New upstream version 5.3.0

diff --git a/.depend b/.depend
index 2e7da09b25e70578d9ef61bd696041acb7430bbe..ad3238204db2fd452d165a948a2e59146c9f34ed 100644 (file)
--- a/.depend
+++ b/.depend
@@ -81,27 +81,38 @@ utils/consistbl.cmi : \
     utils/misc.cmi
 utils/diffing.cmo : \
     utils/misc.cmi \
+    utils/format_doc.cmi \
     utils/diffing.cmi
 utils/diffing.cmx : \
     utils/misc.cmx \
+    utils/format_doc.cmx \
     utils/diffing.cmi
 utils/diffing.cmi : \
-    utils/misc.cmi
+    utils/misc.cmi \
+    utils/format_doc.cmi
 utils/diffing_with_keys.cmo : \
     utils/misc.cmi \
+    utils/format_doc.cmi \
     utils/diffing.cmi \
     utils/diffing_with_keys.cmi
 utils/diffing_with_keys.cmx : \
     utils/misc.cmx \
+    utils/format_doc.cmx \
     utils/diffing.cmx \
     utils/diffing_with_keys.cmi
 utils/diffing_with_keys.cmi : \
+    utils/format_doc.cmi \
     utils/diffing.cmi
 utils/domainstate.cmo : \
     utils/domainstate.cmi
 utils/domainstate.cmx : \
     utils/domainstate.cmi
 utils/domainstate.cmi :
+utils/format_doc.cmo : \
+    utils/format_doc.cmi
+utils/format_doc.cmx : \
+    utils/format_doc.cmi
+utils/format_doc.cmi :
 utils/identifiable.cmo : \
     utils/misc.cmi \
     utils/identifiable.cmi
@@ -119,6 +130,16 @@ utils/lazy_backtrack.cmo : \
 utils/lazy_backtrack.cmx : \
     utils/lazy_backtrack.cmi
 utils/lazy_backtrack.cmi :
+utils/linkdeps.cmo : \
+    utils/misc.cmi \
+    utils/format_doc.cmi \
+    utils/linkdeps.cmi
+utils/linkdeps.cmx : \
+    utils/misc.cmx \
+    utils/format_doc.cmx \
+    utils/linkdeps.cmi
+utils/linkdeps.cmi : \
+    utils/format_doc.cmi
 utils/load_path.cmo : \
     utils/misc.cmi \
     utils/local_store.cmi \
@@ -136,14 +157,17 @@ utils/local_store.cmx : \
     utils/local_store.cmi
 utils/local_store.cmi :
 utils/misc.cmo : \
+    utils/format_doc.cmi \
     utils/config.cmi \
     utils/build_path_prefix_map.cmi \
     utils/misc.cmi
 utils/misc.cmx : \
+    utils/format_doc.cmx \
     utils/config.cmx \
     utils/build_path_prefix_map.cmx \
     utils/misc.cmi
 utils/misc.cmi : \
+    utils/format_doc.cmi \
     utils/build_path_prefix_map.cmi
 utils/numbers.cmo : \
     utils/misc.cmi \
@@ -188,11 +212,14 @@ utils/terminfo.cmx : \
 utils/terminfo.cmi :
 utils/warnings.cmo : \
     utils/misc.cmi \
+    utils/format_doc.cmi \
     utils/warnings.cmi
 utils/warnings.cmx : \
     utils/misc.cmx \
+    utils/format_doc.cmx \
     utils/warnings.cmi
-utils/warnings.cmi :
+utils/warnings.cmi : \
+    utils/format_doc.cmi
 parsing/ast_helper.cmo : \
     parsing/syntaxerr.cmi \
     parsing/parsetree.cmi \
@@ -209,7 +236,7 @@ parsing/ast_helper.cmx : \
     parsing/longident.cmx \
     parsing/location.cmx \
     parsing/docstrings.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_helper.cmi
 parsing/ast_helper.cmi : \
     parsing/parsetree.cmi \
@@ -230,7 +257,7 @@ parsing/ast_invariants.cmx : \
     parsing/parsetree.cmi \
     parsing/longident.cmx \
     parsing/builtin_attributes.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_iterator.cmx \
     parsing/ast_invariants.cmi
 parsing/ast_invariants.cmi : \
@@ -252,6 +279,7 @@ parsing/ast_mapper.cmo : \
     parsing/longident.cmi \
     parsing/location.cmi \
     utils/load_path.cmi \
+    utils/format_doc.cmi \
     utils/config.cmi \
     utils/clflags.cmi \
     parsing/asttypes.cmi \
@@ -263,20 +291,28 @@ parsing/ast_mapper.cmx : \
     parsing/longident.cmx \
     parsing/location.cmx \
     utils/load_path.cmx \
+    utils/format_doc.cmx \
     utils/config.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_helper.cmx \
     parsing/ast_mapper.cmi
 parsing/ast_mapper.cmi : \
     parsing/parsetree.cmi \
     parsing/location.cmi
+parsing/asttypes.cmo : \
+    parsing/location.cmi \
+    parsing/asttypes.cmi
+parsing/asttypes.cmx : \
+    parsing/location.cmx \
+    parsing/asttypes.cmi
 parsing/asttypes.cmi : \
     parsing/location.cmi
 parsing/attr_helper.cmo : \
     parsing/parsetree.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
     parsing/builtin_attributes.cmi \
     parsing/asttypes.cmi \
     parsing/attr_helper.cmi
@@ -284,12 +320,14 @@ parsing/attr_helper.cmx : \
     parsing/parsetree.cmi \
     utils/misc.cmx \
     parsing/location.cmx \
+    utils/format_doc.cmx \
     parsing/builtin_attributes.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/attr_helper.cmi
 parsing/attr_helper.cmi : \
     parsing/parsetree.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
     parsing/asttypes.cmi
 parsing/builtin_attributes.cmo : \
     utils/warnings.cmi \
@@ -297,6 +335,7 @@ parsing/builtin_attributes.cmo : \
     utils/misc.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
     utils/clflags.cmi \
     parsing/asttypes.cmi \
     parsing/ast_iterator.cmi \
@@ -308,8 +347,9 @@ parsing/builtin_attributes.cmx : \
     utils/misc.cmx \
     parsing/longident.cmx \
     parsing/location.cmx \
+    utils/format_doc.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_iterator.cmx \
     parsing/ast_helper.cmx \
     parsing/builtin_attributes.cmi
@@ -338,7 +378,7 @@ parsing/depend.cmx : \
     parsing/location.cmx \
     utils/clflags.cmx \
     parsing/builtin_attributes.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/depend.cmi
 parsing/depend.cmi : \
     parsing/parsetree.cmi \
@@ -362,6 +402,7 @@ parsing/lexer.cmo : \
     parsing/parser.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
     parsing/docstrings.cmi \
     parsing/lexer.cmi
 parsing/lexer.cmx : \
@@ -369,6 +410,7 @@ parsing/lexer.cmx : \
     parsing/parser.cmx \
     utils/misc.cmx \
     parsing/location.cmx \
+    utils/format_doc.cmx \
     parsing/docstrings.cmx \
     parsing/lexer.cmi
 parsing/lexer.cmi : \
@@ -378,6 +420,7 @@ parsing/location.cmo : \
     utils/warnings.cmi \
     utils/terminfo.cmi \
     utils/misc.cmi \
+    utils/format_doc.cmi \
     utils/clflags.cmi \
     utils/build_path_prefix_map.cmi \
     parsing/location.cmi
@@ -385,11 +428,13 @@ parsing/location.cmx : \
     utils/warnings.cmx \
     utils/terminfo.cmx \
     utils/misc.cmx \
+    utils/format_doc.cmx \
     utils/clflags.cmx \
     utils/build_path_prefix_map.cmx \
     parsing/location.cmi
 parsing/location.cmi : \
-    utils/warnings.cmi
+    utils/warnings.cmi \
+    utils/format_doc.cmi
 parsing/longident.cmo : \
     utils/misc.cmi \
     parsing/longident.cmi
@@ -404,7 +449,9 @@ parsing/parse.cmo : \
     utils/misc.cmi \
     parsing/location.cmi \
     parsing/lexer.cmi \
+    utils/format_doc.cmi \
     parsing/docstrings.cmi \
+    utils/clflags.cmi \
     parsing/parse.cmi
 parsing/parse.cmx : \
     parsing/syntaxerr.cmx \
@@ -413,7 +460,9 @@ parsing/parse.cmx : \
     utils/misc.cmx \
     parsing/location.cmx \
     parsing/lexer.cmx \
+    utils/format_doc.cmx \
     parsing/docstrings.cmx \
+    utils/clflags.cmx \
     parsing/parse.cmi
 parsing/parse.cmi : \
     parsing/parsetree.cmi \
@@ -439,7 +488,7 @@ parsing/parser.cmx : \
     utils/clflags.cmx \
     parsing/camlinternalMenhirLib.cmx \
     parsing/builtin_attributes.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_helper.cmx \
     parsing/parser.cmi
 parsing/parser.cmi : \
@@ -457,6 +506,7 @@ parsing/pprintast.cmo : \
     parsing/longident.cmi \
     parsing/location.cmi \
     parsing/lexer.cmi \
+    utils/format_doc.cmi \
     parsing/asttypes.cmi \
     parsing/pprintast.cmi
 parsing/pprintast.cmx : \
@@ -464,11 +514,13 @@ parsing/pprintast.cmx : \
     parsing/longident.cmx \
     parsing/location.cmx \
     parsing/lexer.cmx \
-    parsing/asttypes.cmi \
+    utils/format_doc.cmx \
+    parsing/asttypes.cmx \
     parsing/pprintast.cmi
 parsing/pprintast.cmi : \
     parsing/parsetree.cmi \
-    parsing/longident.cmi
+    parsing/longident.cmi \
+    utils/format_doc.cmi
 parsing/printast.cmo : \
     parsing/pprintast.cmi \
     parsing/parsetree.cmi \
@@ -483,7 +535,7 @@ parsing/printast.cmx : \
     parsing/longident.cmx \
     parsing/location.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/printast.cmi
 parsing/printast.cmi : \
     parsing/parsetree.cmi
@@ -515,6 +567,7 @@ typing/annot.cmi : \
 typing/btype.cmo : \
     typing/types.cmi \
     typing/path.cmi \
+    utils/misc.cmi \
     utils/local_store.cmi \
     typing/ident.cmi \
     parsing/asttypes.cmi \
@@ -522,9 +575,10 @@ typing/btype.cmo : \
 typing/btype.cmx : \
     typing/types.cmx \
     typing/path.cmx \
+    utils/misc.cmx \
     utils/local_store.cmx \
     typing/ident.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/btype.cmi
 typing/btype.cmi : \
     typing/types.cmi \
@@ -557,10 +611,12 @@ typing/cmt2annot.cmx : \
     typing/envaux.cmx \
     typing/env.cmx \
     file_formats/cmt_format.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/annot.cmi \
     typing/cmt2annot.cmi
 typing/cmt2annot.cmi : \
+    typing/tast_iterator.cmi \
+    parsing/location.cmi \
     file_formats/cmt_format.cmi
 typing/ctype.cmo : \
     typing/types.cmi \
@@ -573,6 +629,7 @@ typing/ctype.cmo : \
     parsing/location.cmi \
     utils/local_store.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     utils/clflags.cmi \
@@ -590,11 +647,12 @@ typing/ctype.cmx : \
     parsing/location.cmx \
     utils/local_store.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/errortrace.cmx \
     typing/env.cmx \
     utils/clflags.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/ctype.cmi
 typing/ctype.cmi : \
     typing/types.cmi \
@@ -621,9 +679,10 @@ typing/datarepr.cmx : \
     parsing/location.cmx \
     typing/ident.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/datarepr.cmi
 typing/datarepr.cmi : \
+    parsing/unit_info.cmi \
     typing/types.cmi \
     typing/path.cmi \
     typing/ident.cmi
@@ -634,6 +693,7 @@ typing/env.cmo : \
     typing/subst.cmi \
     typing/shape.cmi \
     typing/predef.cmi \
+    parsing/pprintast.cmi \
     typing/persistent_env.cmi \
     typing/path.cmi \
     utils/misc.cmi \
@@ -643,6 +703,7 @@ typing/env.cmo : \
     utils/load_path.cmi \
     utils/lazy_backtrack.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/datarepr.cmi \
     file_formats/cmi_format.cmi \
     utils/clflags.cmi \
@@ -657,6 +718,7 @@ typing/env.cmx : \
     typing/subst.cmx \
     typing/shape.cmx \
     typing/predef.cmx \
+    parsing/pprintast.cmx \
     typing/persistent_env.cmx \
     typing/path.cmx \
     utils/misc.cmx \
@@ -666,12 +728,13 @@ typing/env.cmx : \
     utils/load_path.cmx \
     utils/lazy_backtrack.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/datarepr.cmx \
     file_formats/cmi_format.cmx \
     utils/clflags.cmx \
     parsing/builtin_attributes.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/env.cmi
 typing/env.cmi : \
     utils/warnings.cmi \
@@ -685,6 +748,7 @@ typing/env.cmi : \
     parsing/location.cmi \
     utils/load_path.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     file_formats/cmi_format.cmi \
     parsing/asttypes.cmi
 typing/envaux.cmo : \
@@ -694,6 +758,7 @@ typing/envaux.cmo : \
     utils/misc.cmi \
     parsing/location.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     parsing/asttypes.cmi \
     typing/envaux.cmi
@@ -704,46 +769,115 @@ typing/envaux.cmx : \
     utils/misc.cmx \
     parsing/location.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/envaux.cmi
 typing/envaux.cmi : \
     typing/subst.cmi \
     typing/path.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi
 typing/errortrace.cmo : \
     typing/types.cmi \
     typing/path.cmi \
+    utils/format_doc.cmi \
     parsing/asttypes.cmi \
     typing/errortrace.cmi
 typing/errortrace.cmx : \
     typing/types.cmx \
     typing/path.cmx \
-    parsing/asttypes.cmi \
+    utils/format_doc.cmx \
+    parsing/asttypes.cmx \
     typing/errortrace.cmi
 typing/errortrace.cmi : \
     typing/types.cmi \
     typing/path.cmi \
+    utils/format_doc.cmi \
     parsing/asttypes.cmi
+typing/errortrace_report.cmo : \
+    typing/types.cmi \
+    typing/printtyp.cmi \
+    typing/predef.cmi \
+    typing/path.cmi \
+    typing/out_type.cmi \
+    typing/oprint.cmi \
+    utils/misc.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace.cmi \
+    typing/env.cmi \
+    typing/ctype.cmi \
+    utils/clflags.cmi \
+    typing/btype.cmi \
+    parsing/asttypes.cmi \
+    typing/errortrace_report.cmi
+typing/errortrace_report.cmx : \
+    typing/types.cmx \
+    typing/printtyp.cmx \
+    typing/predef.cmx \
+    typing/path.cmx \
+    typing/out_type.cmx \
+    typing/oprint.cmx \
+    utils/misc.cmx \
+    utils/format_doc.cmx \
+    typing/errortrace.cmx \
+    typing/env.cmx \
+    typing/ctype.cmx \
+    utils/clflags.cmx \
+    typing/btype.cmx \
+    parsing/asttypes.cmx \
+    typing/errortrace_report.cmi
+typing/errortrace_report.cmi : \
+    typing/path.cmi \
+    typing/out_type.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace.cmi \
+    typing/env.cmi
+typing/gprinttyp.cmo : \
+    utils/warnings.cmi \
+    typing/types.cmi \
+    typing/path.cmi \
+    parsing/longident.cmi \
+    utils/format_doc.cmi \
+    utils/clflags.cmi \
+    parsing/asttypes.cmi \
+    typing/gprinttyp.cmi
+typing/gprinttyp.cmx : \
+    utils/warnings.cmx \
+    typing/types.cmx \
+    typing/path.cmx \
+    parsing/longident.cmx \
+    utils/format_doc.cmx \
+    utils/clflags.cmx \
+    parsing/asttypes.cmx \
+    typing/gprinttyp.cmi
+typing/gprinttyp.cmi : \
+    utils/warnings.cmi \
+    typing/types.cmi
 typing/ident.cmo : \
     utils/misc.cmi \
     utils/local_store.cmi \
     utils/identifiable.cmi \
+    utils/format_doc.cmi \
     utils/clflags.cmi \
     typing/ident.cmi
 typing/ident.cmx : \
     utils/misc.cmx \
     utils/local_store.cmx \
     utils/identifiable.cmx \
+    utils/format_doc.cmx \
     utils/clflags.cmx \
     typing/ident.cmi
 typing/ident.cmi : \
-    utils/identifiable.cmi
+    utils/identifiable.cmi \
+    utils/format_doc.cmi
 typing/includeclass.cmo : \
     typing/types.cmi \
     typing/printtyp.cmi \
     typing/path.cmi \
     utils/misc.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace_report.cmi \
     typing/ctype.cmi \
     parsing/builtin_attributes.cmi \
     typing/includeclass.cmi
@@ -752,13 +886,16 @@ typing/includeclass.cmx : \
     typing/printtyp.cmx \
     typing/path.cmx \
     utils/misc.cmx \
+    utils/format_doc.cmx \
+    typing/errortrace_report.cmx \
     typing/ctype.cmx \
     parsing/builtin_attributes.cmx \
     typing/includeclass.cmi
 typing/includeclass.cmi : \
     typing/types.cmi \
-    typing/printtyp.cmi \
+    typing/out_type.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     typing/ctype.cmi
 typing/includecore.cmo : \
@@ -770,6 +907,8 @@ typing/includecore.cmo : \
     typing/path.cmi \
     utils/misc.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace_report.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     utils/diffing_with_keys.cmi \
@@ -787,13 +926,15 @@ typing/includecore.cmx : \
     typing/path.cmx \
     utils/misc.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
+    typing/errortrace_report.cmx \
     typing/errortrace.cmx \
     typing/env.cmx \
     utils/diffing_with_keys.cmx \
     typing/ctype.cmx \
     parsing/builtin_attributes.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/includecore.cmi
 typing/includecore.cmi : \
     typing/types.cmi \
@@ -802,6 +943,7 @@ typing/includecore.cmi : \
     typing/path.cmi \
     parsing/location.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     utils/diffing_with_keys.cmi
@@ -810,6 +952,7 @@ typing/includemod.cmo : \
     typing/typedtree.cmi \
     typing/subst.cmi \
     typing/shape.cmi \
+    typing/rawprinttyp.cmi \
     typing/printtyp.cmi \
     typing/primitive.cmi \
     typing/predef.cmi \
@@ -833,6 +976,7 @@ typing/includemod.cmx : \
     typing/typedtree.cmx \
     typing/subst.cmx \
     typing/shape.cmx \
+    typing/rawprinttyp.cmx \
     typing/printtyp.cmx \
     typing/primitive.cmx \
     typing/predef.cmx \
@@ -867,7 +1011,9 @@ typing/includemod_errorprinter.cmo : \
     typing/types.cmi \
     typing/typedtree.cmi \
     typing/printtyp.cmi \
+    typing/primitive.cmi \
     typing/path.cmi \
+    typing/out_type.cmi \
     typing/oprint.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
@@ -875,6 +1021,7 @@ typing/includemod_errorprinter.cmo : \
     typing/includecore.cmi \
     typing/includeclass.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     utils/diffing.cmi \
     utils/clflags.cmi \
@@ -883,7 +1030,9 @@ typing/includemod_errorprinter.cmx : \
     typing/types.cmx \
     typing/typedtree.cmx \
     typing/printtyp.cmx \
+    typing/primitive.cmx \
     typing/path.cmx \
+    typing/out_type.cmx \
     typing/oprint.cmx \
     utils/misc.cmx \
     parsing/location.cmx \
@@ -891,12 +1040,17 @@ typing/includemod_errorprinter.cmx : \
     typing/includecore.cmx \
     typing/includeclass.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     utils/diffing.cmx \
     utils/clflags.cmx \
     typing/includemod_errorprinter.cmi
 typing/includemod_errorprinter.cmi : \
-    typing/includemod.cmi
+    typing/types.cmi \
+    typing/typedtree.cmi \
+    typing/includemod.cmi \
+    utils/format_doc.cmi \
+    typing/env.cmi
 typing/mtype.cmo : \
     typing/types.cmi \
     typing/subst.cmi \
@@ -919,7 +1073,7 @@ typing/mtype.cmx : \
     typing/ctype.cmx \
     utils/clflags.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/mtype.cmi
 typing/mtype.cmi : \
     typing/types.cmi \
@@ -929,19 +1083,83 @@ typing/mtype.cmi : \
 typing/oprint.cmo : \
     parsing/pprintast.cmi \
     typing/outcometree.cmi \
+    utils/misc.cmi \
     parsing/lexer.cmi \
+    utils/format_doc.cmi \
     parsing/asttypes.cmi \
     typing/oprint.cmi
 typing/oprint.cmx : \
     parsing/pprintast.cmx \
     typing/outcometree.cmi \
+    utils/misc.cmx \
     parsing/lexer.cmx \
-    parsing/asttypes.cmi \
+    utils/format_doc.cmx \
+    parsing/asttypes.cmx \
     typing/oprint.cmi
 typing/oprint.cmi : \
-    typing/outcometree.cmi
+    typing/outcometree.cmi \
+    utils/format_doc.cmi
+typing/out_type.cmo : \
+    parsing/unit_info.cmi \
+    typing/types.cmi \
+    typing/type_immediacy.cmi \
+    typing/signature_group.cmi \
+    typing/shape.cmi \
+    typing/primitive.cmi \
+    typing/predef.cmi \
+    typing/path.cmi \
+    parsing/parsetree.cmi \
+    typing/outcometree.cmi \
+    typing/oprint.cmi \
+    utils/misc.cmi \
+    parsing/longident.cmi \
+    parsing/location.cmi \
+    typing/ident.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace.cmi \
+    typing/env.cmi \
+    typing/ctype.cmi \
+    utils/clflags.cmi \
+    typing/btype.cmi \
+    parsing/asttypes.cmi \
+    typing/out_type.cmi
+typing/out_type.cmx : \
+    parsing/unit_info.cmx \
+    typing/types.cmx \
+    typing/type_immediacy.cmx \
+    typing/signature_group.cmx \
+    typing/shape.cmx \
+    typing/primitive.cmx \
+    typing/predef.cmx \
+    typing/path.cmx \
+    parsing/parsetree.cmi \
+    typing/outcometree.cmi \
+    typing/oprint.cmx \
+    utils/misc.cmx \
+    parsing/longident.cmx \
+    parsing/location.cmx \
+    typing/ident.cmx \
+    utils/format_doc.cmx \
+    typing/errortrace.cmx \
+    typing/env.cmx \
+    typing/ctype.cmx \
+    utils/clflags.cmx \
+    typing/btype.cmx \
+    parsing/asttypes.cmx \
+    typing/out_type.cmi
+typing/out_type.cmi : \
+    typing/types.cmi \
+    typing/shape.cmi \
+    typing/path.cmi \
+    typing/outcometree.cmi \
+    parsing/location.cmi \
+    typing/ident.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace.cmi \
+    typing/env.cmi
 typing/outcometree.cmi : \
     typing/type_immediacy.cmi \
+    utils/format_doc.cmi \
     parsing/asttypes.cmi
 typing/parmatch.cmo : \
     utils/warnings.cmi \
@@ -958,6 +1176,7 @@ typing/parmatch.cmo : \
     parsing/longident.cmi \
     parsing/location.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     typing/ctype.cmi \
     typing/btype.cmi \
@@ -978,10 +1197,11 @@ typing/parmatch.cmx : \
     parsing/longident.cmx \
     parsing/location.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     typing/ctype.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/parmatch.cmi
 typing/parmatch.cmi : \
     typing/types.cmi \
@@ -993,13 +1213,16 @@ typing/parmatch.cmi : \
 typing/path.cmo : \
     parsing/lexer.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/path.cmi
 typing/path.cmx : \
     parsing/lexer.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/path.cmi
 typing/path.cmi : \
-    typing/ident.cmi
+    typing/ident.cmi \
+    utils/format_doc.cmi
 typing/patterns.cmo : \
     typing/types.cmi \
     typing/typedtree.cmi \
@@ -1018,7 +1241,7 @@ typing/patterns.cmx : \
     typing/ident.cmx \
     typing/env.cmx \
     typing/ctype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/patterns.cmi
 typing/patterns.cmi : \
     typing/types.cmi \
@@ -1033,6 +1256,7 @@ typing/persistent_env.cmo : \
     parsing/location.cmi \
     utils/load_path.cmi \
     utils/lazy_backtrack.cmi \
+    utils/format_doc.cmi \
     utils/consistbl.cmi \
     file_formats/cmi_format.cmi \
     utils/clflags.cmi \
@@ -1044,6 +1268,7 @@ typing/persistent_env.cmx : \
     parsing/location.cmx \
     utils/load_path.cmx \
     utils/lazy_backtrack.cmx \
+    utils/format_doc.cmx \
     utils/consistbl.cmx \
     file_formats/cmi_format.cmx \
     utils/clflags.cmx \
@@ -1055,6 +1280,7 @@ typing/persistent_env.cmi : \
     parsing/location.cmi \
     utils/load_path.cmi \
     utils/lazy_backtrack.cmi \
+    utils/format_doc.cmi \
     utils/consistbl.cmi \
     file_formats/cmi_format.cmi
 typing/predef.cmo : \
@@ -1076,7 +1302,7 @@ typing/predef.cmx : \
     parsing/location.cmx \
     typing/ident.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_helper.cmx \
     typing/predef.cmi
 typing/predef.cmi : \
@@ -1088,6 +1314,7 @@ typing/primitive.cmo : \
     typing/outcometree.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
     parsing/attr_helper.cmi \
     typing/primitive.cmi
 typing/primitive.cmx : \
@@ -1095,6 +1322,7 @@ typing/primitive.cmx : \
     typing/outcometree.cmi \
     utils/misc.cmx \
     parsing/location.cmx \
+    utils/format_doc.cmx \
     parsing/attr_helper.cmx \
     typing/primitive.cmi
 typing/primitive.cmi : \
@@ -1105,78 +1333,54 @@ typing/printpat.cmo : \
     typing/types.cmi \
     typing/typedtree.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     parsing/asttypes.cmi \
     typing/printpat.cmi
 typing/printpat.cmx : \
     typing/types.cmx \
     typing/typedtree.cmx \
     typing/ident.cmx \
-    parsing/asttypes.cmi \
+    utils/format_doc.cmx \
+    parsing/asttypes.cmx \
     typing/printpat.cmi
 typing/printpat.cmi : \
     typing/typedtree.cmi \
+    utils/format_doc.cmi \
     parsing/asttypes.cmi
 typing/printtyp.cmo : \
     utils/warnings.cmi \
-    parsing/unit_info.cmi \
     typing/types.cmi \
-    typing/type_immediacy.cmi \
-    typing/signature_group.cmi \
-    typing/shape.cmi \
-    typing/primitive.cmi \
-    typing/predef.cmi \
     parsing/pprintast.cmi \
-    typing/path.cmi \
-    parsing/parsetree.cmi \
     typing/outcometree.cmi \
+    typing/out_type.cmi \
     typing/oprint.cmi \
-    utils/misc.cmi \
-    parsing/longident.cmi \
     parsing/location.cmi \
     typing/ident.cmi \
-    typing/errortrace.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
-    typing/ctype.cmi \
-    utils/clflags.cmi \
-    typing/btype.cmi \
-    parsing/asttypes.cmi \
     typing/printtyp.cmi
 typing/printtyp.cmx : \
     utils/warnings.cmx \
-    parsing/unit_info.cmx \
     typing/types.cmx \
-    typing/type_immediacy.cmx \
-    typing/signature_group.cmx \
-    typing/shape.cmx \
-    typing/primitive.cmx \
-    typing/predef.cmx \
     parsing/pprintast.cmx \
-    typing/path.cmx \
-    parsing/parsetree.cmi \
     typing/outcometree.cmi \
+    typing/out_type.cmx \
     typing/oprint.cmx \
-    utils/misc.cmx \
-    parsing/longident.cmx \
     parsing/location.cmx \
     typing/ident.cmx \
-    typing/errortrace.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
-    typing/ctype.cmx \
-    utils/clflags.cmx \
-    typing/btype.cmx \
-    parsing/asttypes.cmi \
     typing/printtyp.cmi
 typing/printtyp.cmi : \
     typing/types.cmi \
     typing/shape.cmi \
     typing/path.cmi \
-    typing/outcometree.cmi \
+    typing/out_type.cmi \
     parsing/longident.cmi \
-    parsing/location.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/errortrace.cmi \
-    typing/env.cmi \
-    parsing/asttypes.cmi
+    typing/env.cmi
 typing/printtyped.cmo : \
     typing/types.cmi \
     typing/typedtree.cmi \
@@ -1201,23 +1405,42 @@ typing/printtyped.cmx : \
     parsing/location.cmx \
     typing/ident.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/printtyped.cmi
 typing/printtyped.cmi : \
     typing/typedtree.cmi
+typing/rawprinttyp.cmo : \
+    typing/types.cmi \
+    parsing/pprintast.cmi \
+    typing/path.cmi \
+    utils/format_doc.cmi \
+    parsing/asttypes.cmi \
+    typing/rawprinttyp.cmi
+typing/rawprinttyp.cmx : \
+    typing/types.cmx \
+    parsing/pprintast.cmx \
+    typing/path.cmx \
+    utils/format_doc.cmx \
+    parsing/asttypes.cmx \
+    typing/rawprinttyp.cmi
+typing/rawprinttyp.cmi : \
+    typing/types.cmi
 typing/shape.cmo : \
+    parsing/unit_info.cmi \
     typing/path.cmi \
     utils/misc.cmi \
     utils/identifiable.cmi \
     typing/ident.cmi \
     typing/shape.cmi
 typing/shape.cmx : \
+    parsing/unit_info.cmx \
     typing/path.cmx \
     utils/misc.cmx \
     utils/identifiable.cmx \
     typing/ident.cmx \
     typing/shape.cmi
 typing/shape.cmi : \
+    parsing/unit_info.cmi \
     typing/path.cmi \
     utils/identifiable.cmi \
     typing/ident.cmi
@@ -1251,6 +1474,7 @@ typing/signature_group.cmi : \
 typing/stypes.cmo : \
     typing/typedtree.cmi \
     typing/printtyp.cmi \
+    typing/out_type.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
     utils/clflags.cmi \
@@ -1259,6 +1483,7 @@ typing/stypes.cmo : \
 typing/stypes.cmx : \
     typing/typedtree.cmx \
     typing/printtyp.cmx \
+    typing/out_type.cmx \
     utils/misc.cmx \
     parsing/location.cmx \
     utils/clflags.cmx \
@@ -1313,7 +1538,7 @@ typing/tast_iterator.cmx : \
     parsing/parsetree.cmi \
     parsing/location.cmx \
     typing/env.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_iterator.cmx \
     typing/tast_iterator.cmi
 typing/tast_iterator.cmi : \
@@ -1334,7 +1559,7 @@ typing/tast_mapper.cmx : \
     parsing/parsetree.cmi \
     parsing/location.cmx \
     typing/env.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_mapper.cmx \
     typing/tast_mapper.cmi
 typing/tast_mapper.cmi : \
@@ -1363,12 +1588,15 @@ typing/typeclass.cmo : \
     typing/predef.cmi \
     typing/path.cmi \
     parsing/parsetree.cmi \
+    typing/out_type.cmi \
     typing/oprint.cmi \
     utils/misc.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
     typing/includeclass.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace_report.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     typing/ctype.cmi \
@@ -1392,12 +1620,15 @@ typing/typeclass.cmx : \
     typing/predef.cmx \
     typing/path.cmx \
     parsing/parsetree.cmi \
+    typing/out_type.cmx \
     typing/oprint.cmx \
     utils/misc.cmx \
     parsing/longident.cmx \
     parsing/location.cmx \
     typing/includeclass.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
+    typing/errortrace_report.cmx \
     typing/errortrace.cmx \
     typing/env.cmx \
     typing/ctype.cmx \
@@ -1405,7 +1636,7 @@ typing/typeclass.cmx : \
     utils/clflags.cmx \
     parsing/builtin_attributes.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_helper.cmx \
     typing/typeclass.cmi
 typing/typeclass.cmi : \
@@ -1415,6 +1646,7 @@ typing/typeclass.cmi : \
     parsing/longident.cmi \
     parsing/location.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     typing/ctype.cmi \
@@ -1438,11 +1670,14 @@ typing/typecore.cmo : \
     typing/path.cmi \
     parsing/parsetree.cmi \
     typing/parmatch.cmi \
+    typing/out_type.cmi \
     typing/mtype.cmi \
     utils/misc.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace_report.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     typing/ctype.cmi \
@@ -1472,11 +1707,14 @@ typing/typecore.cmx : \
     typing/path.cmx \
     parsing/parsetree.cmi \
     typing/parmatch.cmx \
+    typing/out_type.cmx \
     typing/mtype.cmx \
     utils/misc.cmx \
     parsing/longident.cmx \
     parsing/location.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
+    typing/errortrace_report.cmx \
     typing/errortrace.cmx \
     typing/env.cmx \
     typing/ctype.cmx \
@@ -1484,7 +1722,7 @@ typing/typecore.cmx : \
     utils/clflags.cmx \
     parsing/builtin_attributes.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_helper.cmx \
     typing/typecore.cmi
 typing/typecore.cmi : \
@@ -1518,6 +1756,7 @@ typing/typedecl.cmo : \
     parsing/pprintast.cmi \
     typing/path.cmi \
     parsing/parsetree.cmi \
+    typing/out_type.cmi \
     typing/oprint.cmi \
     utils/misc.cmi \
     parsing/longident.cmi \
@@ -1525,6 +1764,8 @@ typing/typedecl.cmo : \
     lambda/lambda.cmi \
     typing/includecore.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace_report.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     typing/ctype.cmi \
@@ -1556,6 +1797,7 @@ typing/typedecl.cmx : \
     parsing/pprintast.cmx \
     typing/path.cmx \
     parsing/parsetree.cmi \
+    typing/out_type.cmx \
     typing/oprint.cmx \
     utils/misc.cmx \
     parsing/longident.cmx \
@@ -1563,6 +1805,8 @@ typing/typedecl.cmx : \
     lambda/lambda.cmx \
     typing/includecore.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
+    typing/errortrace_report.cmx \
     typing/errortrace.cmx \
     typing/env.cmx \
     typing/ctype.cmx \
@@ -1571,7 +1815,7 @@ typing/typedecl.cmx : \
     parsing/builtin_attributes.cmx \
     typing/btype.cmx \
     parsing/attr_helper.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_iterator.cmx \
     parsing/ast_helper.cmx \
     typing/typedecl.cmi
@@ -1588,6 +1832,7 @@ typing/typedecl.cmi : \
     parsing/location.cmi \
     typing/includecore.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     parsing/asttypes.cmi
@@ -1689,7 +1934,7 @@ typing/typedecl_variance.cmx : \
     typing/env.cmx \
     typing/ctype.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/typedecl_variance.cmi
 typing/typedecl_variance.cmi : \
     typing/types.cmi \
@@ -1724,7 +1969,7 @@ typing/typedtree.cmx : \
     parsing/location.cmx \
     typing/ident.cmx \
     typing/env.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/typedtree.cmi
 typing/typedtree.cmi : \
     typing/value_rec_types.cmi \
@@ -1756,6 +2001,7 @@ typing/typemod.cmo : \
     typing/path.cmi \
     parsing/parsetree.cmi \
     parsing/parse.cmi \
+    typing/out_type.cmi \
     typing/mtype.cmi \
     utils/misc.cmi \
     parsing/longident.cmi \
@@ -1764,6 +2010,8 @@ typing/typemod.cmo : \
     typing/includemod_errorprinter.cmi \
     typing/includemod.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace.cmi \
     typing/env.cmi \
     typing/ctype.cmi \
     file_formats/cmt_format.cmi \
@@ -1793,6 +2041,7 @@ typing/typemod.cmx : \
     typing/path.cmx \
     parsing/parsetree.cmi \
     parsing/parse.cmx \
+    typing/out_type.cmx \
     typing/mtype.cmx \
     utils/misc.cmx \
     parsing/longident.cmx \
@@ -1801,6 +2050,8 @@ typing/typemod.cmx : \
     typing/includemod_errorprinter.cmx \
     typing/includemod.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
+    typing/errortrace.cmx \
     typing/env.cmx \
     typing/ctype.cmx \
     file_formats/cmt_format.cmx \
@@ -1810,7 +2061,7 @@ typing/typemod.cmx : \
     parsing/builtin_attributes.cmx \
     typing/btype.cmx \
     parsing/attr_helper.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/typemod.cmi
 typing/typemod.cmi : \
     parsing/unit_info.cmi \
@@ -1854,7 +2105,7 @@ typing/typeopt.cmx : \
     typing/ctype.cmx \
     utils/config.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/typeopt.cmi
 typing/typeopt.cmi : \
     typing/types.cmi \
@@ -1888,7 +2139,7 @@ typing/types.cmx : \
     utils/local_store.cmx \
     typing/ident.cmx \
     utils/config.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/types.cmi
 typing/types.cmi : \
     typing/type_immediacy.cmi \
@@ -1908,10 +2159,13 @@ typing/typetexp.cmo : \
     parsing/pprintast.cmi \
     typing/path.cmi \
     parsing/parsetree.cmi \
+    typing/out_type.cmi \
     typing/oprint.cmi \
     utils/misc.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
+    typing/errortrace_report.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     typing/ctype.cmi \
@@ -1928,16 +2182,19 @@ typing/typetexp.cmx : \
     parsing/pprintast.cmx \
     typing/path.cmx \
     parsing/parsetree.cmi \
+    typing/out_type.cmx \
     typing/oprint.cmx \
     utils/misc.cmx \
     parsing/longident.cmx \
     parsing/location.cmx \
+    utils/format_doc.cmx \
+    typing/errortrace_report.cmx \
     typing/errortrace.cmx \
     typing/env.cmx \
     typing/ctype.cmx \
     parsing/builtin_attributes.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_helper.cmx \
     typing/typetexp.cmi
 typing/typetexp.cmi : \
@@ -1947,6 +2204,7 @@ typing/typetexp.cmi : \
     parsing/parsetree.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     parsing/asttypes.cmi
@@ -1967,7 +2225,7 @@ typing/untypeast.cmx : \
     parsing/longident.cmx \
     parsing/location.cmx \
     typing/ident.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_helper.cmx \
     typing/untypeast.cmi
 typing/untypeast.cmi : \
@@ -1999,7 +2257,7 @@ typing/value_rec_check.cmx : \
     utils/misc.cmx \
     lambda/lambda.cmx \
     typing/ident.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     typing/value_rec_check.cmi
 typing/value_rec_check.cmi : \
     typing/value_rec_types.cmi \
@@ -2034,7 +2292,7 @@ bytecomp/bytegen.cmx : \
     lambda/debuginfo.cmx \
     utils/config.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     bytecomp/bytegen.cmi
 bytecomp/bytegen.cmi : \
     lambda/lambda.cmi \
@@ -2043,6 +2301,8 @@ bytecomp/bytelibrarian.cmo : \
     utils/misc.cmi \
     parsing/location.cmi \
     utils/load_path.cmi \
+    utils/linkdeps.cmi \
+    utils/format_doc.cmi \
     bytecomp/emitcode.cmi \
     utils/config.cmi \
     file_formats/cmo_format.cmi \
@@ -2053,20 +2313,26 @@ bytecomp/bytelibrarian.cmx : \
     utils/misc.cmx \
     parsing/location.cmx \
     utils/load_path.cmx \
+    utils/linkdeps.cmx \
+    utils/format_doc.cmx \
     bytecomp/emitcode.cmx \
     utils/config.cmx \
     file_formats/cmo_format.cmi \
     utils/clflags.cmx \
     bytecomp/bytelink.cmx \
     bytecomp/bytelibrarian.cmi
-bytecomp/bytelibrarian.cmi :
+bytecomp/bytelibrarian.cmi : \
+    utils/linkdeps.cmi \
+    utils/format_doc.cmi
 bytecomp/bytelink.cmo : \
     bytecomp/symtable.cmi \
     bytecomp/opcodes.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
     utils/load_path.cmi \
+    utils/linkdeps.cmi \
     bytecomp/instruct.cmi \
+    utils/format_doc.cmi \
     bytecomp/emitcode.cmi \
     bytecomp/dll.cmi \
     utils/consistbl.cmi \
@@ -2083,7 +2349,9 @@ bytecomp/bytelink.cmx : \
     utils/misc.cmx \
     parsing/location.cmx \
     utils/load_path.cmx \
+    utils/linkdeps.cmx \
     bytecomp/instruct.cmx \
+    utils/format_doc.cmx \
     bytecomp/emitcode.cmx \
     bytecomp/dll.cmx \
     utils/consistbl.cmx \
@@ -2097,6 +2365,8 @@ bytecomp/bytelink.cmx : \
 bytecomp/bytelink.cmi : \
     bytecomp/symtable.cmi \
     utils/misc.cmi \
+    utils/linkdeps.cmi \
+    utils/format_doc.cmi \
     file_formats/cmo_format.cmi
 bytecomp/bytepackager.cmo : \
     parsing/unit_info.cmi \
@@ -2112,6 +2382,7 @@ bytecomp/bytepackager.cmo : \
     utils/load_path.cmi \
     bytecomp/instruct.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     bytecomp/emitcode.cmi \
     utils/config.cmi \
@@ -2135,6 +2406,7 @@ bytecomp/bytepackager.cmx : \
     utils/load_path.cmx \
     bytecomp/instruct.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     bytecomp/emitcode.cmx \
     utils/config.cmx \
@@ -2145,6 +2417,7 @@ bytecomp/bytepackager.cmx : \
     bytecomp/bytegen.cmx \
     bytecomp/bytepackager.cmi
 bytecomp/bytepackager.cmi : \
+    utils/format_doc.cmi \
     typing/env.cmi \
     file_formats/cmo_format.cmi
 bytecomp/bytesections.cmo : \
@@ -2176,6 +2449,7 @@ bytecomp/emitcode.cmo : \
     lambda/lambda.cmi \
     bytecomp/instruct.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     utils/config.cmi \
     utils/compression.cmi \
@@ -2196,6 +2470,7 @@ bytecomp/emitcode.cmx : \
     lambda/lambda.cmx \
     bytecomp/instruct.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     utils/config.cmx \
     utils/compression.cmx \
@@ -2203,7 +2478,7 @@ bytecomp/emitcode.cmx : \
     utils/clflags.cmx \
     bytecomp/bytegen.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     bytecomp/emitcode.cmi
 bytecomp/emitcode.cmi : \
     parsing/unit_info.cmi \
@@ -2271,6 +2546,7 @@ bytecomp/symtable.cmo : \
     parsing/location.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     bytecomp/dll.cmi \
     utils/config.cmi \
     file_formats/cmo_format.cmi \
@@ -2284,6 +2560,7 @@ bytecomp/symtable.cmx : \
     parsing/location.cmx \
     lambda/lambda.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     bytecomp/dll.cmx \
     utils/config.cmx \
     file_formats/cmo_format.cmi \
@@ -2292,17 +2569,8 @@ bytecomp/symtable.cmx : \
 bytecomp/symtable.cmi : \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     file_formats/cmo_format.cmi
-asmcomp/CSE.cmo : \
-    asmcomp/mach.cmi \
-    asmcomp/CSEgen.cmi \
-    asmcomp/arch.cmi \
-    asmcomp/CSE.cmi
-asmcomp/CSE.cmx : \
-    asmcomp/mach.cmx \
-    asmcomp/CSEgen.cmx \
-    asmcomp/arch.cmx \
-    asmcomp/CSE.cmi
 asmcomp/CSE.cmi : \
     asmcomp/mach.cmi
 asmcomp/CSEgen.cmo : \
@@ -2317,7 +2585,7 @@ asmcomp/CSEgen.cmx : \
     asmcomp/proc.cmx \
     asmcomp/mach.cmx \
     asmcomp/cmm.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     asmcomp/CSEgen.cmi
 asmcomp/CSEgen.cmi : \
     asmcomp/mach.cmi \
@@ -2334,26 +2602,11 @@ asmcomp/afl_instrument.cmx : \
     asmcomp/cmm.cmx \
     utils/clflags.cmx \
     middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     asmcomp/afl_instrument.cmi
 asmcomp/afl_instrument.cmi : \
     lambda/debuginfo.cmi \
     asmcomp/cmm.cmi
-asmcomp/arch.cmo : \
-    asmcomp/x86_ast.cmi \
-    lambda/lambda.cmi \
-    utils/config.cmi \
-    utils/clflags.cmi \
-    asmcomp/arch.cmi
-asmcomp/arch.cmx : \
-    asmcomp/x86_ast.cmi \
-    lambda/lambda.cmx \
-    utils/config.cmx \
-    utils/clflags.cmx \
-    asmcomp/arch.cmi
-asmcomp/arch.cmi : \
-    asmcomp/x86_ast.cmi \
-    lambda/lambda.cmi
 asmcomp/asmgen.cmo : \
     parsing/unit_info.cmi \
     lambda/translmod.cmi \
@@ -2382,6 +2635,7 @@ asmcomp/asmgen.cmo : \
     asmcomp/interval.cmi \
     asmcomp/interf.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     asmcomp/emitaux.cmi \
     asmcomp/emit.cmi \
     asmcomp/deadcode.cmi \
@@ -2426,6 +2680,7 @@ asmcomp/asmgen.cmx : \
     asmcomp/interval.cmx \
     asmcomp/interf.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     asmcomp/emitaux.cmx \
     asmcomp/emit.cmx \
     asmcomp/deadcode.cmx \
@@ -2445,6 +2700,7 @@ asmcomp/asmgen.cmx : \
 asmcomp/asmgen.cmi : \
     parsing/unit_info.cmi \
     lambda/lambda.cmi \
+    utils/format_doc.cmi \
     asmcomp/emitaux.cmi \
     asmcomp/cmm.cmi \
     middle_end/clambda.cmi \
@@ -2453,6 +2709,8 @@ asmcomp/asmlibrarian.cmo : \
     utils/misc.cmi \
     parsing/location.cmi \
     utils/load_path.cmi \
+    utils/linkdeps.cmi \
+    utils/format_doc.cmi \
     middle_end/flambda/export_info.cmi \
     utils/config.cmi \
     middle_end/compilenv.cmi \
@@ -2466,6 +2724,8 @@ asmcomp/asmlibrarian.cmx : \
     utils/misc.cmx \
     parsing/location.cmx \
     utils/load_path.cmx \
+    utils/linkdeps.cmx \
+    utils/format_doc.cmx \
     middle_end/flambda/export_info.cmx \
     utils/config.cmx \
     middle_end/compilenv.cmx \
@@ -2475,7 +2735,9 @@ asmcomp/asmlibrarian.cmx : \
     utils/ccomp.cmx \
     asmcomp/asmlink.cmx \
     asmcomp/asmlibrarian.cmi
-asmcomp/asmlibrarian.cmi :
+asmcomp/asmlibrarian.cmi : \
+    utils/linkdeps.cmi \
+    utils/format_doc.cmi
 asmcomp/asmlink.cmo : \
     asmcomp/thread_sanitizer.cmi \
     lambda/runtimedef.cmi \
@@ -2483,6 +2745,8 @@ asmcomp/asmlink.cmo : \
     utils/misc.cmi \
     parsing/location.cmi \
     utils/load_path.cmi \
+    utils/linkdeps.cmi \
+    utils/format_doc.cmi \
     asmcomp/emitaux.cmi \
     asmcomp/emit.cmi \
     utils/consistbl.cmi \
@@ -2502,6 +2766,8 @@ asmcomp/asmlink.cmx : \
     utils/misc.cmx \
     parsing/location.cmx \
     utils/load_path.cmx \
+    utils/linkdeps.cmx \
+    utils/format_doc.cmx \
     asmcomp/emitaux.cmx \
     asmcomp/emit.cmx \
     utils/consistbl.cmx \
@@ -2516,6 +2782,8 @@ asmcomp/asmlink.cmx : \
     asmcomp/asmlink.cmi
 asmcomp/asmlink.cmi : \
     utils/misc.cmi \
+    utils/linkdeps.cmi \
+    utils/format_doc.cmi \
     file_formats/cmx_format.cmi
 asmcomp/asmpackager.cmo : \
     parsing/unit_info.cmi \
@@ -2528,6 +2796,7 @@ asmcomp/asmpackager.cmo : \
     utils/load_path.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     middle_end/flambda/flambda_middle_end.cmi \
     middle_end/flambda/export_info_for_pack.cmi \
     middle_end/flambda/export_info.cmi \
@@ -2553,6 +2822,7 @@ asmcomp/asmpackager.cmx : \
     utils/load_path.cmx \
     lambda/lambda.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     middle_end/flambda/flambda_middle_end.cmx \
     middle_end/flambda/export_info_for_pack.cmx \
     middle_end/flambda/export_info.cmx \
@@ -2568,6 +2838,7 @@ asmcomp/asmpackager.cmx : \
     asmcomp/asmgen.cmx \
     asmcomp/asmpackager.cmi
 asmcomp/asmpackager.cmi : \
+    utils/format_doc.cmi \
     typing/env.cmi \
     middle_end/backend_intf.cmi
 asmcomp/branch_relaxation.cmo : \
@@ -2606,7 +2877,7 @@ asmcomp/cmm.cmx : \
     lambda/lambda.cmx \
     lambda/debuginfo.cmx \
     middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     asmcomp/cmm.cmi
 asmcomp/cmm.cmi : \
     utils/targetint.cmi \
@@ -2618,7 +2889,6 @@ asmcomp/cmm_helpers.cmo : \
     utils/targetint.cmi \
     lambda/switch.cmi \
     asmcomp/strmatch.cmi \
-    asmcomp/proc.cmi \
     typing/primitive.cmi \
     utils/numbers.cmi \
     utils/misc.cmi \
@@ -2641,7 +2911,6 @@ asmcomp/cmm_helpers.cmx : \
     utils/targetint.cmx \
     lambda/switch.cmx \
     asmcomp/strmatch.cmx \
-    asmcomp/proc.cmx \
     typing/primitive.cmx \
     utils/numbers.cmx \
     utils/misc.cmx \
@@ -2657,7 +2926,7 @@ asmcomp/cmm_helpers.cmx : \
     middle_end/clambda_primitives.cmx \
     middle_end/clambda.cmx \
     middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     asmcomp/arch.cmx \
     asmcomp/cmm_helpers.cmi
 asmcomp/cmm_helpers.cmi : \
@@ -2716,7 +2985,7 @@ asmcomp/cmmgen.cmx : \
     middle_end/clambda_primitives.cmx \
     middle_end/clambda.cmx \
     middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     asmcomp/afl_instrument.cmx \
     asmcomp/cmmgen.cmi
 asmcomp/cmmgen.cmi : \
@@ -2787,56 +3056,12 @@ asmcomp/deadcode.cmx : \
     asmcomp/deadcode.cmi
 asmcomp/deadcode.cmi : \
     asmcomp/mach.cmi
-asmcomp/emit.cmo : \
-    asmcomp/x86_proc.cmi \
-    asmcomp/x86_masm.cmi \
-    asmcomp/x86_gas.cmi \
-    asmcomp/x86_dsl.cmi \
-    asmcomp/x86_ast.cmi \
-    asmcomp/reg.cmi \
-    asmcomp/proc.cmi \
-    utils/numbers.cmi \
-    utils/misc.cmi \
-    asmcomp/mach.cmi \
-    asmcomp/linear.cmi \
-    lambda/lambda.cmi \
-    asmcomp/emitenv.cmi \
-    asmcomp/emitaux.cmi \
-    utils/domainstate.cmi \
-    utils/config.cmi \
-    middle_end/compilenv.cmi \
-    asmcomp/cmm.cmi \
-    utils/clflags.cmi \
-    asmcomp/branch_relaxation.cmi \
-    asmcomp/arch.cmi \
-    asmcomp/emit.cmi
-asmcomp/emit.cmx : \
-    asmcomp/x86_proc.cmx \
-    asmcomp/x86_masm.cmx \
-    asmcomp/x86_gas.cmx \
-    asmcomp/x86_dsl.cmx \
-    asmcomp/x86_ast.cmi \
-    asmcomp/reg.cmx \
-    asmcomp/proc.cmx \
-    utils/numbers.cmx \
-    utils/misc.cmx \
-    asmcomp/mach.cmx \
-    asmcomp/linear.cmx \
-    lambda/lambda.cmx \
-    asmcomp/emitenv.cmi \
-    asmcomp/emitaux.cmx \
-    utils/domainstate.cmx \
-    utils/config.cmx \
-    middle_end/compilenv.cmx \
-    asmcomp/cmm.cmx \
-    utils/clflags.cmx \
-    asmcomp/branch_relaxation.cmx \
-    asmcomp/arch.cmx \
-    asmcomp/emit.cmi
-asmcomp/emit.cmi : \
+asmcomp/emit.cmi : \
     asmcomp/linear.cmi \
     asmcomp/cmm.cmi
 asmcomp/emitaux.cmo : \
+    parsing/location.cmi \
+    utils/format_doc.cmi \
     asmcomp/emitenv.cmi \
     lambda/debuginfo.cmi \
     utils/config.cmi \
@@ -2846,6 +3071,8 @@ asmcomp/emitaux.cmo : \
     asmcomp/arch.cmi \
     asmcomp/emitaux.cmi
 asmcomp/emitaux.cmx : \
+    parsing/location.cmx \
+    utils/format_doc.cmx \
     asmcomp/emitenv.cmi \
     lambda/debuginfo.cmx \
     utils/config.cmx \
@@ -2856,6 +3083,7 @@ asmcomp/emitaux.cmx : \
     asmcomp/emitaux.cmi
 asmcomp/emitaux.cmi : \
     asmcomp/linear.cmi \
+    utils/format_doc.cmi \
     asmcomp/emitenv.cmi \
     lambda/debuginfo.cmi
 asmcomp/emitenv.cmi : \
@@ -2971,7 +3199,7 @@ asmcomp/mach.cmx : \
     lambda/lambda.cmx \
     lambda/debuginfo.cmx \
     asmcomp/cmm.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     asmcomp/arch.cmx \
     asmcomp/mach.cmi
 asmcomp/mach.cmi : \
@@ -2986,6 +3214,7 @@ asmcomp/polling.cmo : \
     utils/misc.cmi \
     asmcomp/mach.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
     lambda/debuginfo.cmi \
     asmcomp/dataflow.cmi \
     asmcomp/cmm.cmi \
@@ -2995,6 +3224,7 @@ asmcomp/polling.cmx : \
     utils/misc.cmx \
     asmcomp/mach.cmx \
     parsing/location.cmx \
+    utils/format_doc.cmx \
     lambda/debuginfo.cmx \
     asmcomp/dataflow.cmx \
     asmcomp/cmm.cmx \
@@ -3018,7 +3248,7 @@ asmcomp/printcmm.cmx : \
     asmcomp/cmm.cmx \
     utils/clflags.cmx \
     middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     asmcomp/printcmm.cmi
 asmcomp/printcmm.cmi : \
     lambda/debuginfo.cmi \
@@ -3069,24 +3299,6 @@ asmcomp/printmach.cmi : \
     asmcomp/reg.cmi \
     asmcomp/mach.cmi \
     asmcomp/interval.cmi
-asmcomp/proc.cmo : \
-    asmcomp/x86_proc.cmi \
-    asmcomp/reg.cmi \
-    utils/misc.cmi \
-    asmcomp/mach.cmi \
-    utils/config.cmi \
-    asmcomp/cmm.cmi \
-    asmcomp/arch.cmi \
-    asmcomp/proc.cmi
-asmcomp/proc.cmx : \
-    asmcomp/x86_proc.cmx \
-    asmcomp/reg.cmx \
-    utils/misc.cmx \
-    asmcomp/mach.cmx \
-    utils/config.cmx \
-    asmcomp/cmm.cmx \
-    asmcomp/arch.cmx \
-    asmcomp/proc.cmi
 asmcomp/proc.cmi : \
     asmcomp/reg.cmi \
     asmcomp/mach.cmi \
@@ -3102,22 +3314,6 @@ asmcomp/reg.cmx : \
 asmcomp/reg.cmi : \
     asmcomp/cmm.cmi \
     middle_end/backend_var.cmi
-asmcomp/reload.cmo : \
-    asmcomp/reloadgen.cmi \
-    asmcomp/reg.cmi \
-    asmcomp/mach.cmi \
-    asmcomp/cmm.cmi \
-    utils/clflags.cmi \
-    asmcomp/arch.cmi \
-    asmcomp/reload.cmi
-asmcomp/reload.cmx : \
-    asmcomp/reloadgen.cmx \
-    asmcomp/reg.cmx \
-    asmcomp/mach.cmx \
-    asmcomp/cmm.cmx \
-    utils/clflags.cmx \
-    asmcomp/arch.cmx \
-    asmcomp/reload.cmi
 asmcomp/reload.cmi : \
     asmcomp/mach.cmi
 asmcomp/reloadgen.cmo : \
@@ -3154,12 +3350,6 @@ asmcomp/schedgen.cmx : \
 asmcomp/schedgen.cmi : \
     asmcomp/mach.cmi \
     asmcomp/linear.cmi
-asmcomp/scheduling.cmo : \
-    asmcomp/schedgen.cmi \
-    asmcomp/scheduling.cmi
-asmcomp/scheduling.cmx : \
-    asmcomp/schedgen.cmx \
-    asmcomp/scheduling.cmi
 asmcomp/scheduling.cmi : \
     asmcomp/linear.cmi
 asmcomp/selectgen.cmo : \
@@ -3187,7 +3377,7 @@ asmcomp/selectgen.cmx : \
     lambda/debuginfo.cmx \
     asmcomp/cmm.cmx \
     middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     asmcomp/arch.cmx \
     asmcomp/selectgen.cmi
 asmcomp/selectgen.cmi : \
@@ -3199,169 +3389,712 @@ asmcomp/selectgen.cmi : \
     middle_end/backend_var.cmi \
     parsing/asttypes.cmi \
     asmcomp/arch.cmi
-asmcomp/selection.cmo : \
-    asmcomp/selectgen.cmi \
+asmcomp/selection.cmi : \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/cmm.cmi
+asmcomp/spill.cmo : \
+    asmcomp/reg.cmi \
+    asmcomp/proc.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/cmm.cmi \
+    utils/clflags.cmi \
+    asmcomp/spill.cmi
+asmcomp/spill.cmx : \
+    asmcomp/reg.cmx \
+    asmcomp/proc.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/cmm.cmx \
+    utils/clflags.cmx \
+    asmcomp/spill.cmi
+asmcomp/spill.cmi : \
+    asmcomp/mach.cmi
+asmcomp/split.cmo : \
+    asmcomp/reg.cmi \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/split.cmi
+asmcomp/split.cmx : \
+    asmcomp/reg.cmx \
+    utils/misc.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/split.cmi
+asmcomp/split.cmi : \
+    asmcomp/mach.cmi
+asmcomp/stackframe.cmi : \
+    asmcomp/stackframegen.cmi \
+    asmcomp/mach.cmi
+asmcomp/stackframegen.cmo : \
+    asmcomp/mach.cmi \
+    lambda/lambda.cmi \
+    utils/clflags.cmi \
+    asmcomp/stackframegen.cmi
+asmcomp/stackframegen.cmx : \
+    asmcomp/mach.cmx \
+    lambda/lambda.cmx \
+    utils/clflags.cmx \
+    asmcomp/stackframegen.cmi
+asmcomp/stackframegen.cmi : \
+    asmcomp/mach.cmi
+asmcomp/strmatch.cmo : \
+    lambda/lambda.cmi \
+    lambda/debuginfo.cmi \
+    asmcomp/cmm.cmi \
+    middle_end/backend_var.cmi \
+    parsing/asttypes.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/strmatch.cmi
+asmcomp/strmatch.cmx : \
+    lambda/lambda.cmx \
+    lambda/debuginfo.cmx \
+    asmcomp/cmm.cmx \
+    middle_end/backend_var.cmx \
+    parsing/asttypes.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/strmatch.cmi
+asmcomp/strmatch.cmi : \
+    lambda/debuginfo.cmi \
+    asmcomp/cmm.cmi
+asmcomp/thread_sanitizer.cmo : \
+    lambda/debuginfo.cmi \
+    asmcomp/cmm_helpers.cmi \
+    asmcomp/cmm.cmi \
+    middle_end/backend_var.cmi \
+    parsing/asttypes.cmi \
+    asmcomp/thread_sanitizer.cmi
+asmcomp/thread_sanitizer.cmx : \
+    lambda/debuginfo.cmx \
+    asmcomp/cmm_helpers.cmx \
+    asmcomp/cmm.cmx \
+    middle_end/backend_var.cmx \
+    parsing/asttypes.cmx \
+    asmcomp/thread_sanitizer.cmi
+asmcomp/thread_sanitizer.cmi : \
+    asmcomp/cmm.cmi
+asmcomp/x86_ast.cmi :
+asmcomp/x86_dsl.cmo : \
+    asmcomp/x86_proc.cmi \
+    asmcomp/x86_ast.cmi \
+    asmcomp/x86_dsl.cmi
+asmcomp/x86_dsl.cmx : \
+    asmcomp/x86_proc.cmx \
+    asmcomp/x86_ast.cmi \
+    asmcomp/x86_dsl.cmi
+asmcomp/x86_dsl.cmi : \
+    asmcomp/x86_ast.cmi
+asmcomp/x86_gas.cmo : \
+    asmcomp/x86_proc.cmi \
+    asmcomp/x86_ast.cmi \
+    utils/misc.cmi \
+    asmcomp/x86_gas.cmi
+asmcomp/x86_gas.cmx : \
+    asmcomp/x86_proc.cmx \
+    asmcomp/x86_ast.cmi \
+    utils/misc.cmx \
+    asmcomp/x86_gas.cmi
+asmcomp/x86_gas.cmi : \
+    asmcomp/x86_ast.cmi
+asmcomp/x86_masm.cmo : \
+    asmcomp/x86_proc.cmi \
+    asmcomp/x86_ast.cmi \
+    asmcomp/x86_masm.cmi
+asmcomp/x86_masm.cmx : \
+    asmcomp/x86_proc.cmx \
+    asmcomp/x86_ast.cmi \
+    asmcomp/x86_masm.cmi
+asmcomp/x86_masm.cmi : \
+    asmcomp/x86_ast.cmi
+asmcomp/x86_proc.cmo : \
+    asmcomp/x86_ast.cmi \
+    utils/misc.cmi \
+    utils/config.cmi \
+    middle_end/compilenv.cmi \
+    utils/clflags.cmi \
+    utils/ccomp.cmi \
+    asmcomp/x86_proc.cmi
+asmcomp/x86_proc.cmx : \
+    asmcomp/x86_ast.cmi \
+    utils/misc.cmx \
+    utils/config.cmx \
+    middle_end/compilenv.cmx \
+    utils/clflags.cmx \
+    utils/ccomp.cmx \
+    asmcomp/x86_proc.cmi
+asmcomp/x86_proc.cmi : \
+    asmcomp/x86_ast.cmi
+ifeq "$(ARCH)" "amd64"
+asmcomp/CSE.cmo : \
+    asmcomp/mach.cmi \
+    asmcomp/CSEgen.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/CSE.cmi
+asmcomp/CSE.cmx : \
+    asmcomp/mach.cmx \
+    asmcomp/CSEgen.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/CSE.cmi
+asmcomp/arch.cmo : \
+    asmcomp/x86_ast.cmi \
+    lambda/lambda.cmi \
+    utils/config.cmi \
+    utils/clflags.cmi \
+    asmcomp/arch.cmi
+asmcomp/arch.cmx : \
+    asmcomp/x86_ast.cmi \
+    lambda/lambda.cmx \
+    utils/config.cmx \
+    utils/clflags.cmx \
+    asmcomp/arch.cmi
+asmcomp/arch.cmi : \
+    asmcomp/x86_ast.cmi \
+    lambda/lambda.cmi
+asmcomp/emit.cmo : \
+    asmcomp/x86_proc.cmi \
+    asmcomp/x86_masm.cmi \
+    asmcomp/x86_gas.cmi \
+    asmcomp/x86_dsl.cmi \
+    asmcomp/x86_ast.cmi \
+    asmcomp/reg.cmi \
+    asmcomp/proc.cmi \
+    utils/numbers.cmi \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/linear.cmi \
+    lambda/lambda.cmi \
+    asmcomp/emitenv.cmi \
+    asmcomp/emitaux.cmi \
+    utils/domainstate.cmi \
+    utils/config.cmi \
+    middle_end/compilenv.cmi \
+    asmcomp/cmm.cmi \
+    utils/clflags.cmi \
+    asmcomp/branch_relaxation.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/emit.cmi
+asmcomp/emit.cmx : \
+    asmcomp/x86_proc.cmx \
+    asmcomp/x86_masm.cmx \
+    asmcomp/x86_gas.cmx \
+    asmcomp/x86_dsl.cmx \
+    asmcomp/x86_ast.cmi \
+    asmcomp/reg.cmx \
+    asmcomp/proc.cmx \
+    utils/numbers.cmx \
+    utils/misc.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/linear.cmx \
+    lambda/lambda.cmx \
+    asmcomp/emitenv.cmi \
+    asmcomp/emitaux.cmx \
+    utils/domainstate.cmx \
+    utils/config.cmx \
+    middle_end/compilenv.cmx \
+    asmcomp/cmm.cmx \
+    utils/clflags.cmx \
+    asmcomp/branch_relaxation.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/emit.cmi
+asmcomp/proc.cmo : \
+    asmcomp/x86_proc.cmi \
+    asmcomp/reg.cmi \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    utils/config.cmi \
+    asmcomp/cmm.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/proc.cmi
+asmcomp/proc.cmx : \
+    asmcomp/x86_proc.cmx \
+    asmcomp/reg.cmx \
+    utils/misc.cmx \
+    asmcomp/mach.cmx \
+    utils/config.cmx \
+    asmcomp/cmm.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/proc.cmi
+asmcomp/reload.cmo : \
+    asmcomp/reloadgen.cmi \
+    asmcomp/reg.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/cmm.cmi \
+    utils/clflags.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/reload.cmi
+asmcomp/reload.cmx : \
+    asmcomp/reloadgen.cmx \
+    asmcomp/reg.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/cmm.cmx \
+    utils/clflags.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/reload.cmi
+asmcomp/scheduling.cmo : \
+    asmcomp/schedgen.cmi \
+    asmcomp/scheduling.cmi
+asmcomp/scheduling.cmx : \
+    asmcomp/schedgen.cmx \
+    asmcomp/scheduling.cmi
+asmcomp/selection.cmo : \
+    asmcomp/selectgen.cmi \
+    asmcomp/reg.cmi \
+    asmcomp/proc.cmi \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/cmm.cmi \
+    utils/clflags.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/selection.cmi
+asmcomp/selection.cmx : \
+    asmcomp/selectgen.cmx \
+    asmcomp/reg.cmx \
+    asmcomp/proc.cmx \
+    utils/misc.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/cmm.cmx \
+    utils/clflags.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/selection.cmi
+asmcomp/stackframe.cmo : \
+    asmcomp/stackframegen.cmi \
+    asmcomp/mach.cmi \
+    utils/config.cmi \
+    asmcomp/stackframe.cmi
+asmcomp/stackframe.cmx : \
+    asmcomp/stackframegen.cmx \
+    asmcomp/mach.cmx \
+    utils/config.cmx \
+    asmcomp/stackframe.cmi
+endif # ifeq "$(ARCH)" "amd64"
+ifeq "$(ARCH)" "arm64"
+asmcomp/CSE.cmo : \
+    asmcomp/mach.cmi \
+    asmcomp/CSEgen.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/CSE.cmi
+asmcomp/CSE.cmx : \
+    asmcomp/mach.cmx \
+    asmcomp/CSEgen.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/CSE.cmi
+asmcomp/arch.cmo : \
+    lambda/debuginfo.cmi \
+    utils/config.cmi \
+    asmcomp/arch.cmi
+asmcomp/arch.cmx : \
+    lambda/debuginfo.cmx \
+    utils/config.cmx \
+    asmcomp/arch.cmi
+asmcomp/arch.cmi : \
+    lambda/debuginfo.cmi
+asmcomp/emit.cmo : \
+    asmcomp/reg.cmi \
+    asmcomp/proc.cmi \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/linear.cmi \
+    lambda/lambda.cmi \
+    asmcomp/emitenv.cmi \
+    asmcomp/emitaux.cmi \
+    utils/domainstate.cmi \
+    utils/config.cmi \
+    middle_end/compilenv.cmi \
+    asmcomp/cmm.cmi \
+    utils/clflags.cmi \
+    asmcomp/branch_relaxation.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/emit.cmi
+asmcomp/emit.cmx : \
+    asmcomp/reg.cmx \
+    asmcomp/proc.cmx \
+    utils/misc.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/linear.cmx \
+    lambda/lambda.cmx \
+    asmcomp/emitenv.cmi \
+    asmcomp/emitaux.cmx \
+    utils/domainstate.cmx \
+    utils/config.cmx \
+    middle_end/compilenv.cmx \
+    asmcomp/cmm.cmx \
+    utils/clflags.cmx \
+    asmcomp/branch_relaxation.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/emit.cmi
+asmcomp/proc.cmo : \
+    asmcomp/reg.cmi \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    utils/config.cmi \
+    asmcomp/cmm.cmi \
+    utils/ccomp.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/proc.cmi
+asmcomp/proc.cmx : \
+    asmcomp/reg.cmx \
+    utils/misc.cmx \
+    asmcomp/mach.cmx \
+    utils/config.cmx \
+    asmcomp/cmm.cmx \
+    utils/ccomp.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/proc.cmi
+asmcomp/reload.cmo : \
+    asmcomp/reloadgen.cmi \
+    asmcomp/reg.cmi \
+    asmcomp/reload.cmi
+asmcomp/reload.cmx : \
+    asmcomp/reloadgen.cmx \
+    asmcomp/reg.cmx \
+    asmcomp/reload.cmi
+asmcomp/scheduling.cmo : \
+    asmcomp/schedgen.cmi \
+    asmcomp/scheduling.cmi
+asmcomp/scheduling.cmx : \
+    asmcomp/schedgen.cmx \
+    asmcomp/scheduling.cmi
+asmcomp/selection.cmo : \
+    asmcomp/selectgen.cmi \
+    asmcomp/reg.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/cmm.cmi \
+    utils/clflags.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/selection.cmi
+asmcomp/selection.cmx : \
+    asmcomp/selectgen.cmx \
+    asmcomp/reg.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/cmm.cmx \
+    utils/clflags.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/selection.cmi
+asmcomp/stackframe.cmo : \
+    asmcomp/stackframegen.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/stackframe.cmi
+asmcomp/stackframe.cmx : \
+    asmcomp/stackframegen.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/stackframe.cmi
+endif # ifeq "$(ARCH)" "arm64"
+ifeq "$(ARCH)" "power"
+asmcomp/CSE.cmo : \
+    asmcomp/mach.cmi \
+    asmcomp/CSEgen.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/CSE.cmi
+asmcomp/CSE.cmx : \
+    asmcomp/mach.cmx \
+    asmcomp/CSEgen.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/CSE.cmi
+asmcomp/arch.cmo : \
+    lambda/debuginfo.cmi \
+    utils/config.cmi \
+    asmcomp/arch.cmi
+asmcomp/arch.cmx : \
+    lambda/debuginfo.cmx \
+    utils/config.cmx \
+    asmcomp/arch.cmi
+asmcomp/arch.cmi : \
+    lambda/debuginfo.cmi
+asmcomp/emit.cmo : \
+    asmcomp/reg.cmi \
+    asmcomp/proc.cmi \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/linear.cmi \
+    lambda/lambda.cmi \
+    asmcomp/emitenv.cmi \
+    asmcomp/emitaux.cmi \
+    utils/domainstate.cmi \
+    utils/config.cmi \
+    middle_end/compilenv.cmi \
+    asmcomp/cmm.cmi \
+    utils/clflags.cmi \
+    asmcomp/branch_relaxation.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/emit.cmi
+asmcomp/emit.cmx : \
+    asmcomp/reg.cmx \
+    asmcomp/proc.cmx \
+    utils/misc.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/linear.cmx \
+    lambda/lambda.cmx \
+    asmcomp/emitenv.cmi \
+    asmcomp/emitaux.cmx \
+    utils/domainstate.cmx \
+    utils/config.cmx \
+    middle_end/compilenv.cmx \
+    asmcomp/cmm.cmx \
+    utils/clflags.cmx \
+    asmcomp/branch_relaxation.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/emit.cmi
+asmcomp/proc.cmo : \
+    asmcomp/reg.cmi \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    utils/config.cmi \
+    asmcomp/cmm.cmi \
+    utils/ccomp.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/proc.cmi
+asmcomp/proc.cmx : \
+    asmcomp/reg.cmx \
+    utils/misc.cmx \
+    asmcomp/mach.cmx \
+    utils/config.cmx \
+    asmcomp/cmm.cmx \
+    utils/ccomp.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/proc.cmi
+asmcomp/reload.cmo : \
+    asmcomp/reloadgen.cmi \
+    asmcomp/reload.cmi
+asmcomp/reload.cmx : \
+    asmcomp/reloadgen.cmx \
+    asmcomp/reload.cmi
+asmcomp/scheduling.cmo : \
+    asmcomp/schedgen.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/scheduling.cmi
+asmcomp/scheduling.cmx : \
+    asmcomp/schedgen.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/scheduling.cmi
+asmcomp/selection.cmo : \
+    asmcomp/selectgen.cmi \
+    asmcomp/mach.cmi \
+    lambda/debuginfo.cmi \
+    asmcomp/cmm.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/selection.cmi
+asmcomp/selection.cmx : \
+    asmcomp/selectgen.cmx \
+    asmcomp/mach.cmx \
+    lambda/debuginfo.cmx \
+    asmcomp/cmm.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/selection.cmi
+asmcomp/stackframe.cmo : \
+    asmcomp/stackframegen.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/stackframe.cmi
+asmcomp/stackframe.cmx : \
+    asmcomp/stackframegen.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/stackframe.cmi
+endif # ifeq "$(ARCH)" "power"
+ifeq "$(ARCH)" "s390x"
+asmcomp/CSE.cmo : \
+    asmcomp/mach.cmi \
+    asmcomp/CSEgen.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/CSE.cmi
+asmcomp/CSE.cmx : \
+    asmcomp/mach.cmx \
+    asmcomp/CSEgen.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/CSE.cmi
+asmcomp/arch.cmo : \
+    utils/clflags.cmi \
+    asmcomp/arch.cmi
+asmcomp/arch.cmx : \
+    utils/clflags.cmx \
+    asmcomp/arch.cmi
+asmcomp/arch.cmi :
+asmcomp/emit.cmo : \
+    asmcomp/reg.cmi \
+    asmcomp/proc.cmi \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/linear.cmi \
+    lambda/lambda.cmi \
+    asmcomp/emitenv.cmi \
+    asmcomp/emitaux.cmi \
+    utils/domainstate.cmi \
+    utils/config.cmi \
+    middle_end/compilenv.cmi \
+    asmcomp/cmm.cmi \
+    utils/clflags.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/emit.cmi
+asmcomp/emit.cmx : \
+    asmcomp/reg.cmx \
+    asmcomp/proc.cmx \
+    utils/misc.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/linear.cmx \
+    lambda/lambda.cmx \
+    asmcomp/emitenv.cmi \
+    asmcomp/emitaux.cmx \
+    utils/domainstate.cmx \
+    utils/config.cmx \
+    middle_end/compilenv.cmx \
+    asmcomp/cmm.cmx \
+    utils/clflags.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/emit.cmi
+asmcomp/proc.cmo : \
+    asmcomp/reg.cmi \
+    utils/misc.cmi \
+    asmcomp/mach.cmi \
+    utils/config.cmi \
+    asmcomp/cmm.cmi \
+    utils/ccomp.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/proc.cmi
+asmcomp/proc.cmx : \
+    asmcomp/reg.cmx \
+    utils/misc.cmx \
+    asmcomp/mach.cmx \
+    utils/config.cmx \
+    asmcomp/cmm.cmx \
+    utils/ccomp.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/proc.cmi
+asmcomp/reload.cmo : \
+    asmcomp/reloadgen.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/reload.cmi
+asmcomp/reload.cmx : \
+    asmcomp/reloadgen.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/reload.cmi
+asmcomp/scheduling.cmo : \
+    asmcomp/schedgen.cmi \
+    asmcomp/scheduling.cmi
+asmcomp/scheduling.cmx : \
+    asmcomp/schedgen.cmx \
+    asmcomp/scheduling.cmi
+asmcomp/selection.cmo : \
+    asmcomp/selectgen.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/cmm.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/selection.cmi
+asmcomp/selection.cmx : \
+    asmcomp/selectgen.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/cmm.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/selection.cmi
+asmcomp/stackframe.cmo : \
+    asmcomp/stackframegen.cmi \
+    asmcomp/mach.cmi \
+    asmcomp/stackframe.cmi
+asmcomp/stackframe.cmx : \
+    asmcomp/stackframegen.cmx \
+    asmcomp/mach.cmx \
+    asmcomp/stackframe.cmi
+endif # ifeq "$(ARCH)" "s390x"
+ifeq "$(ARCH)" "riscv"
+asmcomp/CSE.cmo : \
+    asmcomp/mach.cmi \
+    asmcomp/CSEgen.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/CSE.cmi
+asmcomp/CSE.cmx : \
+    asmcomp/mach.cmx \
+    asmcomp/CSEgen.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/CSE.cmi
+asmcomp/arch.cmo : \
+    asmcomp/arch.cmi
+asmcomp/arch.cmx : \
+    asmcomp/arch.cmi
+asmcomp/arch.cmi :
+asmcomp/emit.cmo : \
     asmcomp/reg.cmi \
     asmcomp/proc.cmi \
     utils/misc.cmi \
     asmcomp/mach.cmi \
+    asmcomp/linear.cmi \
+    lambda/lambda.cmi \
+    asmcomp/emitenv.cmi \
+    asmcomp/emitaux.cmi \
+    utils/domainstate.cmi \
+    utils/config.cmi \
+    middle_end/compilenv.cmi \
     asmcomp/cmm.cmi \
     utils/clflags.cmi \
     asmcomp/arch.cmi \
-    asmcomp/selection.cmi
-asmcomp/selection.cmx : \
-    asmcomp/selectgen.cmx \
+    asmcomp/emit.cmi
+asmcomp/emit.cmx : \
     asmcomp/reg.cmx \
     asmcomp/proc.cmx \
     utils/misc.cmx \
     asmcomp/mach.cmx \
+    asmcomp/linear.cmx \
+    lambda/lambda.cmx \
+    asmcomp/emitenv.cmi \
+    asmcomp/emitaux.cmx \
+    utils/domainstate.cmx \
+    utils/config.cmx \
+    middle_end/compilenv.cmx \
     asmcomp/cmm.cmx \
     utils/clflags.cmx \
     asmcomp/arch.cmx \
-    asmcomp/selection.cmi
-asmcomp/selection.cmi : \
-    utils/misc.cmi \
-    asmcomp/mach.cmi \
-    asmcomp/cmm.cmi
-asmcomp/spill.cmo : \
+    asmcomp/emit.cmi
+asmcomp/proc.cmo : \
     asmcomp/reg.cmi \
-    asmcomp/proc.cmi \
+    utils/misc.cmi \
     asmcomp/mach.cmi \
+    utils/config.cmi \
     asmcomp/cmm.cmi \
     utils/clflags.cmi \
-    asmcomp/spill.cmi
-asmcomp/spill.cmx : \
+    utils/ccomp.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/proc.cmi
+asmcomp/proc.cmx : \
     asmcomp/reg.cmx \
-    asmcomp/proc.cmx \
+    utils/misc.cmx \
     asmcomp/mach.cmx \
+    utils/config.cmx \
     asmcomp/cmm.cmx \
     utils/clflags.cmx \
-    asmcomp/spill.cmi
-asmcomp/spill.cmi : \
-    asmcomp/mach.cmi
-asmcomp/split.cmo : \
-    asmcomp/reg.cmi \
-    utils/misc.cmi \
+    utils/ccomp.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/proc.cmi
+asmcomp/reload.cmo : \
+    asmcomp/reloadgen.cmi \
+    asmcomp/reload.cmi
+asmcomp/reload.cmx : \
+    asmcomp/reloadgen.cmx \
+    asmcomp/reload.cmi
+asmcomp/scheduling.cmo : \
+    asmcomp/schedgen.cmi \
+    asmcomp/scheduling.cmi
+asmcomp/scheduling.cmx : \
+    asmcomp/schedgen.cmx \
+    asmcomp/scheduling.cmi
+asmcomp/selection.cmo : \
+    asmcomp/selectgen.cmi \
     asmcomp/mach.cmi \
-    asmcomp/split.cmi
-asmcomp/split.cmx : \
-    asmcomp/reg.cmx \
-    utils/misc.cmx \
+    asmcomp/cmm.cmi \
+    asmcomp/arch.cmi \
+    asmcomp/selection.cmi
+asmcomp/selection.cmx : \
+    asmcomp/selectgen.cmx \
     asmcomp/mach.cmx \
-    asmcomp/split.cmi
-asmcomp/split.cmi : \
-    asmcomp/mach.cmi
+    asmcomp/cmm.cmx \
+    asmcomp/arch.cmx \
+    asmcomp/selection.cmi
 asmcomp/stackframe.cmo : \
     asmcomp/stackframegen.cmi \
     asmcomp/mach.cmi \
-    utils/config.cmi \
     asmcomp/stackframe.cmi
 asmcomp/stackframe.cmx : \
     asmcomp/stackframegen.cmx \
     asmcomp/mach.cmx \
-    utils/config.cmx \
     asmcomp/stackframe.cmi
-asmcomp/stackframe.cmi : \
-    asmcomp/stackframegen.cmi \
-    asmcomp/mach.cmi
-asmcomp/stackframegen.cmo : \
-    asmcomp/mach.cmi \
-    lambda/lambda.cmi \
-    utils/clflags.cmi \
-    asmcomp/stackframegen.cmi
-asmcomp/stackframegen.cmx : \
-    asmcomp/mach.cmx \
-    lambda/lambda.cmx \
-    utils/clflags.cmx \
-    asmcomp/stackframegen.cmi
-asmcomp/stackframegen.cmi : \
-    asmcomp/mach.cmi
-asmcomp/strmatch.cmo : \
-    lambda/lambda.cmi \
-    lambda/debuginfo.cmi \
-    asmcomp/cmm.cmi \
-    middle_end/backend_var.cmi \
-    parsing/asttypes.cmi \
-    asmcomp/arch.cmi \
-    asmcomp/strmatch.cmi
-asmcomp/strmatch.cmx : \
-    lambda/lambda.cmx \
-    lambda/debuginfo.cmx \
-    asmcomp/cmm.cmx \
-    middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
-    asmcomp/arch.cmx \
-    asmcomp/strmatch.cmi
-asmcomp/strmatch.cmi : \
-    lambda/debuginfo.cmi \
-    asmcomp/cmm.cmi
-asmcomp/thread_sanitizer.cmo : \
-    lambda/debuginfo.cmi \
-    asmcomp/cmm_helpers.cmi \
-    asmcomp/cmm.cmi \
-    middle_end/backend_var.cmi \
-    parsing/asttypes.cmi \
-    asmcomp/thread_sanitizer.cmi
-asmcomp/thread_sanitizer.cmx : \
-    lambda/debuginfo.cmx \
-    asmcomp/cmm_helpers.cmx \
-    asmcomp/cmm.cmx \
-    middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
-    asmcomp/thread_sanitizer.cmi
-asmcomp/thread_sanitizer.cmi : \
-    asmcomp/cmm.cmi
-asmcomp/x86_ast.cmi :
-asmcomp/x86_dsl.cmo : \
-    asmcomp/x86_proc.cmi \
-    asmcomp/x86_ast.cmi \
-    asmcomp/x86_dsl.cmi
-asmcomp/x86_dsl.cmx : \
-    asmcomp/x86_proc.cmx \
-    asmcomp/x86_ast.cmi \
-    asmcomp/x86_dsl.cmi
-asmcomp/x86_dsl.cmi : \
-    asmcomp/x86_ast.cmi
-asmcomp/x86_gas.cmo : \
-    asmcomp/x86_proc.cmi \
-    asmcomp/x86_ast.cmi \
-    utils/misc.cmi \
-    asmcomp/x86_gas.cmi
-asmcomp/x86_gas.cmx : \
-    asmcomp/x86_proc.cmx \
-    asmcomp/x86_ast.cmi \
-    utils/misc.cmx \
-    asmcomp/x86_gas.cmi
-asmcomp/x86_gas.cmi : \
-    asmcomp/x86_ast.cmi
-asmcomp/x86_masm.cmo : \
-    asmcomp/x86_proc.cmi \
-    asmcomp/x86_ast.cmi \
-    asmcomp/x86_masm.cmi
-asmcomp/x86_masm.cmx : \
-    asmcomp/x86_proc.cmx \
-    asmcomp/x86_ast.cmi \
-    asmcomp/x86_masm.cmi
-asmcomp/x86_masm.cmi : \
-    asmcomp/x86_ast.cmi
-asmcomp/x86_proc.cmo : \
-    asmcomp/x86_ast.cmi \
-    utils/misc.cmi \
-    utils/config.cmi \
-    middle_end/compilenv.cmi \
-    utils/clflags.cmi \
-    utils/ccomp.cmi \
-    asmcomp/x86_proc.cmi
-asmcomp/x86_proc.cmx : \
-    asmcomp/x86_ast.cmi \
-    utils/misc.cmx \
-    utils/config.cmx \
-    middle_end/compilenv.cmx \
-    utils/clflags.cmx \
-    utils/ccomp.cmx \
-    asmcomp/x86_proc.cmi
-asmcomp/x86_proc.cmi : \
-    asmcomp/x86_ast.cmi
+endif # ifeq "$(ARCH)" "riscv"
 middle_end/backend_intf.cmi : \
     middle_end/symbol.cmi \
     middle_end/flambda/simple_value_approx.cmi \
@@ -3370,12 +4103,14 @@ middle_end/backend_intf.cmi : \
 middle_end/backend_var.cmo : \
     typing/path.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     lambda/debuginfo.cmi \
     utils/clflags.cmi \
     middle_end/backend_var.cmi
 middle_end/backend_var.cmx : \
     typing/path.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     lambda/debuginfo.cmx \
     utils/clflags.cmx \
     middle_end/backend_var.cmi
@@ -3399,7 +4134,7 @@ middle_end/clambda.cmx : \
     lambda/debuginfo.cmx \
     middle_end/clambda_primitives.cmx \
     middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/clambda.cmi
 middle_end/clambda.cmi : \
     typing/path.cmi \
@@ -3419,7 +4154,7 @@ middle_end/clambda_primitives.cmx : \
     typing/types.cmx \
     typing/primitive.cmx \
     lambda/lambda.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/clambda_primitives.cmi
 middle_end/clambda_primitives.cmi : \
     typing/types.cmi \
@@ -3455,6 +4190,7 @@ middle_end/compilenv.cmo : \
     utils/load_path.cmi \
     middle_end/linkage_name.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     middle_end/flambda/export_info.cmi \
     typing/env.cmi \
     utils/config.cmi \
@@ -3475,6 +4211,7 @@ middle_end/compilenv.cmx : \
     utils/load_path.cmx \
     middle_end/linkage_name.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     middle_end/flambda/export_info.cmx \
     typing/env.cmx \
     utils/config.cmx \
@@ -3490,6 +4227,7 @@ middle_end/compilenv.cmi : \
     middle_end/flambda/base_types/set_of_closures_id.cmi \
     middle_end/linkage_name.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     middle_end/flambda/export_info.cmi \
     middle_end/compilation_unit.cmi \
     file_formats/cmx_format.cmi \
@@ -3550,7 +4288,7 @@ middle_end/printclambda.cmx : \
     typing/ident.cmx \
     middle_end/clambda.cmx \
     middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/printclambda.cmi
 middle_end/printclambda.cmi : \
     middle_end/clambda.cmi
@@ -3566,7 +4304,7 @@ middle_end/printclambda_primitives.cmx : \
     typing/primitive.cmx \
     lambda/lambda.cmx \
     middle_end/clambda_primitives.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/printclambda_primitives.cmi
 middle_end/printclambda_primitives.cmi : \
     middle_end/clambda_primitives.cmi
@@ -3630,7 +4368,7 @@ lambda/debuginfo.cmx : \
     parsing/location.cmx \
     utils/int_replace_polymorphic_compare.cmx \
     typing/ident.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/debuginfo.cmi
 lambda/debuginfo.cmi : \
     parsing/location.cmi \
@@ -3658,7 +4396,7 @@ lambda/lambda.cmx : \
     typing/env.cmx \
     lambda/debuginfo.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/lambda.cmi
 lambda/lambda.cmi : \
     typing/types.cmi \
@@ -3669,6 +4407,7 @@ lambda/lambda.cmi : \
     lambda/debuginfo.cmi \
     parsing/asttypes.cmi
 lambda/matching.cmo : \
+    utils/warnings.cmi \
     typing/types.cmi \
     typing/typeopt.cmi \
     typing/typedtree.cmi \
@@ -3691,6 +4430,7 @@ lambda/matching.cmo : \
     parsing/asttypes.cmi \
     lambda/matching.cmi
 lambda/matching.cmx : \
+    utils/warnings.cmx \
     typing/types.cmx \
     typing/typeopt.cmx \
     typing/typedtree.cmx \
@@ -3710,7 +4450,7 @@ lambda/matching.cmx : \
     lambda/debuginfo.cmx \
     utils/clflags.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/matching.cmi
 lambda/matching.cmi : \
     typing/typedtree.cmi \
@@ -3738,7 +4478,7 @@ lambda/printlambda.cmx : \
     typing/ident.cmx \
     lambda/debuginfo.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/printlambda.cmi
 lambda/printlambda.cmi : \
     typing/types.cmi \
@@ -3768,7 +4508,7 @@ lambda/simplif.cmx : \
     typing/ident.cmx \
     lambda/debuginfo.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/simplif.cmi
 lambda/simplif.cmi : \
     lambda/lambda.cmi \
@@ -3784,6 +4524,7 @@ lambda/tmc.cmo : \
     parsing/location.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     lambda/debuginfo.cmi \
     parsing/asttypes.cmi \
     lambda/tmc.cmi
@@ -3793,8 +4534,9 @@ lambda/tmc.cmx : \
     parsing/location.cmx \
     lambda/lambda.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     lambda/debuginfo.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/tmc.cmi
 lambda/tmc.cmi : \
     lambda/lambda.cmi
@@ -3835,9 +4577,11 @@ lambda/translclass.cmo : \
     typing/path.cmi \
     utils/misc.cmi \
     lambda/matching.cmi \
+    parsing/longident.cmi \
     parsing/location.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     lambda/debuginfo.cmi \
     utils/clflags.cmi \
@@ -3854,14 +4598,16 @@ lambda/translclass.cmx : \
     typing/path.cmx \
     utils/misc.cmx \
     lambda/matching.cmx \
+    parsing/longident.cmx \
     parsing/location.cmx \
     lambda/lambda.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     lambda/debuginfo.cmx \
     utils/clflags.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/translclass.cmi
 lambda/translclass.cmi : \
     typing/value_rec_types.cmi \
@@ -3869,6 +4615,7 @@ lambda/translclass.cmi : \
     parsing/location.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     lambda/debuginfo.cmi \
     parsing/asttypes.cmi
 lambda/translcore.cmo : \
@@ -3884,11 +4631,13 @@ lambda/translcore.cmo : \
     typing/primitive.cmi \
     typing/predef.cmi \
     typing/path.cmi \
+    typing/out_type.cmi \
     utils/misc.cmi \
     lambda/matching.cmi \
     parsing/location.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     lambda/debuginfo.cmi \
     utils/config.cmi \
@@ -3909,17 +4658,19 @@ lambda/translcore.cmx : \
     typing/primitive.cmx \
     typing/predef.cmx \
     typing/path.cmx \
+    typing/out_type.cmx \
     utils/misc.cmx \
     lambda/matching.cmx \
     parsing/location.cmx \
     lambda/lambda.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     lambda/debuginfo.cmx \
     utils/config.cmx \
     utils/clflags.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/translcore.cmi
 lambda/translcore.cmi : \
     typing/typedtree.cmi \
@@ -3927,6 +4678,7 @@ lambda/translcore.cmi : \
     parsing/location.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     lambda/debuginfo.cmi \
     parsing/asttypes.cmi
@@ -3947,6 +4699,7 @@ lambda/translmod.cmo : \
     parsing/location.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     lambda/debuginfo.cmi \
     typing/ctype.cmi \
@@ -3970,11 +4723,12 @@ lambda/translmod.cmx : \
     parsing/location.cmx \
     lambda/lambda.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     lambda/debuginfo.cmx \
     typing/ctype.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/translmod.cmi
 lambda/translmod.cmi : \
     typing/typedtree.cmi \
@@ -4002,7 +4756,7 @@ lambda/translobj.cmx : \
     utils/config.cmx \
     utils/clflags.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/translobj.cmi
 lambda/translobj.cmi : \
     lambda/lambda.cmi \
@@ -4020,6 +4774,7 @@ lambda/translprim.cmo : \
     parsing/location.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     lambda/debuginfo.cmi \
     utils/config.cmi \
@@ -4038,11 +4793,12 @@ lambda/translprim.cmx : \
     parsing/location.cmx \
     lambda/lambda.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     lambda/debuginfo.cmx \
     utils/config.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/translprim.cmi
 lambda/translprim.cmi : \
     typing/types.cmi \
@@ -4052,6 +4808,7 @@ lambda/translprim.cmi : \
     parsing/location.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi
 lambda/value_rec_compiler.cmo : \
     typing/value_rec_types.cmi \
@@ -4071,7 +4828,7 @@ lambda/value_rec_compiler.cmx : \
     lambda/lambda.cmx \
     typing/ident.cmx \
     lambda/debuginfo.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     lambda/value_rec_compiler.cmi
 lambda/value_rec_compiler.cmi : \
     typing/value_rec_types.cmi \
@@ -4081,6 +4838,7 @@ file_formats/cmi_format.cmo : \
     typing/types.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
     utils/config.cmi \
     utils/compression.cmi \
     file_formats/cmi_format.cmi
@@ -4088,12 +4846,14 @@ file_formats/cmi_format.cmx : \
     typing/types.cmx \
     utils/misc.cmx \
     parsing/location.cmx \
+    utils/format_doc.cmx \
     utils/config.cmx \
     utils/compression.cmx \
     file_formats/cmi_format.cmi
 file_formats/cmi_format.cmi : \
     typing/types.cmi \
-    utils/misc.cmi
+    utils/misc.cmi \
+    utils/format_doc.cmi
 file_formats/cmo_format.cmi :
 file_formats/cmt_format.cmo : \
     parsing/unit_info.cmi \
@@ -4162,6 +4922,7 @@ file_formats/linear_format.cmo : \
     utils/misc.cmi \
     parsing/location.cmi \
     asmcomp/linear.cmi \
+    utils/format_doc.cmi \
     utils/config.cmi \
     asmcomp/cmm.cmi \
     file_formats/linear_format.cmi
@@ -4169,6 +4930,7 @@ file_formats/linear_format.cmx : \
     utils/misc.cmx \
     parsing/location.cmx \
     asmcomp/linear.cmx \
+    utils/format_doc.cmx \
     utils/config.cmx \
     asmcomp/cmm.cmx \
     file_formats/linear_format.cmi
@@ -4217,7 +4979,7 @@ middle_end/closure/closure.cmx : \
     middle_end/clambda.cmx \
     middle_end/backend_var.cmx \
     middle_end/backend_intf.cmi \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/closure/closure.cmi
 middle_end/closure/closure.cmi : \
     lambda/lambda.cmi \
@@ -4268,7 +5030,7 @@ middle_end/flambda/alias_analysis.cmx : \
     lambda/lambda.cmx \
     utils/int_replace_polymorphic_compare.cmx \
     middle_end/flambda/flambda.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/flambda/allocated_const.cmx \
     middle_end/flambda/alias_analysis.cmi
 middle_end/flambda/alias_analysis.cmi : \
@@ -4668,7 +5430,7 @@ middle_end/flambda/flambda.cmx : \
     middle_end/flambda/base_types/closure_id.cmx \
     utils/clflags.cmx \
     middle_end/clambda_primitives.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/flambda/allocated_const.cmx \
     middle_end/flambda/flambda.cmi
 middle_end/flambda/flambda.cmi : \
@@ -4735,7 +5497,7 @@ middle_end/flambda/flambda_invariants.cmx : \
     middle_end/compilation_unit.cmx \
     middle_end/flambda/base_types/closure_id.cmx \
     middle_end/clambda_primitives.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/flambda/allocated_const.cmx \
     middle_end/flambda/flambda_invariants.cmi
 middle_end/flambda/flambda_invariants.cmi : \
@@ -4940,7 +5702,7 @@ middle_end/flambda/flambda_utils.cmx : \
     middle_end/flambda/base_types/closure_origin.cmx \
     middle_end/flambda/base_types/closure_id.cmx \
     middle_end/clambda_primitives.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/flambda/allocated_const.cmx \
     middle_end/flambda/flambda_utils.cmi
 middle_end/flambda/flambda_utils.cmi : \
@@ -5059,7 +5821,7 @@ middle_end/flambda/inconstant_idents.cmx : \
     middle_end/compilation_unit.cmx \
     middle_end/flambda/base_types/closure_id.cmx \
     middle_end/backend_intf.cmi \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/flambda/inconstant_idents.cmi
 middle_end/flambda/inconstant_idents.cmi : \
     middle_end/variable.cmi \
@@ -5476,7 +6238,7 @@ middle_end/flambda/lift_constants.cmx : \
     middle_end/compilation_unit.cmx \
     middle_end/flambda/base_types/closure_id.cmx \
     middle_end/backend_intf.cmi \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/flambda/allocated_const.cmx \
     middle_end/flambda/alias_analysis.cmx \
     middle_end/flambda/lift_constants.cmi
@@ -5499,7 +6261,7 @@ middle_end/flambda/lift_let_to_initialize_symbol.cmx : \
     utils/int_replace_polymorphic_compare.cmx \
     middle_end/flambda/flambda_utils.cmx \
     middle_end/flambda/flambda.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/flambda/lift_let_to_initialize_symbol.cmi
 middle_end/flambda/lift_let_to_initialize_symbol.cmi : \
     middle_end/flambda/flambda.cmi \
@@ -5564,7 +6326,7 @@ middle_end/flambda/ref_to_variables.cmx : \
     utils/int_replace_polymorphic_compare.cmx \
     middle_end/flambda/flambda_iterators.cmx \
     middle_end/flambda/flambda.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/flambda/ref_to_variables.cmi
 middle_end/flambda/ref_to_variables.cmi : \
     middle_end/flambda/flambda.cmi
@@ -5808,7 +6570,7 @@ middle_end/flambda/simplify_primitives.cmx : \
     middle_end/flambda/flambda.cmx \
     utils/clflags.cmx \
     middle_end/clambda_primitives.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/flambda/simplify_primitives.cmi
 middle_end/flambda/simplify_primitives.cmi : \
     middle_end/variable.cmi \
@@ -5878,7 +6640,7 @@ middle_end/flambda/un_anf.cmx : \
     middle_end/clambda_primitives.cmx \
     middle_end/clambda.cmx \
     middle_end/backend_var.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     middle_end/flambda/un_anf.cmi
 middle_end/flambda/un_anf.cmi : \
     middle_end/symbol.cmi \
@@ -6209,6 +6971,7 @@ driver/compile_common.cmi : \
     parsing/unit_info.cmi \
     typing/typedtree.cmi \
     parsing/parsetree.cmi \
+    utils/misc.cmi \
     typing/env.cmi
 driver/compmisc.cmo : \
     utils/warnings.cmi \
@@ -6434,6 +7197,7 @@ driver/pparse.cmo : \
     parsing/parse.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
+    utils/format_doc.cmi \
     utils/config.cmi \
     utils/clflags.cmi \
     utils/ccomp.cmi \
@@ -6447,6 +7211,7 @@ driver/pparse.cmx : \
     parsing/parse.cmx \
     utils/misc.cmx \
     parsing/location.cmx \
+    utils/format_doc.cmx \
     utils/config.cmx \
     utils/clflags.cmx \
     utils/ccomp.cmx \
@@ -6454,7 +7219,8 @@ driver/pparse.cmx : \
     parsing/ast_invariants.cmx \
     driver/pparse.cmi
 driver/pparse.cmi : \
-    parsing/parsetree.cmi
+    parsing/parsetree.cmi \
+    utils/format_doc.cmi
 toplevel/expunge.cmo : \
     parsing/unit_info.cmi \
     bytecomp/symtable.cmi \
@@ -6478,11 +7244,13 @@ toplevel/genprintval.cmo : \
     typing/path.cmi \
     parsing/parse.cmi \
     typing/outcometree.cmi \
+    typing/out_type.cmi \
     typing/oprint.cmi \
     utils/misc.cmi \
     parsing/longident.cmi \
     parsing/lexer.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     typing/datarepr.cmi \
     typing/ctype.cmi \
@@ -6496,11 +7264,13 @@ toplevel/genprintval.cmx : \
     typing/path.cmx \
     parsing/parse.cmx \
     typing/outcometree.cmi \
+    typing/out_type.cmx \
     typing/oprint.cmx \
     utils/misc.cmx \
     parsing/longident.cmx \
     parsing/lexer.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     typing/datarepr.cmx \
     typing/ctype.cmx \
@@ -6531,6 +7301,7 @@ toplevel/topcommon.cmo : \
     parsing/lexer.cmi \
     typing/ident.cmi \
     toplevel/genprintval.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     bytecomp/dll.cmi \
     utils/config.cmi \
@@ -6561,6 +7332,7 @@ toplevel/topcommon.cmx : \
     parsing/lexer.cmx \
     typing/ident.cmx \
     toplevel/genprintval.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     bytecomp/dll.cmx \
     utils/config.cmx \
@@ -6568,7 +7340,7 @@ toplevel/topcommon.cmx : \
     driver/compenv.cmx \
     file_formats/cmo_format.cmi \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_helper.cmx \
     toplevel/topcommon.cmi
 toplevel/topcommon.cmi : \
@@ -6578,6 +7350,7 @@ toplevel/topcommon.cmi : \
     typing/path.cmi \
     parsing/parsetree.cmi \
     typing/outcometree.cmi \
+    typing/oprint.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
     utils/load_path.cmi \
@@ -6594,6 +7367,7 @@ toplevel/topdirs.cmo : \
     typing/predef.cmi \
     typing/path.cmi \
     parsing/parsetree.cmi \
+    typing/out_type.cmi \
     utils/misc.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
@@ -6619,6 +7393,7 @@ toplevel/topdirs.cmx : \
     typing/predef.cmx \
     typing/path.cmx \
     parsing/parsetree.cmi \
+    typing/out_type.cmx \
     utils/misc.cmx \
     parsing/longident.cmx \
     parsing/location.cmx \
@@ -6631,7 +7406,7 @@ toplevel/topdirs.cmx : \
     driver/compenv.cmx \
     utils/clflags.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_helper.cmx \
     toplevel/topdirs.cmi
 toplevel/topdirs.cmi : \
@@ -6648,6 +7423,7 @@ toplevel/toploop.cmo : \
     parsing/location.cmi \
     utils/load_path.cmi \
     parsing/lexer.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     utils/config.cmi \
     driver/compmisc.cmi \
@@ -6664,6 +7440,7 @@ toplevel/toploop.cmx : \
     parsing/location.cmx \
     utils/load_path.cmx \
     parsing/lexer.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
     utils/config.cmx \
     driver/compmisc.cmx \
@@ -6677,6 +7454,7 @@ toplevel/toploop.cmi : \
     typing/path.cmi \
     parsing/parsetree.cmi \
     typing/outcometree.cmi \
+    typing/oprint.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
     utils/load_path.cmi \
@@ -6696,7 +7474,7 @@ toplevel/topprinters.cmx : \
     typing/path.cmx \
     typing/ident.cmx \
     typing/ctype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     toplevel/topprinters.cmi
 toplevel/topprinters.cmi : \
     typing/types.cmi
@@ -6732,6 +7510,7 @@ toplevel/byte/topeval.cmo : \
     typing/persistent_env.cmi \
     parsing/parsetree.cmi \
     typing/outcometree.cmi \
+    typing/out_type.cmi \
     utils/misc.cmi \
     bytecomp/meta.cmi \
     parsing/location.cmi \
@@ -6767,6 +7546,7 @@ toplevel/byte/topeval.cmx : \
     typing/persistent_env.cmx \
     parsing/parsetree.cmi \
     typing/outcometree.cmi \
+    typing/out_type.cmx \
     utils/misc.cmx \
     bytecomp/meta.cmx \
     parsing/location.cmx \
@@ -6789,7 +7569,6 @@ toplevel/byte/topmain.cmo : \
     typing/types.cmi \
     toplevel/byte/trace.cmi \
     toplevel/toploop.cmi \
-    toplevel/byte/topeval.cmi \
     toplevel/topdirs.cmi \
     toplevel/topcommon.cmi \
     typing/printtyp.cmi \
@@ -6806,7 +7585,6 @@ toplevel/byte/topmain.cmx : \
     typing/types.cmx \
     toplevel/byte/trace.cmx \
     toplevel/toploop.cmx \
-    toplevel/byte/topeval.cmx \
     toplevel/topdirs.cmx \
     toplevel/topcommon.cmx \
     typing/printtyp.cmx \
@@ -6844,7 +7622,7 @@ toplevel/byte/trace.cmx : \
     bytecomp/meta.cmx \
     parsing/longident.cmx \
     typing/ctype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     toplevel/byte/trace.cmi
 toplevel/byte/trace.cmi : \
     typing/types.cmi \
@@ -6869,6 +7647,7 @@ toplevel/native/topeval.cmo : \
     typing/predef.cmi \
     parsing/parsetree.cmi \
     typing/outcometree.cmi \
+    typing/out_type.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
     utils/load_path.cmi \
@@ -6901,6 +7680,7 @@ toplevel/native/topeval.cmx : \
     typing/predef.cmx \
     parsing/parsetree.cmi \
     typing/outcometree.cmi \
+    typing/out_type.cmx \
     utils/misc.cmx \
     parsing/location.cmx \
     utils/load_path.cmx \
@@ -6908,7 +7688,7 @@ toplevel/native/topeval.cmx : \
     typing/includemod.cmx \
     typing/ident.cmx \
     typing/env.cmx \
-    otherlibs/dynlink/dynlink.cmi \
+    otherlibs/dynlink/dynlink.cmx \
     utils/config.cmx \
     driver/compmisc.cmx \
     middle_end/compilenv.cmx \
@@ -6942,7 +7722,7 @@ toplevel/native/tophooks.cmx : \
     lambda/lambda.cmx \
     middle_end/flambda/import_approx.cmx \
     middle_end/flambda/flambda_middle_end.cmx \
-    otherlibs/dynlink/dynlink.cmi \
+    otherlibs/dynlink/dynlink.cmx \
     utils/config.cmx \
     middle_end/compilenv.cmx \
     middle_end/closure/closure_middle_end.cmx \
@@ -6957,7 +7737,6 @@ toplevel/native/tophooks.cmi : \
     lambda/lambda.cmi
 toplevel/native/topmain.cmo : \
     toplevel/toploop.cmi \
-    toplevel/native/topeval.cmi \
     toplevel/topcommon.cmi \
     driver/main_args.cmi \
     parsing/location.cmi \
@@ -6967,7 +7746,6 @@ toplevel/native/topmain.cmo : \
     toplevel/native/topmain.cmi
 toplevel/native/topmain.cmx : \
     toplevel/toploop.cmx \
-    toplevel/native/topeval.cmx \
     toplevel/topcommon.cmx \
     driver/main_args.cmx \
     parsing/location.cmx \
@@ -7127,6 +7905,7 @@ tools/dumpobj.cmo : \
     utils/misc.cmi \
     parsing/location.cmi \
     bytecomp/instruct.cmi \
+    utils/format_doc.cmi \
     utils/config.cmi \
     utils/compression.cmi \
     file_formats/cmo_format.cmi \
@@ -7139,6 +7918,7 @@ tools/dumpobj.cmx : \
     utils/misc.cmx \
     parsing/location.cmx \
     bytecomp/instruct.cmx \
+    utils/format_doc.cmx \
     utils/config.cmx \
     utils/compression.cmx \
     file_formats/cmo_format.cmi \
@@ -7154,7 +7934,7 @@ tools/eqparsetree.cmx : \
     parsing/parsetree.cmi \
     parsing/longident.cmx \
     parsing/location.cmx \
-    parsing/asttypes.cmi
+    parsing/asttypes.cmx
 tools/gen_sizeclasses.cmo :
 tools/gen_sizeclasses.cmx :
 tools/lintapidiff.cmo : \
@@ -7199,6 +7979,7 @@ tools/objinfo.cmo : \
     parsing/location.cmi \
     middle_end/linkage_name.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     middle_end/flambda/export_info.cmi \
     middle_end/compilation_unit.cmi \
     file_formats/cmxs_format.cmi \
@@ -7221,6 +8002,7 @@ tools/objinfo.cmx : \
     parsing/location.cmx \
     middle_end/linkage_name.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     middle_end/flambda/export_info.cmx \
     middle_end/compilation_unit.cmx \
     file_formats/cmxs_format.cmi \
@@ -7390,6 +8172,11 @@ tools/stripdebug.cmx : \
     bytecomp/bytesections.cmx \
     tools/stripdebug.cmi
 tools/stripdebug.cmi :
+tools/sync_dynlink.cmo : \
+    tools/sync_dynlink.cmi
+tools/sync_dynlink.cmx : \
+    tools/sync_dynlink.cmi
+tools/sync_dynlink.cmi :
 debugger/breakpoints.cmo : \
     debugger/symbols.cmi \
     debugger/pos.cmi \
@@ -7534,9 +8321,11 @@ debugger/debugger_config.cmx : \
     debugger/debugger_config.cmi
 debugger/debugger_config.cmi :
 debugger/debugger_lexer.cmo : \
+    utils/misc.cmi \
     debugger/debugger_parser.cmi \
     debugger/debugger_lexer.cmi
 debugger/debugger_lexer.cmx : \
+    utils/misc.cmx \
     debugger/debugger_parser.cmx \
     debugger/debugger_lexer.cmi
 debugger/debugger_lexer.cmi : \
@@ -7572,6 +8361,7 @@ debugger/eval.cmo : \
     bytecomp/instruct.cmi \
     typing/ident.cmi \
     debugger/frames.cmi \
+    utils/format_doc.cmi \
     debugger/events.cmi \
     typing/env.cmi \
     debugger/debugcom.cmi \
@@ -7592,6 +8382,7 @@ debugger/eval.cmx : \
     bytecomp/instruct.cmx \
     typing/ident.cmx \
     debugger/frames.cmx \
+    utils/format_doc.cmx \
     debugger/events.cmx \
     typing/env.cmx \
     debugger/debugcom.cmx \
@@ -7680,6 +8471,7 @@ debugger/loadprinter.cmo : \
     parsing/longident.cmi \
     utils/load_path.cmi \
     typing/ident.cmi \
+    utils/format_doc.cmi \
     typing/env.cmi \
     otherlibs/dynlink/dynlink.cmi \
     typing/ctype.cmi \
@@ -7697,8 +8489,9 @@ debugger/loadprinter.cmx : \
     parsing/longident.cmx \
     utils/load_path.cmx \
     typing/ident.cmx \
+    utils/format_doc.cmx \
     typing/env.cmx \
-    otherlibs/dynlink/dynlink.cmi \
+    otherlibs/dynlink/dynlink.cmx \
     typing/ctype.cmx \
     file_formats/cmo_format.cmi \
     debugger/loadprinter.cmi
@@ -8056,7 +8849,7 @@ ocamldoc/odoc.cmx : \
     ocamldoc/odoc_config.cmx \
     ocamldoc/odoc_args.cmx \
     ocamldoc/odoc_analyse.cmx \
-    otherlibs/dynlink/dynlink.cmi \
+    otherlibs/dynlink/dynlink.cmx \
     ocamldoc/odoc.cmi
 ocamldoc/odoc.cmi :
 ocamldoc/odoc_analyse.cmo : \
@@ -8198,7 +8991,7 @@ ocamldoc/odoc_ast.cmx : \
     parsing/location.cmx \
     typing/ident.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     ocamldoc/odoc_ast.cmi
 ocamldoc/odoc_ast.cmi : \
     typing/types.cmi \
@@ -8396,7 +9189,7 @@ ocamldoc/odoc_extension.cmx : \
     ocamldoc/odoc_types.cmx \
     ocamldoc/odoc_type.cmx \
     ocamldoc/odoc_name.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     ocamldoc/odoc_extension.cmi
 ocamldoc/odoc_extension.cmi : \
     typing/types.cmi \
@@ -8463,7 +9256,7 @@ ocamldoc/odoc_html.cmx : \
     ocamldoc/odoc_global.cmx \
     ocamldoc/odoc_dag2html.cmx \
     utils/misc.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     ocamldoc/odoc_html.cmi
 ocamldoc/odoc_html.cmi : \
     typing/types.cmi \
@@ -8473,7 +9266,7 @@ ocamldoc/odoc_html.cmi : \
     ocamldoc/odoc_dag2html.cmi \
     utils/misc.cmi
 ocamldoc/odoc_info.cmo : \
-    typing/printtyp.cmi \
+    typing/out_type.cmi \
     ocamldoc/odoc_value.cmi \
     ocamldoc/odoc_types.cmi \
     ocamldoc/odoc_type.cmi \
@@ -8497,7 +9290,7 @@ ocamldoc/odoc_info.cmo : \
     parsing/location.cmi \
     ocamldoc/odoc_info.cmi
 ocamldoc/odoc_info.cmx : \
-    typing/printtyp.cmx \
+    typing/out_type.cmx \
     ocamldoc/odoc_value.cmx \
     ocamldoc/odoc_types.cmx \
     ocamldoc/odoc_type.cmx \
@@ -8549,7 +9342,7 @@ ocamldoc/odoc_latex.cmx : \
     ocamldoc/odoc_messages.cmx \
     ocamldoc/odoc_latex_style.cmx \
     ocamldoc/odoc_info.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     ocamldoc/odoc_latex.cmi
 ocamldoc/odoc_latex.cmi : \
     typing/types.cmi \
@@ -8567,6 +9360,7 @@ ocamldoc/odoc_lexer.cmo : \
     ocamldoc/odoc_messages.cmi \
     ocamldoc/odoc_global.cmi \
     ocamldoc/odoc_comments_global.cmi \
+    utils/misc.cmi \
     ocamldoc/odoc_lexer.cmi
 ocamldoc/odoc_lexer.cmx : \
     otherlibs/str/str.cmx \
@@ -8574,6 +9368,7 @@ ocamldoc/odoc_lexer.cmx : \
     ocamldoc/odoc_messages.cmx \
     ocamldoc/odoc_global.cmx \
     ocamldoc/odoc_comments_global.cmx \
+    utils/misc.cmx \
     ocamldoc/odoc_lexer.cmi
 ocamldoc/odoc_lexer.cmi : \
     ocamldoc/odoc_parser.cmi
@@ -8595,7 +9390,7 @@ ocamldoc/odoc_man.cmx : \
     ocamldoc/odoc_misc.cmx \
     ocamldoc/odoc_messages.cmx \
     ocamldoc/odoc_info.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     ocamldoc/odoc_man.cmi
 ocamldoc/odoc_man.cmi : \
     typing/types.cmi \
@@ -8716,9 +9511,11 @@ ocamldoc/odoc_name.cmi : \
     typing/ident.cmi
 ocamldoc/odoc_ocamlhtml.cmo : \
     otherlibs/str/str.cmi \
+    utils/misc.cmi \
     ocamldoc/odoc_ocamlhtml.cmi
 ocamldoc/odoc_ocamlhtml.cmx : \
     otherlibs/str/str.cmx \
+    utils/misc.cmx \
     ocamldoc/odoc_ocamlhtml.cmi
 ocamldoc/odoc_ocamlhtml.cmi :
 ocamldoc/odoc_parameter.cmo : \
@@ -8745,11 +9542,13 @@ ocamldoc/odoc_parser.cmi : \
 ocamldoc/odoc_print.cmo : \
     typing/types.cmi \
     typing/printtyp.cmi \
+    typing/out_type.cmi \
     typing/btype.cmi \
     ocamldoc/odoc_print.cmi
 ocamldoc/odoc_print.cmx : \
     typing/types.cmx \
     typing/printtyp.cmx \
+    typing/out_type.cmx \
     typing/btype.cmx \
     ocamldoc/odoc_print.cmi
 ocamldoc/odoc_print.cmi : \
@@ -8867,7 +9666,7 @@ ocamldoc/odoc_sig.cmx : \
     typing/ident.cmx \
     typing/ctype.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     ocamldoc/odoc_sig.cmi
 ocamldoc/odoc_sig.cmi : \
     typing/types.cmi \
@@ -8883,6 +9682,7 @@ ocamldoc/odoc_sig.cmi : \
 ocamldoc/odoc_str.cmo : \
     typing/types.cmi \
     typing/printtyp.cmi \
+    typing/out_type.cmi \
     ocamldoc/odoc_value.cmi \
     ocamldoc/odoc_type.cmi \
     ocamldoc/odoc_print.cmi \
@@ -8897,6 +9697,7 @@ ocamldoc/odoc_str.cmo : \
 ocamldoc/odoc_str.cmx : \
     typing/types.cmx \
     typing/printtyp.cmx \
+    typing/out_type.cmx \
     ocamldoc/odoc_value.cmx \
     ocamldoc/odoc_type.cmx \
     ocamldoc/odoc_print.cmx \
@@ -8906,7 +9707,7 @@ ocamldoc/odoc_str.cmx : \
     ocamldoc/odoc_extension.cmx \
     ocamldoc/odoc_exception.cmx \
     ocamldoc/odoc_class.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     ocamldoc/odoc_str.cmi
 ocamldoc/odoc_str.cmi : \
     typing/types.cmi \
@@ -8940,7 +9741,7 @@ ocamldoc/odoc_texi.cmx : \
     ocamldoc/odoc_to_text.cmx \
     ocamldoc/odoc_messages.cmx \
     ocamldoc/odoc_info.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     ocamldoc/odoc_texi.cmi
 ocamldoc/odoc_texi.cmi : \
     typing/types.cmi \
@@ -9012,7 +9813,7 @@ ocamldoc/odoc_type.cmx : \
     typing/types.cmx \
     ocamldoc/odoc_types.cmx \
     ocamldoc/odoc_name.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     ocamldoc/odoc_type.cmi
 ocamldoc/odoc_type.cmi : \
     typing/types.cmi \
@@ -9043,7 +9844,7 @@ ocamldoc/odoc_value.cmx : \
     ocamldoc/odoc_parameter.cmx \
     ocamldoc/odoc_name.cmx \
     ocamldoc/odoc_misc.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     ocamldoc/odoc_value.cmi
 ocamldoc/odoc_value.cmi : \
     typing/types.cmi \
@@ -9628,7 +10429,7 @@ testsuite/tools/expect.cmx : \
     driver/compenv.cmx \
     utils/clflags.cmx \
     typing/btype.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     parsing/ast_mapper.cmx \
     testsuite/tools/expect.cmi
 testsuite/tools/expect.cmi : \
@@ -9666,7 +10467,7 @@ testsuite/tools/parsecmm.cmx : \
     lambda/debuginfo.cmx \
     utils/config.cmx \
     asmcomp/cmm.cmx \
-    parsing/asttypes.cmi \
+    parsing/asttypes.cmx \
     asmcomp/arch.cmx \
     testsuite/tools/parsecmm.cmi
 testsuite/tools/parsecmm.cmi : \
@@ -9689,3 +10490,54 @@ testsuite/tools/parsecmmaux.cmi : \
     parsing/location.cmi \
     lambda/debuginfo.cmi \
     middle_end/backend_var.cmi
+otherlibs/dynlink/byte/dynlink.cmo : \
+    otherlibs/dynlink/dynlink_types.cmi \
+    otherlibs/dynlink/byte/dynlink_symtable.cmi \
+    otherlibs/dynlink/dynlink_config.cmi \
+    otherlibs/dynlink/dynlink_common.cmi \
+    otherlibs/dynlink/dynlink_cmo_format.cmi \
+    otherlibs/dynlink/byte/dynlink.cmi
+otherlibs/dynlink/byte/dynlink.cmi :
+otherlibs/dynlink/byte/dynlink_symtable.cmo : \
+    otherlibs/dynlink/dynlink_config.cmi \
+    otherlibs/dynlink/dynlink_cmo_format.cmi \
+    otherlibs/dynlink/byte/dynlink_symtable.cmi
+otherlibs/dynlink/byte/dynlink_symtable.cmi : \
+    otherlibs/dynlink/dynlink_cmo_format.cmi
+otherlibs/dynlink/dynlink.cmi :
+otherlibs/dynlink/dynlink_cmo_format.cmi :
+otherlibs/dynlink/dynlink_cmxs_format.cmi :
+otherlibs/dynlink/dynlink_common.cmo : \
+    otherlibs/dynlink/dynlink_types.cmi \
+    otherlibs/dynlink/dynlink_platform_intf.cmi \
+    otherlibs/dynlink/dynlink_common.cmi
+otherlibs/dynlink/dynlink_common.cmi : \
+    otherlibs/dynlink/dynlink_platform_intf.cmi
+otherlibs/dynlink/dynlink_config.cmo : \
+    otherlibs/dynlink/dynlink_config.cmi
+otherlibs/dynlink/dynlink_config.cmi :
+otherlibs/dynlink/dynlink_platform_intf.cmo : \
+    otherlibs/dynlink/dynlink_types.cmi \
+    otherlibs/dynlink/dynlink_platform_intf.cmi
+otherlibs/dynlink/dynlink_platform_intf.cmi : \
+    otherlibs/dynlink/dynlink_types.cmi
+otherlibs/dynlink/dynlink_types.cmo : \
+    otherlibs/dynlink/dynlink_types.cmi
+otherlibs/dynlink/dynlink_types.cmi :
+otherlibs/dynlink/dynlink_common.cmx : \
+    otherlibs/dynlink/dynlink_types.cmx \
+    otherlibs/dynlink/dynlink_platform_intf.cmx \
+    otherlibs/dynlink/dynlink_common.cmi
+otherlibs/dynlink/dynlink_config.cmx : \
+    otherlibs/dynlink/dynlink_config.cmi
+otherlibs/dynlink/dynlink_platform_intf.cmx : \
+    otherlibs/dynlink/dynlink_types.cmx \
+    otherlibs/dynlink/dynlink_platform_intf.cmi
+otherlibs/dynlink/dynlink_types.cmx : \
+    otherlibs/dynlink/dynlink_types.cmi
+otherlibs/dynlink/native/dynlink.cmx : \
+    otherlibs/dynlink/dynlink_types.cmx \
+    otherlibs/dynlink/dynlink_config.cmx \
+    otherlibs/dynlink/dynlink_common.cmx \
+    otherlibs/dynlink/dynlink_cmxs_format.cmi \
+    otherlibs/dynlink/native/dynlink.cmi

diff --git a/.gitattributes b/.gitattributes
index 0693c28cfb43c373fadc02d300a9fc03aee4428a..b179697031305c44b9d43ca903991baedd8fb0fa 100644 (file)
--- a/.gitattributes
+++ b/.gitattributes
@@ -17,7 +17,7 @@
 * text=auto
 
 # It is not possible to wrap lines lines in .gitattributes files
-.gitattributes typo.long-line=may
+.gitattributes typo.long-line=may typo.utf8
 
 # Binary files
 /boot/ocamlc binary
@@ -75,14 +75,15 @@ META.in                  typo.missing-header
 .depend                  typo.prune
 /.depend.menhir          typo.prune
 
-# These can be fixed at some point
-/tools/*.py              typo.long-line
-
 # Makefiles may contain tabs
 Makefile*                typo.makefile-whitespace=may
 
 asmcomp/*/emit.mlp       typo.tab=may typo.long-line=may
 
+# Unicode character used for graphical debugging and box drawing
+typing/gprinttyp.mli     typo.utf8
+typing/gprinttyp.ml      typo.utf8
+
 # The build-aux directory contains bundled files so do not check it
 build-aux                typo.prune
 
@@ -103,6 +104,8 @@ otherlibs/unix/readlink_win32.c    typo.long-line
 otherlibs/unix/stat_win32.c        typo.long-line
 otherlibs/unix/symlink_win32.c     typo.long-line
 
+# Some Unicode characters here and there
+utils/misc.ml            typo.utf8
 runtime/sak.c            typo.non-ascii
 
 stdlib/hashbang     typo.white-at-eol typo.missing-lf
@@ -111,8 +114,15 @@ testsuite/tests/**                                      typo.missing-header typo
 testsuite/tests/lib-bigarray-2/bigarrf.f                typo.tab linguist-language=Fortran
 testsuite/tests/lib-unix/win-stat/fakeclock.c           typo.missing-header=false
 testsuite/tests/misc-unsafe/almabench.ml                typo.long-line
+testsuite/tests/parsing/latin9.ml                       typo.utf8 typo.very-long-line
+testsuite/tests/parsing/comments.ml                     typo.utf8
+testsuite/tests/tool-ocamldoc/Latin9.ml                 typo.utf8
+testsuite/tests/parsetree/source.ml                     typo.utf8
+testsuite/tests/typing-unicode/*.ml                     typo.utf8
 testsuite/tests/tool-toplevel/strings.ml                typo.utf8
 testsuite/tests/win-unicode/*.ml                        typo.utf8
+testsuite/tests/unicode/見.ml                           typo.utf8
+testsuite/tests/lexing/reject_bad_encoding.ml           typo.prune
 testsuite/tests/asmgen/immediates.cmm                   typo.very-long-line
 testsuite/tests/generated-parse-errors/errors.*         typo.very-long-line
 testsuite/tools/*.S                                     typo.missing-header
@@ -196,12 +206,13 @@ tools/ci/inria/step-by-step-build/script text eol=lf
 tools/check-typo text eol=lf
 tools/check-symbol-names text eol=lf
 tools/msvs-promote-path text eol=lf
-tools/gdb-macros text eol=lf linguist-language=GDB
 tools/magic text eol=lf
 tools/ocamlsize text eol=lf
 tools/pre-commit-githook text eol=lf
 runtime/caml/sizeclasses.h typo.missing-header
 
+/tools/gdb_ocamlrun.py typo.long-line
+
 # Tests which include references spanning multiple lines fail with \r\n
 # endings, so use \n endings only, even on Windows.
 testsuite/tests/basic-modules/anonymous.ml text eol=lf

diff --git a/.github/workflows/build-msvc.yml b/.github/workflows/build-msvc.yml
new file mode 100644 (file)
index 0000000..ecc762f
--- /dev/null
+++ b/.github/workflows/build-msvc.yml
@@ -0,0 +1,138 @@
+name: Build with MSVC
+
+concurrency:
+  group: ${{ github.workflow }}-${{ github.head_ref || github.run_id }}
+  cancel-in-progress: true
+
+on:
+  push:
+    branches:
+      - '4.**'
+      - '5.**'
+      - 'trunk'
+  pull_request:
+
+# env:
+  # Fully print commands executed by Make
+  # MAKEFLAGS: V=1
+
+jobs:
+  build:
+    permissions: {}
+
+    runs-on: windows-latest
+
+    timeout-minutes: 60
+
+    name: ${{ matrix.cc == 'cl' && 'MSVC' || 'clang-cl' }} ${{ matrix.x86_64 && '64 bits' || '32 bits' }}
+
+    strategy:
+      matrix:
+        x86_64: [true, false]
+        cc: [cl, clang-cl]
+        exclude:
+          - cc: clang-cl
+            x86_64: false
+
+    steps:
+      - name: Save pristine PATH
+        run: |
+          echo "PRISTINE_PATH=${env:Path}" >> "${env:GITHUB_ENV}"
+
+      - name: Set up MSVC
+        uses: ilammy/msvc-dev-cmd@v1
+        with:
+          arch: ${{ matrix.x86_64 && 'x64' || 'x86' }}
+
+      - name: Fetch OCaml
+        uses: actions/checkout@v4
+        with:
+          submodules: true
+
+      - name: Restore Cygwin cache
+        uses: actions/cache/restore@v4
+        env:
+          PATH: ${{ env.PRISTINE_PATH }}
+        with:
+          path: |
+            C:\cygwin-packages
+          key: cygwin-packages
+
+      - name: Install Cygwin
+        uses: cygwin/cygwin-install-action@v3
+        with:
+          packages: make,bash,mingw64-x86_64-gcc-core
+          install-dir: 'D:\cygwin'
+
+      - name: Save Cygwin cache
+        uses: actions/cache/save@v4
+        env:
+          PATH: ${{ env.PRISTINE_PATH }}
+        with:
+          path: |
+            C:\cygwin-packages
+          key: cygwin-packages
+
+      - name: Compute a key to cache configure results
+        shell: bash
+        env:
+          HOST: ${{ matrix.x86_64 && 'x86_64-pc-windows' || 'i686-pc-windows' }}
+          CC: ${{ matrix.cc }}
+        run: >-
+          echo "AUTOCONF_CACHE_KEY=$HOST-$CC-$({ cat configure; uname; } | sha1sum | cut -c 1-7)" >> $GITHUB_ENV
+
+      - name: Restore Autoconf cache
+        uses: actions/cache/restore@v4
+        with:
+          path: |
+            config.cache
+          key: ${{ env.AUTOCONF_CACHE_KEY }}
+
+      - name: Build OCaml
+        shell: bash
+        env:
+          HOST: ${{ matrix.x86_64 && 'x86_64-pc-windows' || 'i686-pc-windows' }}
+          CC: ${{ matrix.cc }}
+        run: >-
+          eval $(tools/msvs-promote-path) ;
+          if ! ./configure --cache-file=config.cache --host=$HOST CC=$CC ; then
+          rm -rf config.cache ;
+          failed=0 ;
+          ./configure --cache-file=config.cache --host=$HOST CC=$CC \
+          || failed=$?;
+          if ((failed)) ; then cat config.log ; exit $failed ; fi ;
+          fi ;
+          make -j || failed=$? ;
+          if ((failed)) ; then make -j1 V=1 ; exit $failed ; fi ;
+          runtime/ocamlrun ocamlc -config ;
+        # Don't add indentation or comments, it breaks Bash on
+        # Windows when the yaml text block scalar is processed as a
+        # single line.
+
+      - name: Save Autoconf cache
+        uses: actions/cache/save@v4
+        with:
+          path: |
+            config.cache
+          key: ${{ env.AUTOCONF_CACHE_KEY }}
+
+      - name: Assemble backend with MinGW GASM and compare
+        shell: bash
+        run: >-
+          x86_64-w64-mingw32-gcc -c -I./runtime  -I ./flexdll -D__USE_MINGW_ANSI_STDIO=0 -DUNICODE -D_UNICODE -DWINDOWS_UNICODE=1 -DCAMLDLLIMPORT= -DIN_CAML_RUNTIME -DNATIVE_CODE -DTARGET_amd64 -DMODEL_default -DSYS_mingw64 -o runtime/amd64.o runtime/amd64.S ;
+          dumpbin /disasm:nobytes runtime/amd64nt.obj > runtime/amd64nt.dump ;
+          awk -f tools/ci/actions/canonicalize-dumpbin.awk runtime/amd64nt.dump runtime/amd64nt.dump > runtime/amd64nt.canonical ;
+          dumpbin /disasm:nobytes runtime/amd64.o > runtime/amd64.dump ;
+          awk -f tools/ci/actions/canonicalize-dumpbin.awk runtime/amd64.dump runtime/amd64.dump > runtime/amd64.canonical ;
+          git diff --no-index -- runtime/amd64*.canonical ;
+          wc -l runtime/amd64*.dump runtime/amd64*.canonical ;
+        # ^ The final wc is there to make sure that the canonical files are
+        # reasonable cleaned-up versions of the raw dumpbins and not simply
+        # empty
+        if: matrix.x86_64
+
+      - name: Run the test suite
+        shell: bash
+        run: >-
+          eval $(tools/msvs-promote-path) ;
+          make -j tests ;

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index fbc58f89a2a4893a64618215128236c937d83f3f..f65cfb05e5f9db0d5d9161fd27316b118a2712e4 100644 (file)
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -87,7 +87,7 @@ jobs:
         include:
           - id: normal
             name: normal
-            dependencies: texlive-latex-extra texlive-fonts-recommended hevea sass
+            dependencies: texlive-latex-extra texlive-fonts-recommended texlive-luatex hevea sass
           - id: debug
             name: extra (debug)
           - id: debug-s4096

diff --git a/.github/workflows/stale.yml b/.github/workflows/stale.yml
new file mode 100644 (file)
index 0000000..bed161e
--- /dev/null
+++ b/.github/workflows/stale.yml
@@ -0,0 +1,18 @@
+name: "Close stale issues"
+on:
+  schedule:
+  - cron: "15 4 * * 1,3,5"
+
+jobs:
+  stale:
+    runs-on: ubuntu-latest
+    permissions:
+      issues: write
+    steps:
+    - uses: actions/stale@v8
+      with:
+        repo-token: ${{ secrets.GITHUB_TOKEN }}
+        stale-issue-message: 'This issue has been open one year with no activity.  Consequently, it is being marked with the "stale" label.  What this means is that the issue will be automatically closed in 30 days unless more comments are added or the "stale" label is removed.  Comments that provide new information on the issue are especially welcome: is it still reproducible? did it appear in other contexts? how critical is it? etc.'
+        days-before-stale: 366
+        days-before-close: 30
+        exempt-issue-labels: 'bug'

diff --git a/.github/workflows/tsan.yml b/.github/workflows/tsan.yml
new file mode 100644 (file)
index 0000000..92e1501
--- /dev/null
+++ b/.github/workflows/tsan.yml
@@ -0,0 +1,100 @@
+# Build the compiler and run the testsuite with ThreadSanitizer, if PR is
+# labelled with run-thread-sanitizer
+name: Run testsuite with ThreadSanitizer
+on:
+  pull_request:
+    types: [opened, synchronize, reopened, labeled, unlabeled]
+
+# Restrict the GITHUB_TOKEN
+permissions: {}
+
+# https://docs.github.com/en/actions/using-workflows/workflow-syntax-for-github-actions#concurrency
+# Concurrent workflows are grouped by the PR or branch that triggered them
+# (github.ref) and the name of the workflow (github.workflow). The
+# 'cancel-in-progress' option then make sure that only one workflow is running
+# at a time. This doesn't prevent new jobs from running, rather it cancels
+# already running jobs before scheduling new jobs.
+concurrency:
+  group: ${{ github.workflow }}-${{ github.ref }}-${{ github.event_name == 'pull_request' || github.sha }}
+  cancel-in-progress: true
+
+jobs:
+# This job will do the initial build of the compiler (on linux).
+# We then upload the compiler tree as a build artifact to enable re-use in
+# subsequent jobs.
+  build:
+    if: contains(github.event.pull_request.labels.*.name, 'run-thread-sanitizer')
+    runs-on: 'ubuntu-latest'
+    outputs:
+      manual_changed: ${{ steps.manual.outputs.manual_changed }}
+    steps:
+      - name: Checkout
+        uses: actions/checkout@v4
+        with:
+          persist-credentials: false
+      - name: Install libunwind
+        run: sudo apt install -y libunwind-dev
+      # This temporary workaround reduces the number of random bits for the base
+      # address of vma regions for mmap allocation, to avoid the
+      # "FATAL: ThreadSanitizer: unexpected memory mapping" TSan error.
+      # See:  https://github.com/google/sanitizers/issues/1716
+      - name: Tune vm.mmap_rnd_bits value for TSan
+        run: sudo sysctl vm.mmap_rnd_bits=28
+      - name: Configure tree
+        run: |
+          MAKE_ARG=-j CONFIG_ARG='--enable-cmm-invariants --enable-dependency-generation --enable-native-toplevel --enable-tsan --enable-ocamltest CPPFLAGS=-DTSAN_INSTRUMENT_ALL' OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh configure
+      - name: Build
+        run: |
+          MAKE_ARG=-j bash -xe tools/ci/actions/runner.sh build
+      - name: Prepare Artifact
+        run: tar --zstd -cf /tmp/sources.tar.zstd .
+      - name: Upload Artifact
+        uses: actions/upload-artifact@v4
+        with:
+          name: compiler
+          path: /tmp/sources.tar.zstd
+          retention-days: 1
+
+# Testsuite run jobs:
+# normal: Run the full testsuite
+# debug: Run the full testsuite with the debug runtime and minor heap
+#        verification.
+  normal:
+    if: contains(github.event.pull_request.labels.*.name, 'run-thread-sanitizer')
+    name: ${{ matrix.name }}
+    needs: build
+    runs-on: ubuntu-latest
+    strategy:
+      matrix:
+        include:
+          - id: normal
+            name: normal
+            dependencies: libunwind-dev
+          - id: debug
+            name: debug runtime
+            dependencies: libunwind-dev
+    steps:
+      - name: Download Artifact
+        uses: actions/download-artifact@v4
+        with:
+          name: compiler
+      - name: Unpack Artifact
+        run: |
+          tar --zstd -xf sources.tar.zstd
+          rm -f sources.tar.zstd
+      - name: Packages
+        if: matrix.dependencies != ''
+        run: |
+          sudo apt-get update -y && sudo apt-get install -y ${{ matrix.dependencies }}
+      - name: Run the testsuite
+        if: matrix.id == 'normal'
+        # Run testsuite with 30-minute timeout per test
+        run: |
+          TIMEOUT=1800 TSAN_OPTIONS=history_size=6 OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh test_sequential
+      - name: Run the testsuite (debug runtime)
+        if: matrix.id == 'debug'
+        env:
+          OCAMLRUNPARAM: v=0,V=1
+          USE_RUNTIME: d
+        run: |
+          bash -cxe "TSAN_OPTIONS=history_size=6 SHOW_TIMINGS=1 tools/ci/actions/runner.sh test_sequential"

diff --git a/.gitignore b/.gitignore
index 240a51e54152c1166d0238247f531455bbeace24..5cec38960f9fa8eb4c5bf79f4922c2ec06df84d6 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -38,6 +38,8 @@ _ocamltestd
 .merlin
 _build
 META
+# Ignore foo.depend, but not .depend
+?*.depend
 
 # local to root directory
 
@@ -92,6 +94,7 @@ META
 /emacs/*.elc
 
 /flexdll-sources
+/winpthreads-sources
 
 /lambda/runtimedef.ml
 
@@ -209,13 +212,12 @@ META
 /opt/**
 
 /otherlibs/*/.dep
+/otherlibs/dynlink/dynlink_config.ml
+/otherlibs/dynlink/dynlink_cmo_format.mli
+/otherlibs/dynlink/dynlink_cmxs_format.mli
 /otherlibs/dynlink/dynlink_platform_intf.mli
 /otherlibs/dynlink/byte/dynlink.mli
 /otherlibs/dynlink/native/dynlink.mli
-/otherlibs/dynlink/dynlink_compilerlibs/Makefile
-/otherlibs/dynlink/dynlink_compilerlibs/*.ml
-/otherlibs/dynlink/dynlink_compilerlibs/*.mli
-/otherlibs/dynlink/dynlink_compilerlibs/.depend
 /otherlibs/unix/unix.ml
 
 /parsing/parser.ml
@@ -308,6 +310,7 @@ META
 /tools/ocamltex
 /tools/eventlog_metadata
 /tools/lintapidiff.opt
+/tools/sync_dynlink.opt
 
 /toplevel/byte/topeval.mli
 /toplevel/byte/trace.mli

diff --git a/.gitmodules b/.gitmodules
index 67c9558a1606f2dc57b10ea46018b173fd022ba0..d69d2a4d5ad3603435459480e8144088314bf579 100644 (file)
--- a/.gitmodules
+++ b/.gitmodules
@@ -1,3 +1,6 @@
 [submodule "flexdll"]
     path = flexdll
     url = https://github.com/ocaml/flexdll.git
+[submodule "winpthreads"]
+    path = winpthreads
+    url = https://github.com/ocaml/winpthreads.git

diff --git a/.mailmap b/.mailmap
index 465449bab4955a6c7078ed29eca58551c7483e96..1159a14b69307e358ed84c72695ca2bd79407837 100644 (file)
--- a/.mailmap
+++ b/.mailmap
@@ -139,6 +139,8 @@ Runhang Li <objmagic@github>
 Dmitrii Kosarev <Kakadu@github>
 Samuel Hym <shym@github>
 B. Szilvasy <eutro@github>
+Hazem Elmasry <hyphens@pm.me>
+Hazem Elmasry <hyphenrf@github>
 
 # These contributors prefer to be referred to pseudonymously
 whitequark <whitequark@whitequark.org>

diff --git a/BOOTSTRAP.adoc b/BOOTSTRAP.adoc
index 70db0d0ea8593f15f278fbeab41c2029b99bf762..111723e4fdfa3488be4338096ed1510f23e06006 100644 (file)
--- a/BOOTSTRAP.adoc
+++ b/BOOTSTRAP.adoc
@@ -97,6 +97,19 @@ There are five steps to renaming a primitive:
 It is desirable for bootstraps to be easily repeatable, so you should commit
 changes after step 4.
 
+To remove a primitive:
+
+1. Start with a working build of the compiler eg `./configure && make world`
+
+2. Remove uses of the primitive, but not the primitive itself. Then ensure the system still works:
+
+        make coreall
+
+3. Then, and only then, remove the primitive, and run:
+
+        make coreall
+        make bootstrap
+
 = Bootstrap test script
 
 A script is provided (and used on Inria's continuous

diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index 1e187be1b3c10b4f1feb9861d7096a869eb96835..5a13617b8b7410c8fd594b7a48e1f3579f2ed1a9 100644 (file)
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -60,15 +60,16 @@ contribution.
 
 The current list of maintainers is as follows:
 
+- @abbysmal Abigael
 - @alainfrisch Alain Frisch
 - @Armael Armaël Guéneau
 - @avsm Anil Madhavapeddy
 - @chambart Pierre Chambart
 - @damiendoligez Damien Doligez
 - @dra27 David Allsopp
-- @Engil Enguerrand
 - @garrigue Jacques Garrigue
 - @gasche Gabriel Scherer
+- @goldfirere Richard Eisenberg
 - @jhjourdan Jacques-Henri Jourdan
 - @kayceesrk KC Sivaramakrishnan
 - @let-def Frédéric Bour
@@ -78,6 +79,7 @@ The current list of maintainers is as follows:
 - @mshinwell Mark Shinwell
 - @nojb Nicolás Ojeda Bär
 - @Octachron Florian Angeletti
+- @OlivierNicole Olivier Nicole
 - @sadiqj Sadiq Jaffer
 - @shindere Sébastien Hinderer
 - @stedolan Stephen Dolan
@@ -90,6 +92,9 @@ page](https://github.com/orgs/ocaml/teams/ocaml-dev/members), plus
 Anil as co-owner of the github/ocaml/ organization. Oddly enough,
 Github does not make the page publicly accessible. -->
 
+### Releases
+
+For more information about when and how new releases are published, see [the release introduction](release-info/introduction.md).
 
 ## Coding guidelines
 
@@ -407,7 +412,7 @@ We distinguish two kind of contributions:
   (as requested by the Free Software Foundation for example),
   contributors retain the copyright on their contribution, and can use
   it as they see fit. The OCaml CLA is lightly adapted from [the
-  CLA](https://www.apache.org/licenses/icla.txt) of the Apache
+  CLA](https://apache.org/licenses/icla.pdf) of the Apache
   Foundation, and is available in two versions: [for individual
   contributors](http://caml.inria.fr/pub/docs/CLA-individual.doc) and
   [for corporations](http://caml.inria.fr/pub/docs/CLA-corporate.doc).

diff --git a/Changes b/Changes
index 5e0282b97de96830c3ddb8fae60296b96538ac3a..971216bb0d69a6eafa9e5eccd40af512747694c7 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,594 @@
-OCaml 5.2.1 (18 November 2024)
-------------------------------
+OCaml 5.3.0 (8 January 2025)
+----------------------------
+
+(Changes that can break existing programs are marked with a "*")
+
+### Restored backend:
+
+- #12954: Restore the MSVC port
+  (David Allsopp, Antonin Décimo, Samuel Hym, and Miod Vallat, review by Nicolás
+   Ojeda Bär)
+
+- #13093: Allow building the MSVC port with clang-cl.
+  (Antonin Décimo, review by Nicolás Ojeda Bär, Samuel Hym,
+   David Allsopp and Sébastien Hinderer)
+
+### Language features:
+
+- #12828, #13283: Add short syntax for dependent functor types `(X:A) -> ...`
+  (Jeremy Yallop, review by Nicolás Ojeda Bär and Gabriel Scherer)
+
+- #12309, #13158: Add syntax support for deep effect handlers
+  (Leo White, Tom Kelly, Anil Madhavapeddy, KC Sivaramakrishnan, Xavier Leroy
+   and Florian Angeletti, review by the same, Hugo Heuzard, and Ulysse Gérard)
+
+- #11736, #12664, #13628: Support utf-8 encoded source files and latin-9
+  compatible identifiers.
+  (Xavier Leroy and Florian Angeletti, review by Daniel Bünzli and
+   Jules Aguillon)
+
+### Type system
+
+- #11891, #12507: Allow to name new locally abstract types in constructor type
+  annotations.
+  (Jacques Garrigue, report and review by Gabriel Scherer and Florian Angeletti)
+
+### Runtime system:
+
+- #13419: Fix memory bugs in runtime events system.
+  (B. Szilvasy and Nick Barnes, review by Miod Vallat, Nick Barnes,
+   Tim McGilchrist, and Gabriel Scherer)
+
+- #13364: Emit major slice counters in the runtime events.
+  (KC Sivaramakrishnan and Sadiq Jaffer, review by Gabriel Scherer)
+
+- #13382: Add more documentation for Runtime_events types
+  (Sadiq Jaffer, review by Tim McGilchrist, Miod Vallat and KC Sivaramakrishnan)
+
+- #13370: Fix a low-probability crash when calling Gc.counters.
+  (Demi Marie Obenour, review by Gabriel Scherer)
+
+- #13272: Allow maximum number of domains to be specified as a OCAMLRUNPARAM
+  parameter.
+  (KC Sivaramakrishnan, review by Guillaume Munch-Maccagnoni, Miod Vallat,
+   Gabriel Scherer, David Allsopp, request by Zachary Yedidia).
+
+- #11911, #12923: Multicore statistical memory profiling.
+  This restores a notable OCaml 4 feature that was missing
+  in OCaml 5.
+  (Nick Barnes, review by Stephen Dolan, Jacques-Henri Jourdan
+   and Guillaume Munch-Maccagnoni).
+
+- #12579: OS-based Synchronisation for Stop-the-World Sections
+  (B. Szilvasy, review by Miod Vallat, Nick Barnes, Olivier Nicole,
+   Gabriel Scherer and Damien Doligez)
+
+- #12789: Restore caml_unregister_frametable from OCaml 4
+  (Frédéric Recoules, review by Gabriel Scherer)
+
+- #13003: new, more consistent names for array-creation C functions
+  (Gabriel Scherer, review by Olivier Nicole)
+
+- #13013: introduce a `caml_result` type to supersede the
+  use of 'encoded exception values' in the FFI.
+  (Gabriel Scherer, review by Damien Doligez,
+   Guillaume Munch-Maccagnoni and Xavier Leroy,
+   suggested by Guillaume Munch-Maccagnoni)
+
+- #12407, #13226: Resource-handling improvements: add
+  exception-returning variants for all exception-raising functions in
+  `caml/fail.h`, for the purpose of cleaning-up state and resources
+  before raising.
+  (Guillaume Munch-Maccagnoni, review by Damien Doligez, Xavier Leroy
+   and Gabriel Scherer)
+
+- #13086: Avoid spurious major GC slices.
+  (Damien Doligez, report by Stephen Dolan, review by Gabriel Scherer
+   and Stephen Dolan)
+
+- #11779, #13117: Improve logic for fiber stack alignment.
+  (Miod Vallat, report by Damien Doligez, review by Gabriel Scherer)
+
+- #12839: Remove ATOMIC_UINTNAT_INIT from camlatomic.h (as part of a larger
+  cleanup of camlatomic.h)
+  (David Allsopp, review by Antonin Décimo, Sébastien Hinderer, Samuel Hym,
+   Guillaume Munch-Maccagnoni and Miod Vallat)
+
+- #13163: Enable frame pointers on macOS x86_64
+  (Tim McGilchrist, review by Sébastien Hinderer and Fabrice Buoro)
+
+- #12951: Constify constructors and flags tables in C code (take 2).
+  Now these tables will go in the readonly segment, where they belong.
+  (Antonin Décimo, review by David Allsopp)
+
+- #10696: Introduce __has_attribute and __has_c_attributes in
+  <caml/misc.h> to test the support of specific atributes in C
+  code. Introduce fallthrough as a wrapper around the fallthrough
+  attribute.
+  (Antonin Décimo, review by Nicolás Ojeda Bär, Xavier Leroy, and
+   Gabriel Scherer)
+
+- #13083: Use macros from limits.h to avoid signed-integer wrap-around.
+  Introduce CAML_{U,}INTNAT_{MIN,MAX} macros to expose {u,}intnat limits.
+  (Antonin Décimo, review by Nick Barnes, Xavier Leroy, Gabriel Scherer,
+   and Miod Vallat)
+
+- #13239: Check whether the compiler supports the labels as values
+  extension to enable threaded code interpretation.
+  (Antonin Décimo, review by Miod Vallat)
+
+- #13238: Enable software prefetching on x86 and x86_64 when building
+  with MSVC or clang-cl.
+  (Antonin Décimo, review by Miod Vallat)
+
+- #13241, #13261, #13271: Add CFI_SIGNAL_FRAME to ARM64 and RiscV runtimes,
+  for the purpose of displaying backtraces correctly in GDB.
+  (Tim McGilchrist, review by Miod Vallat, Gabriel Scherer and
+   KC Sivaramakrishnan)
+
+- #13139: Simplify CAMLalign to always use C23/C++11 alignas or C11
+  _Alignas. Ensures that stat data is always aligned to the best
+  boundary.
+  (Antonin Décimo, review by Miod Vallat and Xavier Leroy)
+
+- #13280: Check for support of compiler attributes. Allows using
+  compiler attributes with clang-cl.
+  (Antonin Décimo, review by Miod Vallat)
+
+- #13243: Enable C compiler warnings internally when building with
+  clang-cl or MSVC. Provide fixes too.
+  (Antonin Décimo, review by Miod Vallat and Xavier Leroy)
+
+- #13242: Define and use unreachable and trap annotation, and clean-up some
+  runtime assertions.
+  (Antonin Décimo, review by Miod Vallat, Gabriel Scherer, and David Allsopp)
+
+- #13402, #13512, #13549, #13553: Revise bytecode implementation of callbacks
+  so that it no longer produces dangling registered bytecode fragments.
+  (Xavier Leroy, report by Jan Midtgaard, analysis by Stephen Dolan,
+   review by Miod Vallat)
+
+- #13407: Add Runtime_events.EV_EMPTY_MINOR
+  (Thomas Leonard)
+
+- #13522: Confirm runtime events ring is still active after callback.
+  (KC Sivaramakrishnan, review by Sadiq Jaffer and Miod Vallat)
+
+- #13529: Do not write to event ring after going out of stw participant set.
+  (KC Sivaramakrishnan, review by Sadiq Jaffer)
+
+### Code generation and optimizations:
+
+- #13014: Enable compile-time option -function-sections on all previously
+  unsupported native backends (POWER, riscv64 and s390x)
+  (Miod Vallat, review by Nicolás Ojeda Bär)
+
+- #7241, #12555, #13076, #13138, #13338, #13152, #13153, #13154:
+  fix a soundness bug in the pattern-matching compiler
+  when side-effects mutate the scrutinee during matching.
+  (Gabriel Scherer, review by Nick Roberts)
+
+- #13341: a warning when the pattern-matching compiler pessimizes code
+  because side-effects may mutate the scrutinee during
+  matching. (This warning is disabled by default, as this rarely
+  happens and its performance impact is typically not noticeable.)
+  (Gabriel Scherer, review by Nick Roberts, Florian Angeletti
+   and David Allsopp)
+
+- #13179: Fix evaluation of toplevel lets in classes containing
+  local opens
+  (Vincent Laviron, review by Hugo Heuzard, Nathanaëlle Courant
+   and Gabriel Scherer)
+
+- #13543: Remove some String-Bytes conversion from the stdlib to behave better
+  with js_of_ocaml
+  (Hugo Heuzard, review by Gabriel Scherer)
+
+### Standard library:
+
+- #12884: Add `Queue.drop`
+  (Léo Andrès, review by Nicolás Ojeda Bär and Gabriel Scherer)
+
+- #13168: In Array.shuffle, clarify the code that validates the
+  result of the user-supplied function `rand`, and improve the
+  error message that is produced when this result is invalid.
+  (François Pottier, review by Florian Angeletti, Daniel Bünzli
+   and Gabriel Scherer)
+
+- #12133: Expose support for printing substrings in Format
+  (Florian Angeletti, review by Daniel Bünzli, Gabriel Scherer
+   and Nicolás Ojeda Bär)
+
+- #12869: Add List.take, List.drop, List.take_while and List.drop_while
+  (Kate Deplaix and Oscar Butler-Aldridge, review by Nicolás Ojeda Bär,
+   Craig Ferguson and Gabriel Scherer)
+
+- #12885: move Dynarray to an unboxed representation
+  (Gabriel Scherer, suggestions by Vincent Laviron,
+   review by Olivier Nicole and Simon Cruanes, Yann Leray, Alain Frisch)
+
+- #13047: Add Sys.poll_actions to (only) run pending runtime actions.
+  (Nick Barnes, review by Gabriel Scherer, Guillaume Munch-Maccagnoni, and
+  Vincent Laviron)
+
+- #13144: Dynarray.{equal, compare}
+  (Gabriel Scherer,
+   review by Jeremy Yallop, Daniel Bünzli and Olivier Nicole,
+   request by Olivier Nicole)
+
+- #13171: expose `Domain.self_index : unit -> int` (a somewhat-dense
+  indexing of currently-running domains) for advanced use-cases of
+  domain-indexed concurrent data structures.
+  (Gabriel Scherer,
+   review by KC Sivaramakrishnan, Miod Vallat and Nicolás Ojeda Bär,
+   report by Vesa Karvonen)
+
+- #13197: Dynarray.blit, which allows to extend the destination
+  dynarray (0 <= dst_pos <= dst_length).
+  (Gabriel Scherer, report by Hazem Elmasry,
+   review by Olivier Nicole, Hazem Elmasry and Nicolás Ojeda Bär)
+
+* #13240: Add Uchar.seeded_hash, Change Uchar.hash implementation.
+  Previously, Uchar.hash was aliased to Uchar.to_int. If you need that behavior,
+  change your module instantiation from eg `module HT = Hashtbl.Make(Uchar)` to
+  ```
+    module HT = Hashtbl.Make(struct
+      ...
+      let hash = Uchar.to_int
+    end)
+  ```
+  If the current implementation is desired, and you have a hashtable module `HT`
+  (produced with the `Make` functor) in persistent storage, use `HT.rebuild` to
+  ensure it doesn't break when reading from or writing to buckets.
+  (Hazem ElMasry, review by Gabriel Scherer and Nicolás Ojeda Bär)
+
+- #13318: Fix regression in GC alarms, and fix them for flambda.
+  (Guillaume Munch-Maccagnoni, report by Benjamin Monate, review by
+   Vincent Laviron and Gabriel Scherer)
+
+- #13296: Add mem, memq, find_opt, find_index, find_map and find_mapi
+  to Dynarray.
+  (Jake H, review by Gabriel Scherer and Florian Angeletti)
+
+### Other libraries:
+
+- #11996: release the dependency of dynlink on compilerlibs.
+  (Sébastien Hinderer and Stephen Dolan, review by Damien Doligez and
+  Hugo Heuzard)
+
+- #13326: Implement Unix.O_APPEND on windows.
+  (Romain Beauxis, review by Miod Vallat, Gabriel Scherer and Antonin Décimo)
+
+### Tools:
+
+- #11716: ocamllex: mismatched parentheses and curly brackets are now caught
+  by ocamllex, instead of causing invalid OCaml code to be generated.
+  (Demi Marie Obenour, review by Damien Doligez and Xavier Leroy)
+
+- #12904: Run the testsuite with ThreadSanitizer on a PR when label
+  `run-thread-sanitizer` is added
+  (Olivier Nicole, suggested by Sébastien Hinderer and David Allsopp, review by
+   Gabriel Scherer)
+
+* #13114: Support ocamldebug remote debugging over IPv6 on all
+  platforms, and over Unix domain sockets on Windows.
+  (Antonin Décimo, review by Gabriel Scherer and Miod Vallat)
+
+- #13136: Rewrite GDB extensions and macros in debugger-agnostic Python, and add
+  LLDB support for them.
+  (Nick Barnes, review by Tim McGilchrist and Gabriel Scherer)
+
+### Toplevel:
+
+- #12891: Improved styling for initial prompt
+  (Florian Angeletti, review by Gabriel Scherer)
+
+- #13053: Improved display of builtin types such as `_ list` when aliased.
+  (Samuel Vivien, review by Florian Angeletti)
+
+### Manual and documentation:
+
+- #13370: Document that that temporary variables holding GCd pointers must
+  not be live across a GC.
+  (Demi Marie Obenour)
+
+- #12298: Manual: emphasize that Bigarray.int refers to an OCaml integer,
+  which does not match the C int type.
+  (Edwin Török, review by Florian Angeletti)
+
+- #12868: Manual: simplify style colours of the post-processed manual and API
+  HTML pages, and fix the search button icon
+  (Yawar Amin, review by Simon Grondin, Gabriel Scherer, and Florian Angeletti)
+
+- #12949: document OCaml release cycles and version strings in
+   `release-info/introduction.md`.
+  (Florian Angeletti, review by Fabrice Buoro, Kate Deplaix, Damien Doligez, and
+   Gabriel Scherer)
+
+- #12976: Manual: use webman/<version>/*.html and
+  webman/<version>/api/ for OCaml.org HTML manual generation
+  (Shakthi Kannan, review by Hannes Mehnert, and Florian Angeletti)
+
+- #13045: Emphasize caution about behaviour of custom block finalizers.
+  (Nick Barnes)
+
+- #13216: document the new `caml_result` type in the FFI chapter of the manual.
+  (Gabriel Scherer, review by Miod Vallat, Daniel Bünzli, Nick Barnes,
+   Guillaume Munch-Maccagnoni and Antonin Décimo)
+
+- #13287: stdlib/sys.mli: Update documentation on Sys.opaque_identity
+  following #9412.
+  (Matt Walker, review by Guillaume Munch-Maccagnoni and Vincent Laviron)
+
+- #13295: Use syntax for deep effect handlers in the effect handlers manual
+  page.
+  (KC Sivaramakrishnan, review by Anil Madhavapeddy, Florian Angeletti and Miod
+   Vallat)
+
+- #13424: Fix `Gc.quick_stat` documentation to clarify that returned fields
+  `live_words`, `live_blocks`, `free_words`, and `fragments` are not zero.
+  (Jan Midtgaard, review by Damien Doligez and KC Sivaramakrishnan)
+
+- #13440: Update documentation of `Gc.{control,get,set}` to reflect fields
+  not currently supported on OCaml 5.
+  (Jan Midtgaard, review by Gabriel Scherer)
+
+- #13469, #13474, #13535: Document that [Hashtbl.create n] creates a hash table
+  with a default minimal size, even if [n] is very small or negative.
+  (Antonin Décimo, Nick Bares, report by Nikolaus Huber and Jan Midtgaard,
+   review by Florian Angeletti, Anil Madhavapeddy, Gabriel Scherer,
+   and Miod Vallat)
+
+- #13666: Rewrite parts of the example code around nested lists in Chapter 6
+  (Polymorphism and its limitations -> Polymorphic recursion) giving the
+  "depth" function [in the non-polymorphically-recursive part of the example]
+  a much more sensible behavior; also fix a typo and some formatting.
+  (Frank Steffahn, review by Florian Angeletti)
+
+- #13668: Document the basic support for unicode identifiers and the switch to
+   UTF-8 encoded Unicode text for OCaml source file
+  (Florian Angeletti, review by Nicolás Ojeda Bär and Daniel Bünzli)
+
+### Compiler user-interface and warnings:
+
+* #12084, #13669, #13673: Check link order when creating archive and when using
+   ocamlopt.
+  (Hugo Heuzard, review by Stefan Muenzel and Sébastien Hinderer)
+
+- #12980: Explain type mismatch involving first-class modules by including
+  the module level error message
+  (Florian Angeletti, review by Vincent Laviron)
+
+- #12985, #12988: Better error messages for partially applied functors.
+  (Florian Angeletti, report by Arthur Wendling, review by Gabriel Scherer)
+
+- #13034, #13260: Better error messages for mismatched function labels
+  (Florian Angeletti, report by Daniel Bünzli, review by Gabriel Scherer and
+   Samuel Vivien)
+
+- #13051: Add a "Syntax error" to error messages for invalid package signatures.
+  (Samuel Vivien, review by Gabriel Scherer)
+
+- #13099: Fix erroneous loading of cmis for some module type errors.
+  (Nick Roberts, review by Florian Angeletti)
+
+- #13151, name conflicts explanation as a footnote
+  (Florian Angeletti, review by Gabriel Scherer)
+
+- #13228: Re-export Cmt2annot.{iterator,binary_part} which had become hidden
+  since #11288 and broke ocamlbrowser.
+  (David Allsopp, report by Jacques Garrigue, review by Sébastien Hinderer)
+
+- #13251: Register printer for errors in Emitaux
+  (Vincent Laviron, review by Miod Vallat and Florian Angeletti)
+
+- #13255: Re-enable warning 34 for unused locally abstract types
+  (Nick Roberts, review by Chris Casinghino and Florian Angeletti)
+
+- #12182: Improve the type clash error message.
+  For example, this message:
+    This expression has type ...
+  is changed into:
+    The constant "42" has type ...
+  (Jules Aguillon, review by Gabriel Scherer and Florian Angeletti)
+
+- #13471: add `-keywords <version?+list>` flag to define the list of keywords
+  recognized by the lexer, for instance `-keywords 5.2` disable the `effect`
+  keyword.
+  (Florian Angeletti, review by Gabriel Scherer)
+
+### Internal/compiler-libs changes:
+
+- #11129, #11148: enforce that ppxs do not produce `parsetree`s with
+  an empty list of universally quantified type variables
+  (`. int -> int` instead of `'a . int -> int'`)
+  (Florian Angeletti, report by Simmo Saan, review by Gabriel Scherer)
+
+- #12534: document and refactor Matching.mk_failaction_pos
+  (Gabriel Scherer, review by Vincent Laviron and Nick Roberts)
+
+- #13076: change the handling of Match_failure exits in the pattern-matching
+  compiler, to prepare for a complete fix for #7241
+  (Gabriel Scherer, review by Thomas Refis and Nick Roberts)
+
+- #12896: Simplify the compilation of custom bytecode runtimes by explicitly
+  compiling the primitives file before calling the linker. Tidy-up both the
+  generating code and the output itself for C code being generated by the
+  bytecode linker in `-custom` and `-output-*` modes.
+  (David Allsopp, Antonin Décimo and Samuel Hym, review by Vincent Laviron)
+
+- #12932: Remove useless code in Typecore.type_label_exp (was a fix for #4862)
+  (Jacques Garrigue, review by Gabriel Scherer)
+
+- #12943: Make transient_expr.scope a bitfield, and use it to store marks.
+  Marks are automatically allocated, and removed when leaving their scope.
+  Falls back to using TransientTypeSet when marks are exhausted.
+  (Jacques Garrigue and Takafumi Saikawa, review by Basile Clément)
+
+- #12946: Make generalization automatic when leaving scope.
+  As a result, the `Ctype.generalize*` and `Ctype.correct_levels` functions
+  were removed. The latter is now called `Ctype.duplicate_type`.
+  (Jacques Garrigue and Takafumi Saikawa, review by Richard Eisenberg)
+
+- #12968: Attach location to constants in the parsetree
+  (Jules Aguillon, review by Gabriel Scherer)
+
+- #12959, #13055: Avoid an internal error on recursive module type inconsistency
+  (Florian Angeletti, review by Jacques Garrigue and Gabriel Scherer)
+
+- #13049: graphical debugging printer for types
+  (Florian Angeletti, review by Gabriel Scherer)
+
+- #13074, #13082, #13084: refactoring in the pattern-matching compiler
+  (Gabriel Scherer, review by Thomas Refis, Vincent Laviron and Nick Roberts)
+
+- #13067: rework volatile memory access rules under TSan to consider properly
+  aligned smaller-than-register read operations as atomic, which gets rid of
+  false positives on s390x
+  (Miod Vallat, review by Fabien Buoro)
+
+- #13162: Use quoted strings to clarify code being generated.
+  (Antonin Décimo, review by Miod Vallat and Gabriel Scherer)
+
+- #13015: Emit floating-point literals in .rodata section on ELF arm64
+  platforms (Linux, *BSD).
+  (Miod Vallat, review by Nicolás Ojeda Bär)
+
+- #13169, #13311: Introduce a document data type for compiler messages
+  rather than relying on `Format.formatter -> unit` closures.
+  (Florian Angeletti, review by Gabriel Scherer)
+
+- #13193: Remove the unused env_init field from class blocks
+  (Vincent Laviron, review by Jacques Garrigue)
+
+- #13257: integrate MetaOCaml in the Menhir grammar to ease MetaOCaml
+  maintenance. This is a purely internal change: there is no support
+  in the lexer, so no change to the surface OCaml grammar.
+  (Oleg Kiselyov, Gabriel Scherer and Florian Angeletti,
+   review by Jeremy Yallop)
+
+- #13286: Distinguish unique identifiers `Shape.Uid.t` according to their
+  provenance: either an implementation or an interface.
+  (Ulysse Gérard, review by Florian Angeletti and Leo White)
+
+- #13289: Use C99 for loop to reduce the scope of the for loop iterator.
+  (Antonin Décimo, review by Miod Vallat and Gabriel Scherer)
+
+- #13308: keep track of relations between declaration in the cmt files. This is
+  useful information for external tools for navigation and analysis purposis.
+  (Ulysse Gérard, Florian Angeletti, review by Florian Angeletti and Gabriel
+  Scherer)
+
+- #13336: compiler-libs, split the `Printtyp` in three to only keep
+  "user-friendly" functions in the `Printtyp` module.
+  (Florian Angeletti, review by Gabriel Scherer)
+
+- #13361: split runtime/array.c functions to consistently expose
+  uniform_array and floatarray versions, use floatarray versions
+  in Float.Array.
+  (Gabriel Scherer, review by Nicolás Ojeda Bär)
+
+- #13507: A small refactoring to [free_vars] to make it a bit faster
+  by not allocating a list when the list is not necessary.
+  (Richard Eisenberg, review by Jacques Garrigue)
+
+### Build system:
+
+- #12909: Reorganise how MKEXE_VIA_CC is built to make it correct for MSVC by
+  grouping all the linker flags at the end of the C compiler commandline
+  (David Allsopp and Samuel Hym, review by Nicolás Ojeda Bär)
+
+- #12992, #13009: Check that flexlink can be executed only when building in a
+  native windows environment.
+  (Romain Beauxis, review by David Allsopp and Sébastien Hinderer)
+
+- #12996: Only link with -lgcc_eh when available.
+  (Romain Beauxis, review by David Allsopp and Miod Vallat)
+
+* #13200: Do not use CFLAGS for linking.
+  (Sébastien Hinderer, review by Gabriel Scherer, Antonin Décimo,
+  Miod Vallat and Samuel Hym)
+
+- #13201, #13244: Fix and speedup builds with TSan.
+  (Sébastien Hinderer, review by Miod Vallat, Gabriel Scherer and
+  Olivier Nicole)
+
+* #12578, #12589, #13322, #13519: Use configured CFLAGS and CPPFLAGS *only*
+  during the build of the compiler itself. Do not use them when
+  compiling third-party C sources through the compiler. Flags for
+  compiling third-party C sources can still be specified at configure
+  time in the COMPILER_{BYTECODE,NATIVE}_{CFLAGS,CPPFLAGS}
+  configuration variables.
+  (Sébastien Hinderer, report by William Hu, review by David Allsopp)
+
+- #13285: continue the merge of the sub-makefiles into the root
+  Makefile started with #11243, #11248, #11268, #11420, #11675,
+  #12198, #12321, #12586, #12616, #12706 and #13048.
+  (Sébastien Hinderer, review by David Allsopp and Florian Angeletti)
+
+### Bug fixes:
+
+- #12854: Add a test in the regression suite that flags the bug #12825.
+  (Luc Maranget)
+
+- #12888: fix printing of uncaught exceptions in `.cmo` files passed on the
+  command-line of the toplevel.
+  (Nicolás Ojeda Bär, review by Florian Angeletti, report by Daniel Bünzli)
+
+- #12910, #12920: Fix an unsound interaction between first-class modules
+  and polymorphic records by saving and restoring univar_pairs.
+  (Stephen Dolan, review by Gabriel Scherer, report by Jeremy Yallop)
+
+- #12994: Remove un-used and unsafe caml_drop_continuation
+  (Tim McGilchrist, reviewed by Gabriel Scherer and Miod Vallat)
+
+- #12963: Restore caml_runtime_parameters implementation. This primitive allows
+  programs to query the runtime parameters supplied to an OCaml program.
+  Implementation missing since OCaml 5.0.
+  (Tim McGilchrist, reviewed by David Allsopp and Miod Vallat)
+
+- #13012: parsing: Fix dropped attributes after a '-' or '+'
+  The syntax '-(1 [@foo])' was incorrectly parsed as '-1'.
+  (Jules Aguillon, reviewed by Gabriel Scherer, report by Gabriel Scherer)
+
+* #13070: On Windows, when configured with bootstrapped flexdll, don't add
+  +flexdll to the search path when -nostdlib is specified (which then means
+  -L <path-to-flexdll> no longer gets passed to the system linker).
+  (David Allsopp, review by Florian Angeletti)
+
+- #13089: Fix bug in `runtime_events` library which could result in garbled
+  output under Windows.
+  (B. Szilvasy, review by Nicolás Ojeda Bär and Miod Vallat)
+
+- #13088: A few type-checker behaviors look at a type to see if there are
+  any labeled arguments in it. This sometimes required expansion, which
+  could, in obscure scenarios, result in superfluous type errors.
+  (Richard Eisenberg, review by Gabriel Scherer and Jacques Garrigue)
+
+- #13103: FreeBSD/amd64: properly annotate .o files with non-executable stack
+  notes (Konstantin Belousov, review by Nicolás Ojeda Bär)
+
+- #13150: improve a transitive-closure computation algorithm in the flambda
+  middle-end to avoid a compilation time blowup on Menhir-generated code
+  (Florian Weimer, review by Gabriel Scherer and Pierre Chambart,
+   report by Richard Jones)
+
+- #13166: Fix a MinGW/MSVC Sys.rename regression on renaming a parent directory
+  to an empty child directory.
+  (Jan Midtgaard, review by Antonin Décimo, Sébastien Hinderer, and
+   David Allsopp)
+
+- #13185, #13192: Reject type-level module aliases on functor parameter
+  inside signatures.
+  (Jacques Garrigue, report by Richard Eisenberg, review by Florian Angeletti)
+
+- #13170: Fix a bug that would result in some floating alerts `[@@@alert ...]`
+  incorrectly triggering Warning 53.
+  (Nicolás Ojeda Bär, review by Chris Casinghino and Florian Angeletti)
+
+- #13203: Do not issue warning 53 if the compiler is stopping before attributes
+  have been accurately marked.
+  (Chris Casinghino, review by Florian Angeletti)
 
 - #13207: Be sure to reload the register caching the exception handler in
   caml_c_call and caml_c_call_stack_args, as its value may have been changed
@@ -7,51 +596,105 @@ OCaml 5.2.1 (18 November 2024)
   (Miod Vallat, report by Vesa Karvonen, review by Gabriel Scherer and
    Xavier Leroy)
 
+- #13209: Fix configure test that checks whether `ar` supports `@FILE`
+  arguments.
+  (Nicolás Ojeda Bär, report by Boris D.)
+
+- #13221: Compute more accurate instruction sizes for branch relocation on
+  POWER.
+  (Miod Vallat, review by Gabriel Scherer)
+
 - #13252: Rework register assignment in the interpreter code on m68k on Linux,
   due to the %a5 register being used by Glibc.
   (Miod Vallat, report by Stéphane Glondu, review by Gabriel Scherer and
    Xavier Leroy)
 
-- #13268: Fix a call to test in configure.ac that was causing errors when
-  LDFLAGS contains several words.
-  (Stéphane Glondu, review by Miod Vallat)
+- #13247: Disable lib_unix/kill test for MacOS AMD64 with TSan, linking
+  to llvm bug report causing infinite signal loops.
+  (Tim McGilchrist, review by Olivier Nicole, Miod Vallat, Sébastien Hinderer
+  and Gabriel Scherer)
 
 - #13234, #13267: Open runtime events file in read-write mode on armel
   (armv5) systems due to atomic operations limitations on that
   platform.
   (Stéphane Glondu, review by Miod Vallat and Vincent Laviron)
 
-- #13188: fix races in the FFI code coming from the use of Int_val(...)
-  on rooted values inside blocking questions / without the runtime lock.
-  (Calling Int_val(...) on non-rooted immediates is fine, but any
-   access to rooted values must be done outside blocking sections /
-   with the runtime lock.)
-  (Etienne Millon, review by Gabriel Scherer, Jan Midtgaard, Olivier Nicole)
+- #13273: Fix a call to test in configure.ac that was causing errors when
+  LDFLAGS contains several words.
+  (Stéphane Glondu, review by Miod Vallat)
 
-- #13318: Fix regression in GC alarms, and fix them for flambda.
-  (Guillaume Munch-Maccagnoni, report by Benjamin Monate, review by
-   Vincent Laviron and Gabriel Scherer)
+- #13290: Fix uninitialized and out of bounds reads in runtime_events_consumer.c
+  (Edwin Török, review by Miod Vallat and Antonin Décimo)
+
+- #13306: An algorithm in the type-checker that checks two types for equality
+  could sometimes, in theory, return the wrong answer. This patch fixes the
+  oversight. No known program triggers the bug.
+  (Richard Eisenberg, review by Florian Angeletti)
+
+- #13400: Initialize th->signal_stack to avoid free of uninitialized data
+  if the user calls caml_c_thread_unregister on the main thread.
+  (Richard W.M. Jones, review by Guillaume Munch-Maccagnoni and
+  Gabriel Scherer)
 
 - #13140: POWER back-end: fix issue with call to `caml_call_realloc_stack`
   from a DLL
   (Xavier Leroy, review by Miod Vallat)
 
-- #13370: Fix a low-probability crash when calling Gc.counters.
-  (Demi Marie Obenour, review by Gabriel Scherer)
+- #13263, #13560: fix printing true and false in toplevel and error
+  messages (no more unexpected \#true)
+  (Florian Angeletti, report by Samuel Vivien, review by Gabriel Scherer)
 
-- #13402, #13512, #13549, #13553: Revise bytecode implementation of callbacks
-  so that it no longer produces dangling registered bytecode fragments.
-  (Xavier Leroy, report by Jan Midtgaard, analysis by Stephen Dolan,
-   review by Miod Vallat)
+- #13388, #13540: raises an error message (and not an internal compiler error)
+  when two local substitutions are incompatible (for instance `module type
+  S:=sig end type t:=(module S)`)
+  (Florian Angeletti, report by Nailen Matschke, review by Gabriel Scherer, and
+  Leo White)
+
+- #13408: Fix misplaced debug runtime assertion triggerable by a race
+  between domain exit and backup thread
+  (Miod Vallat and Gabriel Scherer, report by Jan Midtgaard)
+
+- #13417: `Filename.quote_command`: fix handling of forward slashes in program
+  path under Win32.
+  (Nicolás Ojeda Bär, review by David Allsopp and Damien Doligez)
+
+- #13501: Regression on mutually recursive types caused by #12180.
+  Resuscitate Typedecl.update_type.
+  (Jacques Garrigue and Takafumi Saikawa, review by Florian Angeletti, Richard
+  Eisenberg and Gabriel Scherer)
 
 - #13502: Fix misindexing related to `Gc.finalise_last` that could prevent
   finalisers from being run.
   (Nick Roberts, review by Mark Shinwell)
 
+- #13495, #13514: Fix typechecker crash while typing objects
+  (Jacques Garrigue, report by Nicolás Ojeda Bär, review by
+   Nicolas Ojeda Bär, Gabriel Scherer, Stephen Dolan, Florian Angeletti)
+
+- #13391, #13551: fix a printing bug with `-dsource` when using
+  raw literal inside a locally abstract type constraint
+  (i.e. `let f: type \#for. ... `)
+  (Florian Angeletti, report by Nick Roberts, review by Richard Eisenberg)
+
 - #13520: Fix compilation of native-code version of systhreads. Bytecode fields
   were being included in the thread descriptors.
   (David Allsopp, review by Sébastien Hinderer and Miod Vallat)
 
+- #13541, #13591: Fix headers for C++ inclusion.
+  (Antonin Décimo, review by Nick Barnes, report by Kate Deplaix)
+
+- #13579, #13583: Unsoundness involving non-injective types + gadts
+  (Jacques Garrigue, report by @v-gb,
+   review by Richard Eisenberg and Florian Angeletti)
+
+- #13598: Falsely triggered warning 56 [unreachable-case]
+  This was caused by unproper protection of the retyping function.
+  (Jacques Garrigue, report by Tõivo Leedjärv, review by Florian Angeletti)
+
+- #13603, #13604: fix source printing in the presence of the escaped raw
+  identifier `\#mod`.
+  (Florian Angeletti, report by Chris Casinghino, review by Gabriel Scherer)
+
 OCaml 5.2.0 (13 May 2024)
 -------------------------
 
@@ -66,6 +709,60 @@ OCaml 5.2.0 (13 May 2024)
 - #12667: extend the latter to POWER 64 bits, big-endian, ELFv2 ABI
   (A. Wilcox, review by Xavier Leroy)
 
+### Language features:
+
+- #12295, #12568: Give `while true' a polymorphic type, similarly to
+  `assert false'
+  (Jeremy Yallop, review by Nicolás Ojeda Bär and Gabriel Scherer,
+  suggestion by Rodolphe Lepigre and John Whitington)
+
+- #12315: Use type annotations from arguments in let rec
+  (Stephen Dolan, review by Gabriel Scherer)
+
+- #11252, RFC 27: Support raw identifier syntax \#foo
+  (Stephen Dolan, review by David Allsopp, Gabriel Scherer and Olivier Nicole)
+
+- #12044: Add local module open syntax for types.
+  ```
+    module A = struct
+      type t = int
+      type r = unit
+      type s = string
+    end
+
+    type example = A.(t * r * s)
+  ```
+  (Alistair O'Brien, review by Gabriel Scherer, Nicolás Ojeda Bär
+   and Florian Angeletti)
+
+- #12456: Document the incompatibility between effects on the one
+  hand, and `caml_callback` and asynchronous callbacks (signal
+  handlers, finalisers, memprof callbacks...) on the other hand.
+  (Guillaume Munch-Maccagnoni, review by KC Sivaramakrishnan)
+
+- #12375: allow use of [@untagged] for all immediate types like char, bool,
+  and variant with only constant constructors.
+  (Christophe Raffalli, review by Gabriel Scherer)
+
+* #12502: the compiler now normalizes the newline sequence \r\n to
+  a single \n character during lexing, to guarantee that the semantics
+  of newlines in string literals is not modified by Windows tools
+  transforming \n into \r\n in source files.
+  Warning 29 [eol-in-string] is not emitted anymore, as the normalization
+  gives a more robust semantics to newlines in string literals.
+  (Gabriel Scherer and Damien Doligez, review by Daniel Bünzli, David
+   Allsopp, Andreas Rossberg, Xavier Leroy, report by Andreas Rossberg)
+
+- #13130: minor fixes to pprintast for raw identifiers and local module open
+  syntax for types.
+  (Chet Murthy, review by Gabriel Scherer)
+
+### Type system:
+
+- #12313, #11799: Do not re-build as-pattern type when a ground type annotation
+  is given. This allows to work around problems with GADTs in as-patterns.
+  (Jacques Garrigue, report by Leo White, review by Gabriel Scherer)
+
 ### Runtime system:
 
 - #12193: Re-introduce GC compaction for shared pools
@@ -76,12 +773,6 @@ OCaml 5.2.0 (13 May 2024)
    David Allsopp, Miod Vallat, Artem Pianykh, Stephen Dolan, Mark Shinwell
    and KC Sivaramakrishnan)
 
-- #12114: Add ThreadSanitizer support
-  (Fabrice Buoro and Olivier Nicole, based on an initial work by Anmol Sahoo,
-   review by Damien Doligez, Sébastien Hinderer, Jacques-Henri Jourdan, Luc
-   Maranget, Guillaume Munch-Maccagnoni, Gabriel Scherer)
-
-
 - #12850: Update Gc.quick_stat data at the end of major cycles and compaction
   This PR adds an additional caml_collect_gc_stats_sample_stw to the major heap
   cycling stw. This means that Gc.quick_stat now actually reflects the state of
@@ -154,6 +845,11 @@ OCaml 5.2.0 (13 May 2024)
   arise at specific locations during domain creation and shutdown.
   (Guillaume Munch-Maccagnoni, review by Gabriel Scherer)
 
+- #12114: Add ThreadSanitizer support
+  (Fabrice Buoro and Olivier Nicole, based on an initial work by Anmol Sahoo,
+   review by Damien Doligez, Sébastien Hinderer, Jacques-Henri Jourdan, Luc
+   Maranget, Guillaume Munch-Maccagnoni, Gabriel Scherer)
+
 - #11911, #12381: Restore statmemprof functionality in part, with
   some API changes in Gc.Memprof.
   (Nick Barnes, review by Jacques-Henri Jourdan
@@ -265,48 +961,34 @@ OCaml 5.2.0 (13 May 2024)
   (Olivier Nicole, suggested by Stephen Dolan, review by Gabriel Scherer,
    Miod Vallat and Damien Doligez)
 
-### Language features:
-
-- #12295, #12568: Give `while true' a polymorphic type, similarly to
-  `assert false'
-  (Jeremy Yallop, review by Nicolás Ojeda Bär and Gabriel Scherer,
-  suggestion by Rodolphe Lepigre and John Whitington)
-
-- #12044: Add local module open syntax for types.
-  ```
-    module A = struct
-      type t = int
-      type r = unit
-      type s = string
-    end
-
-    type example = A.(t * r * s)
-  ```
-  (Alistair O'Brien, review by Gabriel Scherer, Nicolás Ojeda Bär
-   and Florian Angeletti)
+### Code generation and optimizations:
 
-- #11252, RFC 27: Support raw identifier syntax \#foo
-  (Stephen Dolan, review by David Allsopp, Gabriel Scherer and Olivier Nicole)
+- #11239: on x86-64 and RISC-V, reduce alignment of OCaml stacks from 16 to 8.
+  This reduces stack usage.  It's only C stacks that require 16-alignment.
+  (Xavier Leroy, review by Gabriel Scherer and Stephen Dolan)
 
+- #12311: on POWER, 32-bit FP numbers stored in memory (e.g. in bigarrays)
+  were not correctly rounded sometimes.
+  (Xavier Leroy, review by Anil Madhavapeddy and Tim McGilchrist)
 
-- #12315: Use type annotations from arguments in let rec
-  (Stephen Dolan, review by Gabriel Scherer)
+- #12551, #12608, #12782, #12596: Overhaul of recursive value compilation.
+  Non-function recursive bindings are now forbidden from Lambda onwards,
+  and compiled using a new Value_rec_compiler module.
+  (Vincent Laviron and Lunia Ayanides, review by Gabriel Scherer,
+   Stefan Muenzel and Nathanaëlle Courant)
 
-- #12375: allow use of [@untagged] for all immediate types like char, bool,
-  and variant with only constant constructors.
-  (Christophe Raffalli, review by Gabriel Scherer)
+- #1809, #12181: rewrite `compare x y op 0` to `x op y` when values are integers
+  (Xavier Clerc, Stefan Muenzel, review by Gabriel Scherer and Vincent Laviron)
 
-* #12502: the compiler now normalizes the newline sequence \r\n to
-  a single \n character during lexing, to guarantee that the semantics
-  of newlines in string literals is not modified by Windows tools
-  transforming \n into \r\n in source files.
-  Warning 29 [eol-in-string] is not emitted anymore, as the normalization
-  gives a more robust semantics to newlines in string literals.
-  (Gabriel Scherer and Damien Doligez, review by Daniel Bünzli, David
-   Allsopp, Andreas Rossberg, Xavier Leroy, report by Andreas Rossberg)
+- #12825: disable common subexpression elimination for atomic loads... again.
+  (Gabriel Scherer, review by KC Sivaramakrishnan, Xavier Leroy
+   and Vincent Laviron, report by Vesa Karvonen)
 
 ### Standard library:
 
+- #12716: Add `Format.pp_print_nothing` function.
+  (Léo Andrès, review by Gabriel Scherer and Nicolás Ojeda Bär)
+
 - #11563: Add the Dynarray module to the stdlib. Dynamic arrays are
   arrays whose length can be changed by adding or removing elements at
   the end, similar to 'vectors' in C++ or Rust.
@@ -314,10 +996,6 @@ OCaml 5.2.0 (13 May 2024)
    Daniel Bünzli, Guillaume Munch-Maccagnoni, Clément Allain,
    Damien Doligez, Wiktor Kuchta and Pieter Goetschalckx)
 
-
-- #12716: Add `Format.pp_print_nothing` function.
-  (Léo Andrès, review by Gabriel Scherer and Nicolás Ojeda Bär)
-
 * #6732, #12423: Make Buffer.add_substitute surjective and fix its
   documentation.
   (Damien Doligez, review by Antonin Décimo)
@@ -379,54 +1057,25 @@ OCaml 5.2.0 (13 May 2024)
    and Gabriel Scherer)
 
 - #12625: Remove the Closure module from Obj
-  (Vincent Laviron, review by Xavier Leroy)
-
-- #12758, #12998: Remove the `Marshal.Compression` flag to the
-  `Marshal.to_*` functions.  The compilers are still able to use
-  ZSTD compression for compilation artefacts.
-  This is a forward port and clean-up of the emergency fix that was introduced
-  in OCaml 5.1.1 by #12734.
-  (Xavier Leroy, review by Damien Doligez)
-
-- #12784: Fix computation of minor-heap allocation in Gc.counters()
-  and Gc.allocated_bytes(). (Nick Barnes, review by Gabriel Scherer)
-
-- #12770: Add `Fun.compose`.
-  (Justin Frank, review by Nicolás Ojeda Bär, Daniel Bünzli and Jeremy Yallop)
-
-- #12845: Add `{In,Out}_channel.is_binary_mode` as the dual of
-  `set_binary_mode`. This function was previously only available in the internal
-  C API.
-  (David Allsopp, review by Nicolás Ojeda Bär and Xavier Leroy)
-
-### Type system:
-
-- #12313, #11799: Do not re-build as-pattern type when a ground type annotation
-  is given. This allows to work around problems with GADTs in as-patterns.
-  (Jacques Garrigue, report by Leo White, review by Gabriel Scherer)
-
-### Code generation and optimizations:
-
-- #11239: on x86-64 and RISC-V, reduce alignment of OCaml stacks from 16 to 8.
-  This reduces stack usage.  It's only C stacks that require 16-alignment.
-  (Xavier Leroy, review by Gabriel Scherer and Stephen Dolan)
-
-- #12311: on POWER, 32-bit FP numbers stored in memory (e.g. in bigarrays)
-  were not correctly rounded sometimes.
-  (Xavier Leroy, review by Anil Madhavapeddy and Tim McGilchrist)
+  (Vincent Laviron, review by Xavier Leroy)
 
-- #12551, #12608, #12782, #12596: Overhaul of recursive value compilation.
-  Non-function recursive bindings are now forbidden from Lambda onwards,
-  and compiled using a new Value_rec_compiler module.
-  (Vincent Laviron and Lunia Ayanides, review by Gabriel Scherer,
-   Stefan Muenzel and Nathanaëlle Courant)
+- #12758, #12998: Remove the `Marshal.Compression` flag to the
+  `Marshal.to_*` functions.  The compilers are still able to use
+  ZSTD compression for compilation artefacts.
+  This is a forward port and clean-up of the emergency fix that was introduced
+  in OCaml 5.1.1 by #12734.
+  (Xavier Leroy, review by Damien Doligez)
 
-- #1809, #12181: rewrite `compare x y op 0` to `x op y` when values are integers
-  (Xavier Clerc, Stefan Muenzel, review by Gabriel Scherer and Vincent Laviron)
+- #12784: Fix computation of minor-heap allocation in Gc.counters()
+  and Gc.allocated_bytes(). (Nick Barnes, review by Gabriel Scherer)
 
-- #12825: disable common subexpression elimination for atomic loads... again.
-  (Gabriel Scherer, review by KC Sivaramakrishnan, Xavier Leroy
-   and Vincent Laviron, report by Vesa Karvonen)
+- #12770: Add `Fun.compose`.
+  (Justin Frank, review by Nicolás Ojeda Bär, Daniel Bünzli and Jeremy Yallop)
+
+- #12845: Add `{In,Out}_channel.is_binary_mode` as the dual of
+  `set_binary_mode`. This function was previously only available in the internal
+  C API.
+  (David Allsopp, review by Nicolás Ojeda Bär and Xavier Leroy)
 
 ### Other libraries:
 
@@ -438,73 +1087,57 @@ OCaml 5.2.0 (13 May 2024)
   instead of `value`.
   (Xavier Leroy, review by David Allsopp)
 
-### Compiler user-interface and warnings:
-
-- #11989, #12246, RFC 31: New flag, -H, to allow for transitive dependencies
-  without including them in the initial environment.
-  (Chris Casinghino, François Bobot, and Gabriel Scherer, review by Leo White
-   and Stefan Muenzel, RFC by François Bobot)
-
-
-* #10613, #12405: Simplify the values used for the system variable (`system:` in
-  `ocamlopt -config` or the `Config.system` constant). In particular, s390x and
-  ppc64 now report "linux" instead of "elf"; all variants of 32-bit ARM on Linux
-  now report "linux"; OpenBSD now reports "openbsd" instead of "bsd" for 32-bit
-  ARM; FreeBSD, NetBSD and OpenBSD now report the same value for both x86_64 and
-  x86_32; x86_32 systems matching *bsd but not freebsd*, netbsd* or openbsd*
-  are no longer identified (as on x86_64); x86_32 Linux now reports "linux"
-  instead of "linux_elf".
-  (David Allsopp, request by Kate Deplaix, review by Sébastien Hinderer and
-  Xavier Leroy)
+### Tools:
 
-- #12247: configure: --disable-ocamldebug can now be used instead
-  of --disable-debugger (which remains available for compatibility)
-  (Gabriel Scherer, review by Damien Doligez and Sébastien Hinderer)
+- #12340: testsuite: collect known issues with current -short-paths
+  implementation for existential types
+  (Florian Angeletti, Samuel Hym, review by Florian Angeletti and Thomas Refis)
 
-- #12199: improve the error message for non-overriding `inherit!`
-  (Florian Angeletti, review by Jules Aguillon)
+- #12147: ocamllex: Allow carriage returns at the end of line directives.
+  (SeungCheol Jung, review by Nicolás Ojeda Bär)
 
-- #12210: uniform style for inline code in compiler messages
-  (Florian Angeletti, review by Gabriel Scherer)
+- #12260: Fix invalid_argument on some external or module aliases in ocamlnat
+  (Fabian Hemmer, review by Vincent Laviron)
 
-* #12278, #:12325: Remove the OCAML_FLEXLINK environment variable from the
-  compiler drivers. This environment variable was previously used as part of the
-  FlexDLL bootstrap procedure and existed solely for that purpose. Its removal
-  greatly simplifies both the build system and testsuite machinery.
-  (David Allsopp, review by Sébastien Hinderer)
+- #12185: New script language for ocamltest.
+  (Damien Doligez with Florian Angeletti, Sébastien Hinderer, Gabriel Scherer,
+   review by Sébastien Hinderer and Gabriel Scherer)
 
-- #12347: error messages: always report missing polyvariant tags
-  (Florian Angeletti, report by Tianbo Hao, review by Gabriel Scherer)
+- #12371: ocamltest: fix recursive expansion of variables.
+  (Antonin Décimo, Damien Doligez, review by Sébastien Hinderer,
+   Damien Doligez, Gabriel Scherer, and Xavier Leroy)
 
-- #12224, specialized error message when trying to apply non-functor
-  module (e.g `module M = Int(Int)`)
-  (Florian Angeletti, review by Gabriel Scherer)
+* #12497, #12613: Make ocamlc/ocamlopt fail with an error when no
+  input files are specified to build an executable.
+  (Antonin Décimo, review by Sébastien Hinderer)
 
-- #12451: Warning 53 (misplaced attributes) now works for all attributes.
-  (Chris Casinghino, review by Florian Angeletti)
+- #12576: ocamldep: various refactors.
+  (Antonin Décimo, review by Florian Angeletti, Gabriel Scherer, and Léo Andrès)
 
-- #12622: Give hints about existential types appearing in error messages
-  (Leo White, review by Gabriel Scherer and Florian Angeletti)
+- #12615: ocamldoc: get rid of the odoc_literate and odoc_todo generators.
+  (Sébastien Hinderer, review by Gabriel Scherer and Florian Angeletti)
 
-- #12671: When a class type parameter or class parameter does not match,
-  identify which parameter in the error message, instead of saying
-  "A type parameter" or "A parameter".
-  (Stefan Muenzel, review by Gabriel Scherer)
+- #12624: Use $XDG_CONFIG_DIRS in addition to $XDG_CONFIG_HOME when searching
+  for init.ml and use this to extend init.ml support to the toplevel when
+  running on Windows.
+  (David Allsopp, report by Jonah Beckford, review by Nicolás Ojeda Bär and
+   Antonin Décimo)
 
-- #12679: Add more detail to the error message and manual in case of
-  invalid module type substitutions.
-  (Stefan Muenzel, review by Gabriel Scherer and Florian Angeletti)
+- #12688: Setting the env variable `NO_COLOR` with an empty value no longer
+  has effects. Previously, setting `NO_COLOR` with any value, including
+  the empty value, would disable colors (unless `OCAML_COLOR` is also set).
+  After this change, the user must set `NO_COLOR` with an non-empty value
+  to disable colors. This reflects a specification clarification/change
+  from the upstream website at https://no-color.org.
+  (Favonia, review by Gabriel Scherer)
 
-- #12750: Display the command executed to extract primitives in
-  `ocamlc -verbose`.
-  (David Allsopp, review by Nicolás Ojeda Bär)
+- #12744: ocamltest: run tests in recursive subdirs more eagerly
+  (Nick Roberts, review by Nicolás Ojeda Bär)
 
-- #12777: Add details about the actual and expected method types to the method
-  mismatch error messages.
-  (Javier Chávarri, review by Gabriel Scherer and Florian Angeletti)
+- #12901, 12908: ocamllex: add overflow checks to prevent generating incorrect
+  lexers; use unsigned numbers in the table encoding when possible.
+  (Vincent Laviron, report by Edwin Török, review by Xavier Leroy)
 
-* #12942: Fix an line ordering in some module inclusion error messages
-  (Nick Roberts, review by Florian Angeletti, report by Carl Eastlund)
 ### Manual and documentation:
 
 - #12338: clarification of the documentation of process related function in
@@ -517,11 +1150,6 @@ OCaml 5.2.0 (13 May 2024)
   (Gabriel Scherer and Guillaume Munch-Maccagnoni, review by Olivier
    Nicole and Xavier Leroy)
 
-- #12456: Document the incompatibility between effects on the one
-  hand, and `caml_callback` and asynchronous callbacks (signal
-  handlers, finalisers, memprof callbacks...) on the other hand.
-  (Guillaume Munch-Maccagnoni, review by KC Sivaramakrishnan)
-
 - #12694: Document in runtime/tsan.c the TSan instrumentation choices and the
   consequences with regard to the memory model.
   (Olivier Nicole, review by Miod Vallat, Gabriel Scherer, Guillaume
@@ -549,80 +1177,74 @@ OCaml 5.2.0 (13 May 2024)
 - #13092: document the existence of the `[@@poll error]` built-in attribute
   (Florian Angeletti, review by Gabriel Scherer)
 
-### Tools:
-
-- #12340: testsuite: collect known issues with current -short-paths
-  implementation for existential types
-  (Florian Angeletti, Samuel Hym, review by Florian Angeletti and Thomas Refis)
-
-- #12147: ocamllex: Allow carriage returns at the end of line directives.
-  (SeungCheol Jung, review by Nicolás Ojeda Bär)
-
-- #12260: Fix invalid_argument on some external or module aliases in ocamlnat
-  (Fabian Hemmer, review by Vincent Laviron)
+### Compiler user-interface and warnings:
 
-- #12185: New script language for ocamltest.
-  (Damien Doligez with Florian Angeletti, Sébastien Hinderer, Gabriel Scherer,
-   review by Sébastien Hinderer and Gabriel Scherer)
+* #10613, #12405: Simplify the values used for the system variable (`system:` in
+  `ocamlopt -config` or the `Config.system` constant). In particular, s390x and
+  ppc64 now report "linux" instead of "elf"; all variants of 32-bit ARM on Linux
+  now report "linux"; OpenBSD now reports "openbsd" instead of "bsd" for 32-bit
+  ARM; FreeBSD, NetBSD and OpenBSD now report the same value for both x86_64 and
+  x86_32; x86_32 systems matching *bsd but not freebsd*, netbsd* or openbsd*
+  are no longer identified (as on x86_64); x86_32 Linux now reports "linux"
+  instead of "linux_elf".
+  (David Allsopp, request by Kate Deplaix, review by Sébastien Hinderer and
+  Xavier Leroy)
 
-- #12371: ocamltest: fix recursive expansion of variables.
-  (Antonin Décimo, Damien Doligez, review by Sébastien Hinderer,
-   Damien Doligez, Gabriel Scherer, and Xavier Leroy)
+- #11989, #12246, RFC 31: New flag, -H, to allow for transitive dependencies
+  without including them in the initial environment.
+  (Chris Casinghino, François Bobot, and Gabriel Scherer, review by Leo White
+   and Stefan Muenzel, RFC by François Bobot)
 
-* #12497, #12613: Make ocamlc/ocamlopt fail with an error when no
-  input files are specified to build an executable.
-  (Antonin Décimo, review by Sébastien Hinderer)
+- #12247: configure: --disable-ocamldebug can now be used instead
+  of --disable-debugger (which remains available for compatibility)
+  (Gabriel Scherer, review by Damien Doligez and Sébastien Hinderer)
 
-- #12576: ocamldep: various refactors.
-  (Antonin Décimo, review by Florian Angeletti, Gabriel Scherer, and Léo Andrès)
+- #12199: improve the error message for non-overriding `inherit!`
+  (Florian Angeletti, review by Jules Aguillon)
 
-- #12615: ocamldoc: get rid of the odoc_literate and odoc_todo generators.
-  (Sébaistien Hinderer, review by Gabriel Scherer and Florian Angeletti)
+- #12210: uniform style for inline code in compiler messages
+  (Florian Angeletti, review by Gabriel Scherer)
 
-- #12624: Use $XDG_CONFIG_DIRS in addition to $XDG_CONFIG_HOME when searching
-  for init.ml and use this to extend init.ml support to the toplevel when
-  running on Windows.
-  (David Allsopp, report by Jonah Beckford, review by Nicolás Ojeda Bär and
-   Antonin Décimo)
+* #12278, #:12325: Remove the OCAML_FLEXLINK environment variable from the
+  compiler drivers. This environment variable was previously used as part of the
+  FlexDLL bootstrap procedure and existed solely for that purpose. Its removal
+  greatly simplifies both the build system and testsuite machinery.
+  (David Allsopp, review by Sébastien Hinderer)
 
-- #12688: Setting the env variable `NO_COLOR` with an empty value no longer
-  has effects. Previously, setting `NO_COLOR` with any value, including
-  the empty value, would disable colors (unless `OCAML_COLOR` is also set).
-  After this change, the user must set `NO_COLOR` with an non-empty value
-  to disable colors. This reflects a specification clarification/change
-  from the upstream website at https://no-color.org.
-  (Favonia, review by Gabriel Scherer)
+- #12347: error messages: always report missing polyvariant tags
+  (Florian Angeletti, report by Tianbo Hao, review by Gabriel Scherer)
 
-- #12744: ocamltest: run tests in recursive subdirs more eagerly
-  (Nick Roberts, review by Nicolás Ojeda Bär)
+- #12224, specialized error message when trying to apply non-functor
+  module (e.g `module M = Int(Int)`)
+  (Florian Angeletti, review by Gabriel Scherer)
 
-- #12901, 12908: ocamllex: add overflow checks to prevent generating incorrect
-  lexers; use unsigned numbers in the table encoding when possible.
-  (Vincent Laviron, report by Edwin Török, review by Xavier Leroy)
+- #12451: Warning 53 (misplaced attributes) now works for all attributes.
+  (Chris Casinghino, review by Florian Angeletti)
 
-### Internal/compiler-libs changes:
+- #12622: Give hints about existential types appearing in error messages
+  (Leo White, review by Gabriel Scherer and Florian Angeletti)
 
-- #12508 : Add compiler-side support for project-wide occurrences in Merlin, by
-  generating index tables of all identifier occurrences. This extra data in .cmt
-  files is only added when the new flag -bin-annot-occurrences is passed.
-  (Ulysse Gérard, Nathanaëlle Courant, suggestions by Gabriel Scherer and Thomas
-  Refis, review by Florian Angeletti, Gabriel Scherer and Thomas Refis)
+- #12671: When a class type parameter or class parameter does not match,
+  identify which parameter in the error message, instead of saying
+  "A type parameter" or "A parameter".
+  (Stefan Muenzel, review by Gabriel Scherer)
 
-- #12236, #12386, #12391, #12496, #12673: Use syntax as sole determiner of arity
-  This changes function arity to be based solely on the source program's
-  parsetree. Previously, the heuristic for arity had more subtle heuristics
-  that involved type information about patterns.  Function arity is important
-  because it determines when a pattern match's effects run and is an input
-  into the fast path for function application.
+- #12679: Add more detail to the error message and manual in case of
+  invalid module type substitutions.
+  (Stefan Muenzel, review by Gabriel Scherer and Florian Angeletti)
 
-  This change affects tooling: it changes the function constructs in parsetree
-  and typedtree.
+- #12750: Display the command executed to extract primitives in
+  `ocamlc -verbose`.
+  (David Allsopp, review by Nicolás Ojeda Bär)
 
-  See https://github.com/ocaml/RFCs/pull/32 for the original RFC.
+- #12777: Add details about the actual and expected method types to the method
+  mismatch error messages.
+  (Javier Chávarri, review by Gabriel Scherer and Florian Angeletti)
 
-  (Nick Roberts; review by Richard Eisenberg, Leo White, and Gabriel Scherer;
-  RFC by Stephen Dolan)
+* #12942: Fix an line ordering in some module inclusion error messages
+  (Nick Roberts, review by Florian Angeletti, report by Carl Eastlund)
 
+### Internal/compiler-libs changes:
 
 - #12639: parsing: Attach a location to the RHS of Ptyp_alias
   and improve the 'alias type mismatch' error message.
@@ -658,6 +1280,21 @@ OCaml 5.2.0 (13 May 2024)
   in Typecore in favor of local mutable state.
   (Nick Roberts, review by Takafumi Saikawa)
 
+- #12236, #12386, #12391, #12496, #12673: Use syntax as sole determiner of arity
+  This changes function arity to be based solely on the source program's
+  parsetree. Previously, the heuristic for arity had more subtle heuristics
+  that involved type information about patterns.  Function arity is important
+  because it determines when a pattern match's effects run and is an input
+  into the fast path for function application.
+
+  This change affects tooling: it changes the function constructs in parsetree
+  and typedtree.
+
+  See https://github.com/ocaml/RFCs/pull/32 for the original RFC.
+
+  (Nick Roberts; review by Richard Eisenberg, Leo White, and Gabriel Scherer;
+  RFC by Stephen Dolan)
+
 - #12542: Minor bugfix to #12236: restore dropped call to `instance`
   (Nick Roberts, review by Jacques Garrigue)
 
@@ -710,6 +1347,12 @@ OCaml 5.2.0 (13 May 2024)
 - #12764: Move all installable headers in `caml/` sub-directories.
   (Antonin Décimo, review by Gabriel Scherer and David Allsopp)
 
+- #12508 : Add compiler-side support for project-wide occurrences in Merlin, by
+  generating index tables of all identifier occurrences. This extra data in .cmt
+  files is only added when the new flag -bin-annot-occurrences is passed.
+  (Ulysse Gérard, Nathanaëlle Courant, suggestions by Gabriel Scherer and Thomas
+  Refis, review by Florian Angeletti, Gabriel Scherer and Thomas Refis)
+
 - #12914: Slightly change the s390x assembly dialect in order to build with
   Clang's integrated assembler.
   (Miod Vallat, review by Gabriel Scherer)
@@ -942,10 +1585,6 @@ OCaml 5.2.0 (13 May 2024)
 - #13094: Fix undefined behavior of left-shifting a negative number.
   (Antonin Décimo, review by Miod Vallat and Nicolás Ojeda Bär)
 
-- #13130: minor fixes to pprintast for raw identifiers and local module open
-  syntax for types.
-  (Chet Murthy, review by Gabriel Scherer)
-
 OCaml 5.1.1 (8 December 2023)
 ----------------------------
 
@@ -2471,6 +3110,10 @@ OCaml 4.14 maintenance version
   (emitted for Linux in #8805)
   (Hannes Mehnert, review by Nicolás Ojeda Bär)
 
+- #13448, #13449: fix a code-generation bug on unsafe array accesses
+  at type int32, int64, nativeint, which has been introduced in OCaml 4.04.
+  (Gabriel Scherer, review by Nicolás Ojeda Bär and Vincent Laviron,
+   report by Raphaël Bocquet and Simon Cruanes)
 
 OCaml 4.14.1 (20 December 2022)
 ------------------------------
@@ -3270,7 +3913,7 @@ OCaml 4.13.0 (24 September 2021)
 
 - #10250, #10266: Dynamically allocate alternate signal stacks to
    accommodate changes in Glibc 2.34.
-  (Xavier Leroy, reports by Tomasz Kłoczko and R.W.M. Jones, review by Anil
+  (Xavier Leroy, reports by Tomasz Kłoczko and Richard Jones, review by Anil
    Madhavapeddy, Stephen Dolan, and Florian Angeletti)
 
 ### Code generation and optimizations:
@@ -3727,7 +4370,7 @@ OCaml 4.13.0 (24 September 2021)
 
 - #10584, #10856: Standard Library documentation build no longer fails if
   optional libraries have been disabled.
-  (David Allsopp, report by Yuri Victorovich review by Florian Angeletti)
+  (David Allsopp, report by Yuri Victorovich, review by Florian Angeletti)
 
 - #10593: Fix untyping of patterns without named existential quantifiers. This
   bug was only present in the beta version of OCaml 4.13.0.
@@ -4969,7 +5612,7 @@ OCaml 4.11.0 (19 August 2020)
 
 - #9011: Allow linking .cmxa files with no units on MSVC by not requiring the
   .lib file to be present.
-  (David Allsopp, report by Dimitry Bely, review by Xavier Leroy)
+  (David Allsopp, report by Dmitry Bely, review by Xavier Leroy)
 
 - #9064: Relax the level handling when unifying row fields
   (Leo White, review by Jacques Garrigue)
@@ -7443,7 +8086,7 @@ OCaml 4.07.0 (10 July 2018)
   (Jacques Garrigue, report by kantian)
 
 - #7751, #1657: The toplevel prints some concrete types as abstract.
-  (Jacques Garrigue, report by Matej Kosik)
+  (Jacques Garrigue, report by Matej Košík)
 
 - #7765, #1718: When unmarshaling bigarrays, protect against integer
   overflows in size computations.
@@ -8213,7 +8856,7 @@ OCaml 4.06.0 (3 Nov 2017):
   (Leo White)
 
 - #7261: Warn on type constraints in GADT declarations
-  (Jacques Garrigue, report by Fabrice Le Botlan)
+  (Jacques Garrigue, report by Didier Le Botlan)
 
 - #7321: Private type in signature clashes with type definition via
   functor instantiation
@@ -11280,7 +11923,7 @@ Bug fixes:
 - #4788: wrong error message when executable file is not found for backtrace
   (Damien Doligez, report by Claudio Sacerdoti Coen)
 - #4812: otherlibs/unix: add extern int code_of_unix_error (value error);
-  (Goswin von Berdelow)
+  (Goswin von Brederlow)
 - #4887: input_char after close_in crashes ocaml (msvc runtime)
   (Alain Frisch and Christoph Bauer, report by ygrek)
 - #4994: ocaml-mode doesn't work with xemacs21
@@ -11310,7 +11953,7 @@ Bug fixes:
 - #5350: missing return code checks in the runtime system
   (Xavier Leroy)
 - #5468: ocamlbuild should preserve order of parametric tags
-  (Wojciech Meyer, report by Dario Texeira)
+  (Wojciech Meyer, report by Dario Teixeira)
 - #5551: Avoid repeated lookups for missing cmi files
   (Alain Frisch)
 - #5552: unrecognized gcc option -no-cpp-precomp

diff --git a/HACKING.adoc b/HACKING.adoc
index 3860a3f0b54d995c387f7fcf08f43cbf5d3d04ca..0107e9ce65fd0a74870e39aed4ab4753d4f9520f 100644 (file)
--- a/HACKING.adoc
+++ b/HACKING.adoc
@@ -137,8 +137,9 @@ subdirectory.
 
 Some files are only used by bytecode programs, some only used by
 native-compiled programs, but most of the runtime code is
-common. (See link:runtime/Makefile[] for the list of common,
-bytecode-only and native-only source files.)
+common. (See `runtime_COMMON_C_SOURCES`, `runtime_BYTECODE_ONLY_C_SOURCES`,
+and `runtime_NATIVE_ONLY_C_SOURCES` in link:Makefile[] for the list of common,
+bytecode-only, and native-only source files.)
 
 See link:runtime/HACKING.adoc[].
 
@@ -214,6 +215,7 @@ has excellent documentation.
   toplevel/::             interactive system
   typing/::               typechecking -- see link:typing/HACKING.adoc[]
   utils/::                utility libraries
+  winpthreads/::          winpthreads submodule -- see <<winpthreads,further>>
   yacc/::                 parser generator
 
 [#tips]
@@ -287,11 +289,10 @@ opam install .
 -----
 
 -----
-# Example with installation from the current directory, installing only the
-# bytecode versions of the tools
+# Example with installation from the current directory
 opam switch create . --empty
 ./configure --prefix=$(opam var prefix) # put extra configuration args here
-make world && make opt
+make -j
 opam install . --assume-built
 -----
 
@@ -517,6 +518,44 @@ third-party code, by installing a local <<opam-switch,opam switch>>: opam
 packages tend to be compatible with released versions of the compiler, whereas
 most packages are incompatible with the in-progress development version.
 
+
+=== License
+
+The OCaml distribution in this repository, which includes the OCaml
+compiler and runtime, the OCaml standard library, and some extra
+tools, is licensed under the LGPL version 2.1, with a linking
+exception. See link:LICENSE[] for the full license text. Using the
+https://spdx.org/licenses/[SPDX] standard for license identifiers,
+this is the license "LGPL-2.1 WITH
+https://spdx.org/licenses/OCaml-LGPL-linking-exception.html[OCaml-LGPL-linking-exception]".
+Let us include here a few explanations about the intent of this
+licensing choice -- note that only the license text has legal value.
+
+The broad intent of the LGPL is that if you modify the OCaml
+distribution, and distribute your modified version to your users, then
+you have to provide the source code of your version -- the LGPL, like
+the GPL and unlike the BSD and MIT licenses, is "hereditary"; modified
+versions of LGPL programs must remain free software under the same
+license. (For more general discussion of the LGPL license, see the
+https://www.gnu.org/licenses/gpl-faq.en.html[FAQ] maintained by the
+GNU project.)
+
+On the other hand, if your code is not derived from the OCaml
+distribution, it only uses it, then you can use the licensing terms of
+your choice. We use an explicit "linking exception" precisely to make
+it clear that it is fine to link statically or dynamically with parts
+of the OCaml distribution, typically the OCaml runtime and the
+standard library. Linking exceptions are a common practice for
+language compilers and runtime libraries, for example the GCC project
+uses such an exception. See the
+https://en.wikipedia.org/wiki/GPL_linking_exception[Wikipedia article]
+on linking exceptions for more details.
+
+Finally: If you have your own fork of the OCaml distribution, it must
+be distributed to your own users under the same license
+(LGPL + exception), and your users will also benefit from the linking
+exception.
+
 === Continuous integration
 
 [#check-typo]
@@ -658,4 +697,36 @@ If you would like to receive email notifications of all commits made to the main
 git repository, you can subscribe to the caml-commits@inria.fr mailing list by
 visiting https://sympa.inria.fr/sympa/info/caml-commits[its web page.]
 
+[#winpthreads]
+=== The `winpthreads` library for the MSVC port
+
+The `winpthreads` library is used to emulate `pthread` for the MSVC
+port. Upstream bundles it along with all the MinGW libraries so our
+`winpthreads` submodule points to `git subtree` repository rather than
+upstream directly.
+
+To recreate the `winpthreads` repository from upstream, you can do:
+
+----
+git clone -o upstream https://git.code.sf.net/p/mingw-w64/mingw-w64 winpthreads
+cd winpthreads
+git checkout upstream/master
+git branch -D master
+git subtree -P mingw-w64-libraries/winpthreads split -b master
+----
+
+As subtree splitting is deterministic, repeating these operations later will
+allow to update `master`, for instance by:
+
+----
+git fetch upstream
+git checkout upstream/master
+git subtree -P mingw-w64-libraries/winpthreads split -b tmp
+git checkout master
+git merge --ff-only tmp
+git branch -d tmp
+----
+
+and then go on updating the `winpthreads` submodule in the `ocaml` repository.
+
 Happy Hacking!

diff --git a/INSTALL.adoc b/INSTALL.adoc
index ed29bf01df978f0a56a99590cb5f5799e5ae8c64..bf17760da71b8d5b6de4b3a05cfea1cd14666a0f 100644 (file)
--- a/INSTALL.adoc
+++ b/INSTALL.adoc
@@ -169,7 +169,7 @@ and data segment size (type `limit` under csh or `ulimit -a` under bash). Make
 sure the limit on the stack size is at least 4M.
 
 Try recompiling the runtime system with optimizations turned off (change
-`OC_CFLAGS` in `runtime/Makefile`). The runtime system
+`OC_CFLAGS` in `Makefile.build_config`). The runtime system
 contains some complex, atypical pieces of C code which can uncover bugs in
 optimizing compilers.  Alternatively, try another C compiler (e.g. `gcc` instead
 of the vendor-supplied `cc`).

diff --git a/Makefile b/Makefile
index 71d41cd2d65a88385ced35ba778b1666bb6e2d0d..f7fffdce4db9e077b8a66d039e9ce181ea78ec31 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -34,7 +34,8 @@ CAMLOPT=$(OCAMLRUN) ./ocamlopt$(EXE) $(STDLIBFLAGS) -I otherlibs/dynlink
 ARCHES=amd64 arm64 power s390x riscv
 VPATH = utils parsing typing bytecomp file_formats lambda middle_end \
   middle_end/closure middle_end/flambda middle_end/flambda/base_types \
-  asmcomp driver toplevel tools $(addprefix otherlibs/, $(ALL_OTHERLIBS))
+  asmcomp driver toplevel tools runtime \
+  $(addprefix otherlibs/, $(ALL_OTHERLIBS))
 INCLUDES = $(addprefix -I ,$(VPATH))
 
 ifeq "$(strip $(NATDYNLINKOPTS))" ""
@@ -62,6 +63,7 @@ expunge := expunge$(EXE)
 utils_SOURCES = $(addprefix utils/, \
   config.mli config.ml \
   build_path_prefix_map.mli build_path_prefix_map.ml \
+  format_doc.mli format_doc.ml \
   misc.mli misc.ml \
   identifiable.mli identifiable.ml \
   numbers.mli numbers.ml \
@@ -74,6 +76,7 @@ utils_SOURCES = $(addprefix utils/, \
   ccomp.mli ccomp.ml \
   warnings.mli warnings.ml \
   consistbl.mli consistbl.ml \
+  linkdeps.mli linkdeps.ml \
   strongly_connected_components.mli strongly_connected_components.ml \
   targetint.mli targetint.ml \
   int_replace_polymorphic_compare.mli int_replace_polymorphic_compare.ml \
@@ -87,7 +90,7 @@ utils_SOURCES = $(addprefix utils/, \
 parsing_SOURCES = $(addprefix parsing/, \
   location.mli location.ml \
   unit_info.mli unit_info.ml \
-  asttypes.mli \
+  asttypes.mli asttypes.ml \
   longident.mli longident.ml \
   parsetree.mli \
   docstrings.mli docstrings.ml \
@@ -116,6 +119,8 @@ typing_SOURCES = \
   typing/outcometree.mli \
   typing/shape.mli typing/shape.ml \
   typing/types.mli typing/types.ml \
+  typing/rawprinttyp.mli typing/rawprinttyp.ml \
+  typing/gprinttyp.mli typing/gprinttyp.ml \
   typing/btype.mli typing/btype.ml \
   typing/oprint.mli typing/oprint.ml \
   typing/subst.mli typing/subst.ml \
@@ -129,7 +134,9 @@ typing_SOURCES = \
   typing/signature_group.mli typing/signature_group.ml \
   typing/printtyped.mli typing/printtyped.ml \
   typing/ctype.mli typing/ctype.ml \
+  typing/out_type.mli typing/out_type.ml \
   typing/printtyp.mli typing/printtyp.ml \
+  typing/errortrace_report.mli typing/errortrace_report.ml \
   typing/includeclass.mli typing/includeclass.ml \
   typing/mtype.mli typing/mtype.ml \
   typing/envaux.mli typing/envaux.ml \
@@ -505,7 +512,10 @@ ocamllex_PROGRAMS = $(addprefix lex/,ocamllex ocamllex.opt)
 ocamlyacc_PROGRAM = yacc/ocamlyacc
 
 # Tools to be compiled to native and bytecode, then installed
-TOOLS_TO_INSTALL_NAT = ocamldep ocamlobjinfo
+TOOLS_TO_INSTALL_NAT = ocamldep
+ifeq "$(build_ocamlobjinfo)" "true"
+  TOOLS_TO_INSTALL_NAT += ocamlobjinfo
+endif
 
 # Tools to be compiled to bytecode only, then installed
 TOOLS_TO_INSTALL_BYT = \
@@ -519,7 +529,8 @@ endif
 # the configuration is not available during clean so we don't
 # know whether they have been configured / built or not
 clean::
-       rm -f $(addprefix tools/ocamlopt,p p.opt p.exe p.opt.exe)
+       rm -f $(addprefix tools/ocamlopt,p p.opt p.exe p.opt.exe) \
+         tools/ocamlobjinfo $(addprefix tools/ocamlobjinfo,.opt .exe .opt.exe)
 
 TOOLS_NAT = $(TOOLS_TO_INSTALL_NAT)
 TOOLS_BYT = $(TOOLS_TO_INSTALL_BYT) dumpobj primreq stripdebug cmpbyt
@@ -561,7 +572,7 @@ $(foreach PROGRAM, $(OCAML_BYTECODE_PROGRAMS),\
 # OCaml programs that are compiled only in native code
 
 OCAML_NATIVE_PROGRAMS = \
-  ocamlnat tools/lintapidiff.opt $(OPTIONAL_NATIVE_TOOLS)
+  ocamlnat tools/lintapidiff.opt tools/sync_dynlink.opt $(OPTIONAL_NATIVE_TOOLS)
 
 $(foreach PROGRAM, $(OCAML_NATIVE_PROGRAMS),\
   $(eval $(call OCAML_NATIVE_PROGRAM,$(PROGRAM))))
@@ -648,6 +659,15 @@ $(BYTE_BINDIR)/flexlink$(EXE): \
 partialclean::
        rm -f $(BYTE_BINDIR)/flexlink $(BYTE_BINDIR)/flexlink.exe
 
+ifneq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
+clean::
+       $(MAKE) -C flexdll clean
+endif
+ifneq "$(wildcard flexdll-sources/Makefile)" ""
+clean::
+       $(MAKE) -C flexdll-sources clean
+endif
+
 ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true"
 # The recipe for runtime/ocamlruns$(EXE) also produces runtime/primitives
 boot/ocamlrun$(EXE): runtime/ocamlruns$(EXE)
@@ -866,9 +886,6 @@ flexlink.opt$(EXE): \
        cd $(OPT_BINDIR); $(LN) $(call ROOT_FROM, $(OPT_BINDIR))/$@ flexlink$(EXE)
        cp $(addprefix $(BYTE_BINDIR)/, $(FLEXDLL_OBJECTS)) $(OPT_BINDIR)
 
-partialclean::
-       rm -f flexlink.opt$(EXE) $(OPT_BINDIR)/flexlink$(EXE)
-
 else
 
 flexdll flexlink flexlink.opt:
@@ -889,9 +906,13 @@ flexdll flexlink flexlink.opt:
 
 endif # ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true"
 
+partialclean::
+       rm -f flexlink.opt flexlink.opt.exe \
+        $(OPT_BINDIR)/flexlink $(OPT_BINDIR)/flexlink.exe
+
 INSTALL_COMPLIBDIR = $(DESTDIR)$(COMPLIBDIR)
 INSTALL_FLEXDLLDIR = $(INSTALL_LIBDIR)/flexdll
-FLEXDLL_MANIFEST = default_$(ARCH).manifest
+FLEXDLL_MANIFEST = default$(filter-out _i386,_$(ARCH)).manifest
 
 DOC_FILES=\
   Changes \
@@ -1009,10 +1030,69 @@ natruntop:
        $(MAKE) ocamlnat
        @$(RUN_OCAMLNAT)
 
-# Native dynlink
+# The dynlink library
+
+dynlink_SOURCES = $(addprefix otherlibs/dynlink/,\
+  dynlink_config.mli dynlink_config.ml \
+  dynlink_types.mli dynlink_types.ml \
+  dynlink_platform_intf.mli dynlink_platform_intf.ml \
+  dynlink_common.mli dynlink_common.ml \
+  byte/dynlink_symtable.mli byte/dynlink_symtable.ml \
+  byte/dynlink.mli byte/dynlink.ml \
+  native/dynlink.mli native/dynlink.ml)
+
+dynlink_LIBRARIES =
+
+otherlibs/dynlink/%: CAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS)
+otherlibs/dynlink/%: CAMLOPT = $(BEST_OCAMLOPT) $(STDLIBFLAGS)
+
+
+otherlibs/dynlink/%/dynlink.cmi: \
+  otherlibs/dynlink/dynlink.cmi otherlibs/dynlink/dynlink.mli
+       cp $^ otherlibs/dynlink/$*/
+
+.PHONY: dynlink-all
+dynlink-all: otherlibs/dynlink/dynlink.cma
+
+.PHONY: dynlink-allopt
+dynlink-allopt: otherlibs/dynlink/dynlink.cmxa
 
-otherlibs/dynlink/dynlink.cmxa: otherlibs/dynlink/native/dynlink.ml
-       $(MAKE) -C otherlibs/dynlink allopt
+otherlibs/dynlink/dynlink.cma: VPATH += otherlibs/dynlink/byte
+otherlibs/dynlink/dynlink.cmxa: VPATH += otherlibs/dynlink/native
+
+ifeq "$(FLAMBDA)" "true"
+otherlibs/dynlink/%: OC_NATIVE_COMPFLAGS += -O3
+endif
+
+# dynlink.cmx needs to be available in the search path (since
+# it is not compiled with -opaque), and we prefer to make the file
+# available in a directory that is already searched rather than have
+# to add otherlibs/dynlink/native to the search path as well
+
+otherlibs/dynlink/dynlink.cmx : otherlibs/dynlink/native/dynlink.cmx
+       cd otherlibs/dynlink; $(LN) native/dynlink.cmx .
+
+DYNLINK_DEPEND_DUMMY_FILES = \
+  otherlibs/dynlink/dynlink.ml \
+  otherlibs/dynlink/byte/dynlink.mli \
+  otherlibs/dynlink/native/dynlink.mli
+
+beforedepend::
+       @touch $(DYNLINK_DEPEND_DUMMY_FILES)
+
+otherlibs/dynlink.depend: beforedepend
+       @$(OCAMLDEP) $(OC_OCAMLDEPFLAGS) -I otherlibs/dynlink $(INCLUDES) \
+         $(OCAMLDEPFLAGS) \
+         -I otherlibs/dynlink/byte \
+         -bytecode otherlibs/dynlink/*.mli otherlibs/dynlink/dynlink_*.ml \
+         otherlibs/dynlink/byte/*.mli otherlibs/dynlink/byte/*.ml \
+         > $@
+       @$(OCAMLDEP) $(OC_OCAMLDEPFLAGS) -I otherlibs/dynlink $(INCLUDES) \
+         $(OCAMLDEPFLAGS) \
+         -I otherlibs/dynlink/native \
+         -native otherlibs/dynlink/dynlink_*.ml \
+         otherlibs/dynlink/native/dynlink.ml \
+         >> $@
 
 # Cleanup the lexer
 
@@ -1035,28 +1115,28 @@ beforedepend:: lambda/runtimedef.ml
 # Choose the right machine-dependent files
 
 asmcomp/arch.mli: asmcomp/$(ARCH)/arch.mli
-       cd asmcomp; $(LN) $(ARCH)/arch.mli .
+       @cd asmcomp; $(LN) $(ARCH)/arch.mli .
 
 asmcomp/arch.ml: asmcomp/$(ARCH)/arch.ml
-       cd asmcomp; $(LN) $(ARCH)/arch.ml .
+       @cd asmcomp; $(LN) $(ARCH)/arch.ml .
 
 asmcomp/proc.ml: asmcomp/$(ARCH)/proc.ml
-       cd asmcomp; $(LN) $(ARCH)/proc.ml .
+       @cd asmcomp; $(LN) $(ARCH)/proc.ml .
 
 asmcomp/selection.ml: asmcomp/$(ARCH)/selection.ml
-       cd asmcomp; $(LN) $(ARCH)/selection.ml .
+       @cd asmcomp; $(LN) $(ARCH)/selection.ml .
 
 asmcomp/CSE.ml: asmcomp/$(ARCH)/CSE.ml
-       cd asmcomp; $(LN) $(ARCH)/CSE.ml .
+       @cd asmcomp; $(LN) $(ARCH)/CSE.ml .
 
 asmcomp/reload.ml: asmcomp/$(ARCH)/reload.ml
-       cd asmcomp; $(LN) $(ARCH)/reload.ml .
+       @cd asmcomp; $(LN) $(ARCH)/reload.ml .
 
 asmcomp/scheduling.ml: asmcomp/$(ARCH)/scheduling.ml
-       cd asmcomp; $(LN) $(ARCH)/scheduling.ml .
+       @cd asmcomp; $(LN) $(ARCH)/scheduling.ml .
 
 asmcomp/stackframe.ml: asmcomp/$(ARCH)/stackframe.ml
-       cd asmcomp; $(LN) $(ARCH)/stackframe.ml .
+       @cd asmcomp; $(LN) $(ARCH)/stackframe.ml .
 
 # Preprocess the code emitters
 cvt_emit = tools/cvt_emit$(EXE)
@@ -1089,6 +1169,15 @@ partialclean::
 
 ## Lists of source files
 
+ifneq "$(WINPTHREADS_SOURCE_DIR)" ""
+winpthreads_SOURCES = cond.c misc.c mutex.c rwlock.c sched.c spinlock.c thread.c
+
+winpthreads_OBJECTS = \
+  $(addprefix runtime/winpthreads/, $(winpthreads_SOURCES:.c=.$(O)))
+else
+winpthreads_OBJECTS =
+endif
+
 runtime_COMMON_C_SOURCES = \
   addrmap \
   afl \
@@ -1105,6 +1194,7 @@ runtime_COMMON_C_SOURCES = \
   domain \
   dynlink \
   extern \
+  fail \
   fiber \
   finalise \
   floats \
@@ -1139,7 +1229,6 @@ runtime_COMMON_C_SOURCES = \
   str \
   sync \
   sys \
-  $(TSAN_NATIVE_RUNTIME_C_SOURCES) \
   $(UNIX_OR_WIN32) \
   weak
 
@@ -1155,6 +1244,7 @@ runtime_BYTECODE_C_SOURCES = \
   $(runtime_BYTECODE_ONLY_C_SOURCES:%=runtime/%.c)
 
 runtime_NATIVE_ONLY_C_SOURCES = \
+  $(TSAN_NATIVE_RUNTIME_C_SOURCES) \
   backtrace_nat \
   clambda_checks \
   dynlink_nat \
@@ -1207,38 +1297,46 @@ endif
 
 ## List of object files for each target
 
-libcamlrun_OBJECTS = $(runtime_BYTECODE_C_SOURCES:.c=.b.$(O))
+
+libcamlrun_OBJECTS = \
+  $(runtime_BYTECODE_C_SOURCES:.c=.b.$(O)) $(winpthreads_OBJECTS)
 
 libcamlrun_non_shared_OBJECTS = \
   $(subst $(UNIX_OR_WIN32).b.$(O),$(UNIX_OR_WIN32)_non_shared.b.$(O), \
           $(libcamlrun_OBJECTS))
 
 libcamlrund_OBJECTS = $(runtime_BYTECODE_C_SOURCES:.c=.bd.$(O)) \
-  runtime/instrtrace.bd.$(O)
+  $(winpthreads_OBJECTS) runtime/instrtrace.bd.$(O)
 
-libcamlruni_OBJECTS = $(runtime_BYTECODE_C_SOURCES:.c=.bi.$(O))
+libcamlruni_OBJECTS = \
+  $(runtime_BYTECODE_C_SOURCES:.c=.bi.$(O)) $(winpthreads_OBJECTS)
 
-libcamlrunpic_OBJECTS = $(runtime_BYTECODE_C_SOURCES:.c=.bpic.$(O))
+libcamlrunpic_OBJECTS = \
+  $(runtime_BYTECODE_C_SOURCES:.c=.bpic.$(O)) $(winpthreads_OBJECTS)
 
 libasmrun_OBJECTS = \
-  $(runtime_NATIVE_C_SOURCES:.c=.n.$(O)) $(runtime_ASM_OBJECTS)
+  $(runtime_NATIVE_C_SOURCES:.c=.n.$(O)) $(runtime_ASM_OBJECTS) \
+  $(winpthreads_OBJECTS)
 
 libasmrund_OBJECTS = \
-  $(runtime_NATIVE_C_SOURCES:.c=.nd.$(O)) $(runtime_ASM_OBJECTS:.$(O)=.d.$(O))
+  $(runtime_NATIVE_C_SOURCES:.c=.nd.$(O)) $(runtime_ASM_OBJECTS:.$(O)=.d.$(O)) \
+  $(winpthreads_OBJECTS)
 
 libasmruni_OBJECTS = \
-  $(runtime_NATIVE_C_SOURCES:.c=.ni.$(O)) $(runtime_ASM_OBJECTS:.$(O)=.i.$(O))
+  $(runtime_NATIVE_C_SOURCES:.c=.ni.$(O)) $(runtime_ASM_OBJECTS:.$(O)=.i.$(O)) \
+  $(winpthreads_OBJECTS)
 
 libasmrunpic_OBJECTS = $(runtime_NATIVE_C_SOURCES:.c=.npic.$(O)) \
-  $(runtime_ASM_OBJECTS:.$(O)=_libasmrunpic.$(O))
+  $(runtime_ASM_OBJECTS:.$(O)=_libasmrunpic.$(O)) $(winpthreads_OBJECTS)
 
 libcomprmarsh_OBJECTS = runtime/zstd.npic.$(O)
 
 ## General (non target-specific) assembler and compiler flags
 
 runtime_CPPFLAGS = -DCAMLDLLIMPORT= -DIN_CAML_RUNTIME
-ocamlrund_CPPFLAGS = -DDEBUG
-ocamlruni_CPPFLAGS = -DCAML_INSTR
+ocamlrun_CPPFLAGS = $(runtime_CPPFLAGS)
+ocamlrund_CPPFLAGS = $(runtime_CPPFLAGS) -DDEBUG
+ocamlruni_CPPFLAGS = $(runtime_CPPFLAGS) -DCAML_INSTR
 
 ## Runtime targets
 
@@ -1278,7 +1376,8 @@ runtime/caml/opnames.h : runtime/caml/instruct.h
            -e 's/{$$/[] = {/' \
            -e 's/\([[:upper:]][[:upper:]_0-9]*\)/"\1"/g' > $@
 
-# runtime/caml/jumptbl.h is required only if you have GCC 2.0 or later
+# runtime/caml/jumptbl.h is required only if the C compiler supports
+# the labels as values extension.
 runtime/caml/jumptbl.h : runtime/caml/instruct.h
        $(V_GEN)tr -d '\r' < $< | \
        sed -n -e '/^  /s/ \([A-Z]\)/ \&\&lbl_\1/gp' \
@@ -1294,7 +1393,7 @@ $(SAK): runtime/sak.$(O)
        $(V_MKEXE)$(call SAK_LINK,$@,$^)
 
 runtime/sak.$(O): runtime/sak.c runtime/caml/misc.h runtime/caml/config.h
-       $(V_CC)$(SAK_CC) -c $(SAK_CFLAGS) $(OUTPUTOBJ)$@ $<
+       $(V_CC)$(SAK_CC) $(SAK_CFLAGS) $(OUTPUTOBJ)$@ -c $<
 
 C_LITERAL = $(shell $(SAK) encode-C-literal '$(1)')
 
@@ -1355,34 +1454,45 @@ runtime/libcomprmarsh.$(A): $(libcomprmarsh_OBJECTS)
 
 ## Runtime target-specific preprocessor and compiler flags
 
-runtime/%.$(O): OC_CPPFLAGS += $(runtime_CPPFLAGS)
-$(DEPDIR)/runtime/%.$(D): OC_CPPFLAGS += $(runtime_CPPFLAGS)
-
-runtime/%.bd.$(O): OC_CPPFLAGS += $(ocamlrund_CPPFLAGS)
-$(DEPDIR)/runtime/%.bd.$(D): OC_CPPFLAGS += $(ocamlrund_CPPFLAGS)
-
-runtime/%.bi.$(O): OC_CPPFLAGS += $(ocamlruni_CPPFLAGS)
-$(DEPDIR)/runtime/%.bi.$(D): OC_CPPFLAGS += $(ocamlruni_CPPFLAGS)
-
-runtime/%.bpic.$(O): OC_CFLAGS += $(SHAREDLIB_CFLAGS)
-
-runtime/%.n.$(O): OC_CFLAGS += $(OC_NATIVE_CFLAGS)
-runtime/%.n.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
-$(DEPDIR)/runtime/%.n.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
-
-runtime/%.nd.$(O): OC_CFLAGS += $(OC_NATIVE_CFLAGS)
-runtime/%.nd.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlrund_CPPFLAGS)
+runtime/%.b.$(O): OC_CFLAGS = $(OC_BYTECODE_CFLAGS)
+runtime/%.b.$(O): OC_CPPFLAGS = $(OC_BYTECODE_CPPFLAGS) $(ocamlrun_CPPFLAGS)
+$(DEPDIR)/runtime/%.b.$(D): \
+  OC_CPPFLAGS = $(OC_BYTECODE_CPPFLAGS) $(ocamlrun_CPPFLAGS)
+
+runtime/%.bd.$(O): OC_CFLAGS = $(OC_BYTECODE_CFLAGS)
+runtime/%.bd.$(O): OC_CPPFLAGS = $(OC_BYTECODE_CPPFLAGS) $(ocamlrund_CPPFLAGS)
+$(DEPDIR)/runtime/%.bd.$(D): \
+  OC_CPPFLAGS = $(OC_BYTECODE_CPPFLAGS) $(ocamlrund_CPPFLAGS)
+
+runtime/%.bi.$(O): OC_CFLAGS = $(OC_BYTECODE_CFLAGS)
+runtime/%.bi.$(O): OC_CPPFLAGS = $(OC_BYTECODE_CPPFLAGS) $(ocamlruni_CPPFLAGS)
+$(DEPDIR)/runtime/%.bi.$(D): \
+  OC_CPPFLAGS = $(OC_BYTECODE_CPPFLAGS) $(ocamlruni_CPPFLAGS)
+
+runtime/%.bpic.$(O): OC_CFLAGS = $(OC_BYTECODE_CFLAGS) $(SHAREDLIB_CFLAGS)
+runtime/%.bpic.$(O): OC_CPPFLAGS = $(OC_BYTECODE_CPPFLAGS) $(ocamlrun_CPPFLAGS)
+$(DEPDIR)/runtime/%.bpic.$(D): \
+  OC_CPPFLAGS = $(OC_BYTECODE_CPPFLAGS) $(ocamlrun_CPPFLAGS)
+
+runtime/%.n.$(O): OC_CFLAGS = $(OC_NATIVE_CFLAGS)
+runtime/%.n.$(O): OC_CPPFLAGS = $(OC_NATIVE_CPPFLAGS) $(ocamlrun_CPPFLAGS)
+$(DEPDIR)/runtime/%.n.$(D): \
+  OC_CPPFLAGS = $(OC_NATIVE_CPPFLAGS) $(ocamlrun_CPPFLAGS)
+
+runtime/%.nd.$(O): OC_CFLAGS = $(OC_NATIVE_CFLAGS)
+runtime/%.nd.$(O): OC_CPPFLAGS = $(OC_NATIVE_CPPFLAGS) $(ocamlrund_CPPFLAGS)
 $(DEPDIR)/runtime/%.nd.$(D): \
-  OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlrund_CPPFLAGS)
+  OC_CPPFLAGS = $(OC_NATIVE_CPPFLAGS) $(ocamlrund_CPPFLAGS)
 
-runtime/%.ni.$(O): OC_CFLAGS += $(OC_NATIVE_CFLAGS)
-runtime/%.ni.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlruni_CPPFLAGS)
+runtime/%.ni.$(O): OC_CFLAGS = $(OC_NATIVE_CFLAGS)
+runtime/%.ni.$(O): OC_CPPFLAGS = $(OC_NATIVE_CPPFLAGS) $(ocamlruni_CPPFLAGS)
 $(DEPDIR)/runtime/%.ni.$(D): \
-  OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS) $(ocamlruni_CPPFLAGS)
+  OC_CPPFLAGS = $(OC_NATIVE_CPPFLAGS) $(ocamlruni_CPPFLAGS)
 
-runtime/%.npic.$(O): OC_CFLAGS += $(OC_NATIVE_CFLAGS) $(SHAREDLIB_CFLAGS)
-runtime/%.npic.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
-$(DEPDIR)/runtime/%.npic.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
+runtime/%.npic.$(O): OC_CFLAGS = $(OC_NATIVE_CFLAGS) $(SHAREDLIB_CFLAGS)
+runtime/%.npic.$(O): OC_CPPFLAGS = $(OC_NATIVE_CPPFLAGS) $(ocamlrun_CPPFLAGS)
+$(DEPDIR)/runtime/%.npic.$(D): \
+  OC_CPPFLAGS = $(OC_NATIVE_CPPFLAGS) $(ocamlrun_CPPFLAGS)
 
 ## Compilation of runtime C files
 
@@ -1409,10 +1519,19 @@ $(1).$(O): $(2).c \
   $(runtime_CONFIGURED_HEADERS) $(runtime_BUILT_HEADERS) \
   $(RUNTIME_HEADERS)
 endif # ifeq "$(COMPUTE_DEPS)" "true"
-       $$(V_CC)$$(CC) -c $$(OC_CFLAGS) $$(CFLAGS) $$(OC_CPPFLAGS) $$(CPPFLAGS) \
-         $$(OUTPUTOBJ)$$@ $$<
+       $$(V_CC)$$(CC) $$(OC_CFLAGS) $$(CFLAGS) $$(OC_CPPFLAGS) $$(CPPFLAGS) \
+         $$(OUTPUTOBJ)$$@ -c $$<
 endef
 
+runtime/winpthreads/%.$(O): $(WINPTHREADS_SOURCE_DIR)/src/%.c \
+                            $(wildcard $(WINPTHREADS_SOURCE_DIR)/include/*.h) \
+                              | runtime/winpthreads
+       $(V_CC)$(CC) $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
+         $(OUTPUTOBJ)$@ -c $<
+
+runtime/winpthreads:
+       $(MKDIR) $@
+
 $(DEPDIR)/runtime:
        $(MKDIR) $@
 
@@ -1499,7 +1618,7 @@ clean::
        rm -f runtime/primitives runtime/primitives*.new runtime/prims.c \
          $(runtime_BUILT_HEADERS)
        rm -f runtime/domain_state.inc
-       rm -rf $(DEPDIR)
+       rm -rf $(DEPDIR) runtime/winpthreads
        rm -f stdlib/libcamlrun.a stdlib/libcamlrun.lib
 
 .PHONY: runtimeopt
@@ -1518,7 +1637,13 @@ clean::
 
 # Dependencies
 
-subdirs = stdlib $(addprefix otherlibs/, $(ALL_OTHERLIBS))
+# The following definition duplicates the otherlibs/ prefix but this
+# will go away with the merge of the sub makefiles
+subdirs = stdlib \
+  otherlibs/str \
+  otherlibs/systhreads \
+  otherlibs/unix \
+  otherlibs/runtime_events
 
 .PHONY: alldepend
 alldepend: depend
@@ -1604,7 +1729,8 @@ $(ocamlyacc_PROGRAM)$(EXE): $(ocamlyacc_OBJECTS)
        $(V_MKEXE)$(MKEXE) -o $@ $^
 
 clean::
-       rm -f $(ocamlyacc_MODULES:=.o) $(ocamlyacc_MODULES:=.obj)
+       rm -f $(ocamlyacc_MODULES:=.o) $(ocamlyacc_MODULES:=.obj) \
+        yacc/wstr.o yacc/wstr.obj
 
 $(ocamlyacc_OTHER_MODULES:=.$(O)): yacc/defs.h
 
@@ -1732,7 +1858,6 @@ OCAMLDOC_LIBCMIS=$(OCAMLDOC_LIBMLIS:.mli=.cmi)
 OCAMLDOC_LIBCMTS=$(OCAMLDOC_LIBMLIS:.mli=.cmt) $(OCAMLDOC_LIBMLIS:.mli=.cmti)
 
 ocamldoc/%: CAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS)
-
 ocamldoc/%: CAMLOPT = $(BEST_OCAMLOPT) $(STDLIBFLAGS)
 
 .PHONY: ocamldoc
@@ -1863,7 +1988,7 @@ $(asmgen_OBJECT): $(asmgen_SOURCE)
        $(V_ASM)$(ASPP) $(OC_ASPPFLAGS) -o $@ $< || $(ASPP_ERROR)
 endif
 
-ocamltest/ocamltest$(EXE): OC_BYTECODE_LINKFLAGS += -custom
+ocamltest/ocamltest$(EXE): OC_BYTECODE_LINKFLAGS += -custom -g
 
 ocamltest/ocamltest$(EXE): ocamlc ocamlyacc ocamllex
 
@@ -1947,21 +2072,31 @@ ocamltest/ocamltest.html: ocamltest/ocamltest.org
 # The extra libraries
 
 .PHONY: otherlibraries
-otherlibraries: ocamltools
+otherlibraries: ocamltools dynlink-all
        $(MAKE) -C otherlibs all
 
 .PHONY: otherlibrariesopt
-otherlibrariesopt:
+otherlibrariesopt: dynlink-allopt
        $(MAKE) -C otherlibs allopt
 
 otherlibs/unix/unix.cmxa: otherlibrariesopt
-otherlibs/dynlink/dynlink.cmxa: otherlibrariesopt
 otherlibs/str/str.cmxa: otherlibrariesopt
 
 partialclean::
+       rm -f otherlibs/dynlink/*.cm[ioaxt] otherlibs/dynlink/*.cmti \
+         otherlibs/dynlink/*.cmxa otherlibs/dynlink/byte/*.cm[iot] \
+         otherlibs/dynlink/byte/*.cmti otherlibs/dynlink/native/*.cm[ixt] \
+         otherlibs/dynlink/native/*.cmti otherlibs/dynlink/native/*.o \
+         otherlibs/dynlink/native/*.obj
        $(MAKE) -C otherlibs partialclean
 
 clean::
+       rm -f otherlibs/dynlink/*.a otherlibs/dynlink/*.lib \
+         otherlibs/dynlink/*.o otherlibs/dynlink/*.obj \
+         otherlibs/dynlink/*.so otherlibs/dynlink/*.dll \
+         otherlibs/dynlink/byte/dynlink.mli \
+         otherlibs/dynlink/native/dynlink.mli \
+
        $(MAKE) -C otherlibs clean
 
 # The replay debugger
@@ -1975,7 +2110,6 @@ ocamldebug_LIBRARIES = compilerlibs/ocamlcommon \
 # possible to get rid of these dependencies
 
 otherlibs/unix/unix.cma: otherlibraries
-otherlibs/dynlink/dynlink.cma: otherlibraries
 otherlibs/str/str.cma: otherlibraries
 
 debugger/%: VPATH += otherlibs/unix otherlibs/dynlink
@@ -2030,7 +2164,7 @@ ocamldebug_SOURCES = \
     ocamldebug.ml \
     ocamldebug_entry.mli ocamldebug_entry.ml)
 
-debugger/%: OC_BYTECODE_LINKFLAGS = -linkall
+ocamldebug_BYTECODE_LINKFLAGS = -linkall
 
 debugger/%: CAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS)
 
@@ -2102,6 +2236,18 @@ lintapidiff: tools/lintapidiff.opt$(EXE)
            grep -Ev internal\|obj\|stdLabels\|moreLabels |\
            tools/lintapidiff.opt $(VERSIONS)
 
+# Regenerate otherlibs/dynlink/byte/dynlink_symtable from its bytecomp sources
+
+sync_dynlink_SOURCES = tools/sync_dynlink.mli tools/sync_dynlink.ml
+sync_dynlink_LIBRARIES =
+
+.PHONY: sync_dynlink
+sync_dynlink: tools/sync_dynlink.opt$(EXE)
+           ./tools/sync_dynlink.opt$(EXE) \
+        otherlibs/dynlink/byte/dynlink_symtable.ml \
+      > synced_dynlink.tmp
+           diff -u synced_dynlink.tmp otherlibs/dynlink/byte/dynlink_symtable.ml
+           rm synced_dynlink.tmp
 # Tools
 
 TOOLS_BYTECODE_TARGETS = \
@@ -2163,6 +2309,7 @@ ocamlprof_LIBRARIES =
 ocamlprof_SOURCES = \
   config.mli config.ml \
   build_path_prefix_map.mli build_path_prefix_map.ml \
+  format_doc.mli format_doc.ml \
   misc.mli misc.ml \
   identifiable.mli identifiable.ml \
   numbers.mli numbers.ml \
@@ -2189,6 +2336,7 @@ ocamlprof_SOURCES = \
 ocamlcp_ocamloptp_SOURCES = \
   config.mli config.ml \
   build_path_prefix_map.mli build_path_prefix_map.ml \
+  format_doc.mli format_doc.ml \
   misc.mli misc.ml \
   profile.mli profile.ml \
   warnings.mli warnings.ml \
@@ -2216,6 +2364,7 @@ ocamlmklib_LIBRARIES =
 ocamlmklib_SOURCES = \
   config.ml \
   build_path_prefix_map.ml \
+  format_doc.ml \
   misc.ml \
   ocamlmklib.mli ocamlmklib.ml
 
@@ -2225,6 +2374,7 @@ ocamlmktop_LIBRARIES =
 ocamlmktop_SOURCES = \
   config.mli config.ml \
   build_path_prefix_map.mli build_path_prefix_map.ml \
+  format_doc.mli format_doc.ml \
   misc.mli misc.ml \
   identifiable.mli identifiable.ml \
   numbers.mli numbers.ml \
@@ -2405,25 +2555,86 @@ partialclean::
            $$d/*.o $$d/*.obj $$d/*.so $$d/*.dll; \
        done
 
+%.depend: beforedepend
+       $(V_OCAMLDEP)$(OCAMLDEP) $(OC_OCAMLDEPFLAGS) -I $* $(INCLUDES) \
+         $(OCAMLDEPFLAGS) $*/*.mli $*/*.ml > $@
+
+asmcomp.depend:: beforedepend $(cvt_emit)
+       $(V_OCAMLDEP)$(OCAMLDEP) $(OC_OCAMLDEPFLAGS) -I asmcomp $(INCLUDES) \
+         $(OCAMLDEPFLAGS) $(filter-out $(ARCH_SPECIFIC) asmcomp/emit.ml, \
+                                       $(wildcard asmcomp/*.mli asmcomp/*.ml)) > $@
+
+partialclean::
+       rm -f $(addsuffix .depend, $(ARCH_SPECIFIC) asmcomp/emit.ml)
+
+# asmcomp.depend contains the dependencies for all the backends, with ifeq used
+# to select the correct one depending on the ARCH variable. In order to
+# generate this file, we must temporarily replace the $(ARCH_SPECIFIC) files
+# with the ones for each architecture. At the end of this process, the files for
+# the active architecture (i.e. $(ARCH)) must be restored, but if we simply
+# re-link the files we will trigger a complete rebuild of the native compiler
+# and .opt binaries. The recipe for asmcomp.depend therefore begins by renaming
+# the existing files, then it generates asmcomp.depend and then we rename the
+# files back. This means their timestamps are unaltered, and the next invocation
+# of make therefore correctly doesn't rebuild anything.
+
+define MV_FILE
+asmcomp.depend::
+       @mv $(1) $(2)
+
+endef
+
+$(foreach file, asmcomp/emit.ml $(ARCH_SPECIFIC),\
+  $(eval $(call MV_FILE,$(file),$(file).depend)))
+
+define ADD_ARCH_SPECIFIC_DEPS
+asmcomp.depend::
+       @echo 'ifeq "$$$$(ARCH)" "$(1)"' > asmcomp/$(1).depend
+       @$$(MAKE) ARCH=$(1) asmcomp/emit.ml $$(ARCH_SPECIFIC)
+       @$$(OCAMLDEP) $$(OC_OCAMLDEPFLAGS) -I asmcomp $$(INCLUDES) \
+         $$(OCAMLDEPFLAGS) asmcomp/emit.ml $$(ARCH_SPECIFIC) >> asmcomp/$(1).depend
+       @echo 'endif # ifeq "$$$$(ARCH)" "$(1)"' >> asmcomp/$(1).depend
+       @rm -f asmcomp/emit.ml $$(ARCH_SPECIFIC)
+
+endef
+
+$(foreach arch, $(ARCHES),\
+  $(eval $(call ADD_ARCH_SPECIFIC_DEPS,$(arch))))
+
+asmcomp.depend::
+       @cat $(addprefix asmcomp/, $(addsuffix .depend, $(ARCHES))) >> $@
+       @rm -f $(addprefix asmcomp/, $(addsuffix .depend, $(ARCHES)))
+
+$(foreach file, asmcomp/emit.ml $(ARCH_SPECIFIC),\
+  $(eval $(call MV_FILE,$(file).depend,$(file))))
+
+DEP_DIRS = \
+  utils parsing typing bytecomp asmcomp middle_end lambda file_formats \
+  middle_end/closure middle_end/flambda middle_end/flambda/base_types driver \
+  toplevel toplevel/byte toplevel/native lex tools debugger ocamldoc ocamltest \
+  testsuite/lib testsuite/tools otherlibs/dynlink
+
+DEP_FILES = $(addsuffix .depend, $(DEP_DIRS))
+
+.INTERMEDIATE: $(DEP_FILES)
+
 .PHONY: depend
-depend: beforedepend
-       $(V_GEN)for d in utils parsing typing bytecomp asmcomp middle_end \
-         lambda file_formats middle_end/closure middle_end/flambda \
-         middle_end/flambda/base_types \
-         driver toplevel toplevel/byte toplevel/native lex tools debugger \
-        ocamldoc ocamltest testsuite/lib testsuite/tools; \
-        do \
-          $(OCAMLDEP) $(OC_OCAMLDEPFLAGS) -I $$d $(INCLUDES) \
-          $(OCAMLDEPFLAGS) $$d/*.mli $$d/*.ml \
-          || exit; \
-         done > .depend
+depend: $(DEP_FILES) | beforedepend
+       $(V_GEN)cat $^ > .$@
+       @rm -f $(DYNLINK_DEPEND_DUMMY_FILES)
 
 .PHONY: distclean
 distclean: clean
-       if [ -f flexdll/Makefile ]; then $(MAKE) -C flexdll distclean MSVC_DETECT=0; fi
+ifneq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
+       $(MAKE) -C flexdll distclean MSVC_DETECT=0
+endif
        $(MAKE) -C manual distclean
        rm -f ocamldoc/META
        rm -f $(addprefix ocamltest/,ocamltest_config.ml ocamltest_unix.ml)
+       rm -f otherlibs/dynlink/META otherlibs/dynlink/dynlink_config.ml \
+         otherlibs/dynlink/dynlink_cmo_format.mli \
+         otherlibs/dynlink/dynlink_cmxs_format.mli \
+         otherlibs/dynlink/dynlink_platform_intf.mli
        $(MAKE) -C otherlibs distclean
        rm -f $(runtime_CONFIGURED_HEADERS)
        $(MAKE) -C stdlib distclean
@@ -2435,9 +2646,12 @@ distclean: clean
              boot/flexdll_*.o boot/flexdll_*.obj \
              boot/*.cm* boot/libcamlrun.a boot/libcamlrun.lib boot/ocamlc.opt
        rm -f Makefile.config Makefile.build_config
-       rm -rf autom4te.cache flexdll-sources $(BYTE_BUILD_TREE) $(OPT_BUILD_TREE)
+       rm -rf autom4te.cache winpthreads-sources flexdll-sources \
+         $(BYTE_BUILD_TREE) $(OPT_BUILD_TREE)
        rm -f config.log config.status libtool
 
+INSTALL_LIBDIR_DYNLINK = $(INSTALL_LIBDIR)/dynlink
+
 # Installation
 .PHONY: install
 install:
@@ -2538,7 +2752,22 @@ endif
 ifeq "$(UNIX_OR_WIN32)" "unix" # Install manual pages only on Unix
        $(MAKE) -C man install
 endif
-       for i in $(OTHERLIBRARIES); do \
+# For dynlink, if installing over a previous OCaml version, ensure
+# dynlink is removed from the previous installation.
+       rm -f "$(INSTALL_LIBDIR)"/dynlink.cm* "$(INSTALL_LIBDIR)/dynlink.mli" \
+        "$(INSTALL_LIBDIR)/dynlink.$(A)" \
+        $(addprefix "$(INSTALL_LIBDIR)/", $(notdir $(dynlink_CMX_FILES)))
+       $(MKDIR) "$(INSTALL_LIBDIR_DYNLINK)"
+       $(INSTALL_DATA) \
+         otherlibs/dynlink/dynlink.cmi otherlibs/dynlink/dynlink.cma \
+         otherlibs/dynlink/META \
+         "$(INSTALL_LIBDIR_DYNLINK)"
+ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
+       $(INSTALL_DATA) \
+         otherlibs/dynlink/dynlink.cmti otherlibs/dynlink/dynlink.mli \
+         "$(INSTALL_LIBDIR_DYNLINK)"
+endif
+       for i in $(OTHERLIBS); do \
          $(MAKE) -C otherlibs/$$i install || exit $$?; \
        done
 ifeq "$(build_ocamldoc)" "true"
@@ -2659,7 +2888,13 @@ endif
          ocamldoc/odoc_info.cmxa \
          "$(INSTALL_LIBDIR)/ocamldoc"
 endif
-       for i in $(OTHERLIBRARIES); do \
+ifeq "$(strip $(NATDYNLINK))" "true"
+       $(INSTALL_DATA) \
+         $(dynlink_CMX_FILES) otherlibs/dynlink/dynlink.cmxa \
+         otherlibs/dynlink/dynlink.$(A) \
+         "$(INSTALL_LIBDIR_DYNLINK)"
+endif
+       for i in $(OTHERLIBS); do \
          $(MAKE) -C otherlibs/$$i installopt || exit $$?; \
        done
 ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"

diff --git a/Makefile.build_config.in b/Makefile.build_config.in
index 4df7f5178414d7d04c5d1ca4585304cf48313332..ae649dcebaa2ea867b24925e8424909a959071b9 100644 (file)
--- a/Makefile.build_config.in
+++ b/Makefile.build_config.in
@@ -42,6 +42,7 @@ OCAMLTEST_TARGET = @ocamltest_target@
 OCAMLDOC_OPT_TARGET = @ocamldoc_opt_target@
 OCAMLTEST_OPT_TARGET = @ocamltest_opt_target@
 
+build_ocamlobjinfo = @build_ocamlobjinfo@
 build_ocamltest = @build_ocamltest@
 
 build_ocamltex = @build_ocamltex@
@@ -52,6 +53,15 @@ lib_str = @lib_str@
 lib_systhreads = @lib_systhreads@
 lib_unix = @lib_unix@
 
+# The following variable is added to keep track of which other libraries
+# have to be built by the recursive makefiles (not to be confused with
+# the OTHERLIBRARIES variable defined in Makefile.config.in and which
+# lists all the other libraries that get built, no matter how).
+# This variable is expected to disappear once all the makefiles under
+# otherlibs/ have been merged into the root Makefile
+
+OTHERLIBS = @otherlibs@
+
 OPTIONAL_LIBRARIES = @optional_libraries@
 OPTIONAL_BYTECODE_TOOLS = @optional_bytecode_tools@
 OPTIONAL_NATIVE_TOOLS = @optional_native_tools@
@@ -63,33 +73,31 @@ INSTALL_OCAMLNAT = @install_ocamlnat@
 DEP_CC=@DEP_CC@ -MM
 COMPUTE_DEPS=@compute_deps@
 
-# Build-system flags to use to compile C files
-OC_CFLAGS=@oc_cflags@
-OC_CPPFLAGS=-I$(ROOTDIR)/runtime @oc_cppflags@
+# Default flags to use to compile C files
+OC_CFLAGS = @oc_cflags@
 
-# The following variable defines flags to be passed to the C preprocessor
-# when compiling C files to be linked with native code. This includes
-# the native runtime itself and can also include the stub code around
-# C libraries when it needs to be different from the one used to
-# link with bytecode.
+# Flags to use when compiling C files to be linked with bytecode
+OC_BYTECODE_CFLAGS = @oc_bytecode_cflags@
 
-# These flags should be passed *in addition* to those in OC_CPPFLAGS, they
-# should not replace them.
+# Flags to use when compiling C files to be linked with native code
+OC_NATIVE_CFLAGS = @oc_native_cflags@
 
-OC_NATIVE_CPPFLAGS=-DNATIVE_CODE @native_cppflags@
+# The submodules should be searched *before* any other external -I paths
+OC_INCLUDES = $(addprefix -I $(ROOTDIR)/, \
+  runtime @flexdll_source_dir@ @winpthreads_source_include_dir@)
+OC_CPPFLAGS = $(OC_INCLUDES) @oc_cppflags@
 
-# Same as above, for CFLAGS
-OC_NATIVE_CFLAGS=@native_cflags@
+OC_BYTECODE_CPPFLAGS = $(OC_INCLUDES) @oc_bytecode_cppflags@
+
+OC_NATIVE_CPPFLAGS = $(OC_INCLUDES) @oc_native_cppflags@
 
 # Additional link-time options
 # To support dynamic loading of shared libraries (they need to look at
 # our own symbols):
 OC_LDFLAGS=@oc_ldflags@
 OC_DLL_LDFLAGS=@oc_dll_ldflags@
-OC_EXE_LDFLAGS=@oc_exe_ldflags@
 
-MKEXE_VIA_CC=\
-  $(CC) $(OC_EXE_LDFLAGS) $(OC_CFLAGS) $(CFLAGS) @mkexe_via_cc_ldflags@
+MKEXE_VIA_CC=$(CC) @mkexe_via_cc_ldflags@ @mkexe_via_cc_extra_cmd@
 
 # Which tool to use to display differences between files
 DIFF=@DIFF@
@@ -111,6 +119,10 @@ DOCUMENTATION_TOOL_CMD=@documentation_tool_cmd@
 FLEXDLL_SOURCE_DIR=@flexdll_source_dir@
 BOOTSTRAPPING_FLEXDLL=@bootstrapping_flexdll@
 
+# The location of the Winpthreads sources to use (usually provided as the
+# winpthreads Git submodule)
+WINPTHREADS_SOURCE_DIR=@winpthreads_source_dir@
+
 ### Where to install documentation
 PACKAGE_TARNAME = @PACKAGE_TARNAME@
 datarootdir = @datarootdir@
@@ -139,10 +151,9 @@ DEFAULT_BUILD_TARGET = @default_build_target@
 # (other backends may be added in the future).
 #
 # ZZZ is either COMPFLAGS (compile-time flags) or LINKFLAGS (link-time flags).
-# Countrary to the C convention wrt. CFLAGS and LDFLAGS, the flags in the
-# COMPFLAGS category are not passed at link time, so if a flag is needed
-# at both stages, like e.g. -g, it should be added to both
-# XXX_YYY_COMPFLAGS and XXX_YYY_LINKFLAGS.
+# The flags in the COMPFLAGS category are not passed at link time,
+# so if a flag is needed at both stages, like e.g. -g, it should be
+# added to both XXX_YYY_COMPFLAGS and XXX_YYY_LINKFLAGS.
 
 OC_COMMON_COMPFLAGS = -g -strict-sequence -principal -absname \
   -w +a-4-9-40-41-42-44-45-48 -warn-error +a -bin-annot \

diff --git a/Makefile.common b/Makefile.common
index 986f6c399dc5bbac2b2553363338fc21fae8801c..1e6a7eff89031a49b13b43aa4e96212fe65347e8 100644 (file)
--- a/Makefile.common
+++ b/Makefile.common
@@ -171,8 +171,8 @@ REQUIRED_HEADERS := $(RUNTIME_HEADERS) $(wildcard *.h)
 endif
 
 %.$(O): %.c $(REQUIRED_HEADERS)
-       $(V_CC)$(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
-         $(OUTPUTOBJ)$@ $<
+       $(V_CC)$(CC) $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
+         $(OUTPUTOBJ)$@ -c $<
 
 $(DEPDIR):
        $(MKDIR) $@
@@ -284,7 +284,7 @@ endef # _OCAML_COMMON_BASE
 # Each program foo is characterised by the foo_LIBRARIES and foo_SOURCES
 # variables. The following macros provide the infrastructure to build foo
 # from the object files whose names are derived from these two
-# varialbes. In particular, the following macros define several
+# variables. In particular, the following macros define several
 # variables whose names are prefixed with foo_ to compute the
 # different lists of files used to build foo.
 
@@ -297,6 +297,8 @@ endef # _OCAML_COMMON_BASE
 
 define _OCAML_PROGRAM_BASE
 $(eval $(call _OCAML_COMMON_BASE,$(1)))
+# To be overridden by the programs needing special link flags
+$(basename $(notdir $(1)))_COMMON_LINKFLAGS =
 endef # _OCAML_PROGRAM_BASE
 
 LINK_BYTECODE_PROGRAM =\
@@ -319,8 +321,17 @@ $(basename $(notdir $(1)))_BCOBJS = \
   $$($(basename $(notdir $(1)))_CMA_FILES) \
   $$($(basename $(notdir $(1)))_BO_FILES) \
   $$($(basename $(notdir $(1)))_CMO_FILES)
+# To be overridden by the programs needing special bytecode link flags
+$(basename $(notdir $(1)))_BYTECODE_LINKFLAGS =
+
+$(basename $(notdir $(1)))_BYTECODE_LINKCMD = \
+$(strip \
+  $$(CAMLC) $$(OC_COMMON_LINKFLAGS) $$(OC_BYTECODE_LINKFLAGS) \
+  $$($(basename $(notdir $(1)))_COMMON_LINKFLAGS) \
+  $$($(basename $(notdir $(1)))_BYTECODE_LINKFLAGS))
+
 $(1)$(EXE): $$$$($(basename $(notdir $(1)))_BCOBJS)
-       $$(V_LINKC)$$(LINK_BYTECODE_PROGRAM) -o $$@ \
+       $$(V_LINKC)$$($(basename $(notdir $(1)))_BYTECODE_LINKCMD) -o $$@ \
          $$($(basename $(notdir $(1)))_BCOBJS)
 endef # _OCAML_BYTECODE_PROGRAM
 
@@ -329,9 +340,6 @@ $(eval $(call _OCAML_PROGRAM_BASE,$(1)))
 $(eval $(call _OCAML_BYTECODE_PROGRAM,$(1)))
 endef # OCAML_BYTECODE_PROGRAM
 
-LINK_NATIVE_PROGRAM =\
-  $(CAMLOPT) $(OC_COMMON_LINKFLAGS) $(OC_NATIVE_LINKFLAGS)
-
 define _OCAML_NATIVE_PROGRAM
 $(eval $(call PROGRAM_SYNONYM,$(1)))
 $(basename $(notdir $(1)))_CMXA_FILES = \
@@ -345,8 +353,18 @@ $(basename $(notdir $(1)))_NCOBJS = \
   $$($(basename $(notdir $(1)))_CMXA_FILES) \
   $$($(basename $(notdir $(1)))_NO_FILES) \
   $$($(basename $(notdir $(1)))_CMX_FILES)
+
+# To be overridden by the programs needing special native link flags
+$(basename $(notdir $(1)))_NATIVE_LINKFLAGS =
+
+$(basename $(notdir $(1)))_NATIVE_LINKCMD = \
+$(strip \
+  $$(CAMLOPT) $$(OC_COMMON_LINKFLAGS) $$(OC_NATIVE_LINKFLAGS) \
+  $$($(basename $(notdir $(1)))_COMMON_LINKFLAGS) \
+  $$($(basename $(notdir $(1)))_NATIVE_LINKFLAGS))
+
 $(1)$(EXE): $$$$($(basename $(notdir $(1)))_NCOBJS)
-       $$(V_LINKOPT)$$(LINK_NATIVE_PROGRAM) -o $$@ \
+       $$(V_LINKOPT)$$($(basename $(notdir $(1)))_NATIVE_LINKCMD) -o $$@ \
          $$($(basename $(notdir $(1)))_NCOBJS)
 endef # _OCAML_NATIVE_PROGRAM
 

diff --git a/Makefile.config.in b/Makefile.config.in
index 559738f6ed05c89460d47ac611b8bd29a63b7428..e432851cdea59304756bf34385c9a5a624b4fa9f 100644 (file)
--- a/Makefile.config.in
+++ b/Makefile.config.in
@@ -161,9 +161,9 @@ INSTALL_SOURCE_ARTIFACTS=@install_source_artifacts@
 
 CFLAGS=@CFLAGS@
 CPPFLAGS=@CPPFLAGS@
-OCAMLC_CFLAGS=@ocamlc_cflags@
+BYTECODE_CFLAGS=@bytecode_cflags@
 
-OCAMLC_CPPFLAGS=@ocamlc_cppflags@
+BYTECODE_CPPFLAGS=@bytecode_cppflags@
 ZSTD_LIBS=@zstd_libs@
 BYTECCLIBS=@zstd_libs@ @cclibs@
 EXE=@exeext@
@@ -175,12 +175,16 @@ NATDYNLINK=@natdynlink@
 NATDYNLINKOPTS=@natdynlinkopts@
 SYSLIB=@syslib@
 MKLIB=@mklib@
-# #7678: ocamlopt uses these only to compile .c files, and the behaviour for the
-#        two drivers should be identical.
-OCAMLOPT_CFLAGS=@ocamlc_cflags@
-OCAMLOPT_CPPFLAGS=@ocamlc_cppflags@
+
+# The following variable defines flags to be passed to the C preprocessor
+# when compiling C files to be linked with native code. This includes
+# the native runtime itself and can also include the stub code around
+# C libraries when it needs to be different from the one used to
+# link with bytecode.
+
 NATIVECCLIBS=@cclibs@
 SYSTHREAD_SUPPORT=@systhread_support@
+STRIP=@STRIP@
 PACKLD=@PACKLD@$(EMPTY)
 CCOMPTYPE=@ccomptype@
 TOOLCHAIN=@toolchain@
@@ -217,6 +221,13 @@ NAKED_POINTERS=false
 
 # Deprecated variables
 
+## Variables deprecated since OCaml 5.3
+
+OCAMLC_CFLAGS=@bytecode_cflags@
+OCAMLOPT_CFLAGS=@native_cflags@
+OCAMLC_CPPFLAGS=@bytecode_cppflags@
+OCAMLOPT_CPPFLAGS=@native_cppflags@
+
 ## Variables deprecated since OCaml 5.2
 
 STDLIB_MANPAGES=@build_libraries_manpages@

diff --git a/README.adoc b/README.adoc
index 078bd745084026ef10fb9d68b019bf1db9afe3ab..7e622fcd18b4e657aee0a64e1b3dc27b8cb4fc9d 100644 (file)
--- a/README.adoc
+++ b/README.adoc
@@ -1,28 +1,18 @@
-=== ⚠️ CAUTION
-
-The developer team released OCaml 5.0.0 in December 2022. This release sports a
+[CAUTION]
+====
+The developer team released OCaml 5.0.0 in December 2022. OCaml 5.x features a
 full rewrite of its runtime system for shared-memory parallel programming using
 domains and native support for concurrent programming using effect handlers.
 
-Owing to the large number of changes, the initial 5.0 release is more
-experimental than usual.  It is recommended that all users wanting a stable
-release use the 4.14 release which will continue to be supported and updated
-while 5.x reaches feature and stability parity. Similarly, if you need one of
-the ports not yet supported in the 5.0 release you must use the 4.14 release.
-
-The initial release of OCaml 5.0 only supports the native compiler under ARM64
-and x86-64 architectures under Linux, macOS and the BSDs. On Windows, only the
-MinGW-w64 port is supported in OCaml 5.0 and the Cygwin port is restored in 5.1.
-On Linux, native code support for RISC-V and s390x/IBM Z will be available in
-OCaml 5.1 and on Power in 5.2.
-
-❗ From OCaml 5.0 onwards, native compilation is available only on 64-bit
-systems.  Native compilation on 32-bit systems is no longer available, nor
-are there plans to bring it back. The bytecode compiler will continue to work on
-all architectures.
+Owing to the large number of changes, especially to the garbage collector,
+OCaml 4.14 (the final release in the OCaml 4.x series, originally released in
+March 2022) remains supported for the time being. Maintainers of existing
+codebases are strongly encouraged to evaluate OCaml 5.x and to report any
+performance degradations on our issue tracker.
+====
 
 |=====
-| Branch `trunk` | Branch `5.1` | Branch `5.0` | Branch `4.14`
+| Branch `trunk` | Branch `5.2` | Branch `5.1` | Branch `5.0` | Branch `4.14`
 
 | image:https://github.com/ocaml/ocaml/workflows/Build/badge.svg?branch=trunk["Github CI Build Status (trunk branch)",
      link="https://github.com/ocaml/ocaml/actions?query=workflow%3ABuild"]
@@ -30,6 +20,10 @@ all architectures.
      link="https://github.com/ocaml/ocaml/actions?query=workflow%3AHygiene"]
   image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=trunk&svg=true["AppVeyor Build Status (trunk branch)",
      link="https://ci.appveyor.com/project/avsm/ocaml"]
+| image:https://github.com/ocaml/ocaml/workflows/Build/badge.svg?branch=5.2["Github CI Build Status (5.2 branch)",
+     link="https://github.com/ocaml/ocaml/actions?query=workflow%3ABuild"]
+  image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=5.2&svg=true["AppVeyor Build Status (5.2 branch)",
+     link="https://ci.appveyor.com/project/avsm/ocaml"]
 | image:https://github.com/ocaml/ocaml/workflows/Build/badge.svg?branch=5.1["Github CI Build Status (5.1 branch)",
      link="https://github.com/ocaml/ocaml/actions?query=workflow%3ABuild"]
   image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=5.1&svg=true["AppVeyor Build Status (5.1 branch)",
@@ -79,6 +73,9 @@ compiler currently runs on the following platforms:
 Other operating systems for the processors above have not been tested, but
 the compiler may work under other operating systems with little work.
 
+❗ From OCaml 5.0 onwards, native compilation is available only on 64-bit
+systems.  Native compilation on 32-bit systems is no longer available, nor
+are there plans to bring it back.
 
 == Copyright
 
@@ -98,7 +95,7 @@ Windows, see link:README.win32.adoc[].
 The OCaml manual is distributed in HTML, PDF, and Emacs
 Info files.  It is available at
 
-https://ocaml.org/releases/latest/manual.html
+https://ocaml.org/manual/latest/
 
 == Availability
 
@@ -106,6 +103,14 @@ The complete OCaml distribution can be accessed at
 
 https://ocaml.org/docs/install.html
 
+== Releases
+
+More information about when and how new releases of OCaml are published is
+available at link:release-info/introduction.md[], see also
+link:release-info/calendar.md[] for a prospective calendar for future OCaml
+versions. For past versions, link:release-info/News[] contains a short
+description of major changes in previous versions.
+
 == Keeping in Touch with the Caml Community
 
 There is an active and friendly discussion forum at
@@ -139,6 +144,8 @@ To be effective, bug reports should include a complete program (preferably
 small) that exhibits the unexpected behavior, and the configuration you are
 using (machine type, etc).
 
+== Contributing
+
 For information on contributing to OCaml, see link:HACKING.adoc[] and
 link:CONTRIBUTING.md[].
 

diff --git a/README.win32.adoc b/README.win32.adoc
index 901d3c30d10c1d4fe7bcce0f494138da94f90209..aa7cfd0928c26411e0b393f843586d15f5a577dd 100644 (file)
--- a/README.win32.adoc
+++ b/README.win32.adoc
@@ -1,20 +1,3 @@
-=== ⚠️ CAUTION
-
-The developer team is currently preparing the release of OCaml 5.0. This release
-sports a full rewrite of its runtime system for shared-memory parallel
-programming using domains and native support for concurrent programming using
-effect handlers.
-
-Owing to the large number of changes, the initial 5.0 release will be more
-experimental than usual.  It is recommended that all users wanting a stable
-release use the 4.14 release which will continue to be supported and updated
-while 5.0 reaches feature and stability parity. Similarly, if you need one of
-the ports not yet supported in the 5.0 release you must use the 4.14 release.
-
-The MSVC port is presently not supported, but will hopefully be added back in
-later releases. On 32-bit systems, only the bytecode compiler is supported.
-Native-code support for these 32-bit systems is under discussion.
-
 = Release notes for the Microsoft Windows ports of OCaml =
 :toc: macro
 
@@ -23,7 +6,7 @@ available in 32 and 64-bit versions:
 
   - native Windows, built with the Microsoft C/C++ Optimizing Compiler
   - native Windows, built using the MinGW-w64 version of GCC
-  - Cygwin (http://www.cygwin.com[www.cygwin.com])
+  - Cygwin (https://www.cygwin.com[https://www.cygwin.com])
 
 Here is a summary of the main differences between these ports:
 
@@ -31,7 +14,7 @@ Here is a summary of the main differences between these ports:
 |                                        | Native Microsoft       | Native MinGW-w64 | Cygwin
 4+^| Third-party software required
 | for base bytecode system               | none                   | none             | none
-| for `ocamlc -custom`                     | Microsoft Visual C++   | Cygwin           | Cygwin
+| for `ocamlc -custom`                   | Microsoft Visual C++   | Cygwin           | Cygwin
 | for native-code generation             | Microsoft Visual C++   | Cygwin           | Cygwin
 4+^| Features
 | Speed of bytecode interpreter          | 70%                    | 100%             | 100%
@@ -44,7 +27,7 @@ Here is a summary of the main differences between these ports:
 [[tb1]]
 (*):: Executables generated by the native GCC package in Cygwin are linked with
 the Cygwin DLL and require this to be distributed with your programs.
-Executables generated by Microsoft Visual C++ or the MinGW-w64 compilers (even
+Executables generated by Microsoft Visual {cpp} or the MinGW-w64 compilers (even
 when run in Cygwin as `i686-w64-mingw32-gcc` or `x86_64-w64-mingw32-gcc`) are
 not linked against this DLL. Prior to Cygwin 2.5.2 (the Cygwin version can be
 obtained with `uname -r`) the Cygwin DLL is distributed under the GPL, requiring
@@ -62,8 +45,8 @@ Cygwin aims to provide a Unix-like environment on Windows, and the build
 procedure for it is the same as for other flavours of Unix.  See
 link:INSTALL.adoc[] for full instructions.
 
-The native ports require Windows Vista or later and naturally the 64-bit versions
-need a 64-bit edition of Windows (note that this is both to run *and* build).
+OCaml requires Windows 8 or later and naturally the 64-bit versions need a
+64-bit edition of Windows (note that this is both to run *and* build).
 
 The two native Windows ports have to be built differently, and the remainder of
 this document gives more information.
@@ -90,8 +73,8 @@ FlexDLL and OCaml are given <<seflexdll,later in this document>>.  Unless you
 bootstrap FlexDLL, you will need to ensure that the directory to which you
 install FlexDLL is included in your `PATH` environment variable. Note: binary
 distributions of FlexDLL are compatible only with Visual Studio 2013 and
-earlier; for Visual Studio 2015 and later, you will need to compile the C
-objects from source, or configure ocaml with the `--with-flexdll` option.
+earlier; for the MSVC port of OCaml, you will need to compile the C objects from
+source, or configure ocaml with the `--with-flexdll` option.
 
 The base bytecode system (ocamlc, ocaml, ocamllex, ocamlyacc, ...) of all three
 ports runs without any additional tools.
@@ -104,22 +87,19 @@ The native-code compiler (`ocamlopt`) and static linking of OCaml bytecode with
 C code (`ocamlc -custom`) require a Microsoft Visual C/C++ Compiler and the
 `flexlink` tool (see <<bmflex,above>>).
 
-Any edition (including Express/Community editions) of Microsoft Visual Studio
-2008 or later may be used to provide the required Windows headers and the C
-compiler. Additionally, some older Microsoft Windows SDKs include the
-Visual C/C++ Compiler as well as the Build Tools for Visual Studio.
+The OCaml runtime requires C11 atomics, which are available in
+Visual Studio 2022 (starting from release 17.8). Earlier versions (either of
+Visual Studio 2022 17.7 and earlier or Visual Studio 2019 and earlier) cannot
+be used to compile OCaml. In addition to the paid versions of Visual Studio,
+OCaml can be compiled with either Visual Studio 2022 Community or Build Tools
+for Visual Studio 2022. The following components are needed (the precise version
+numbers may differ, but this should not matter):
+
+ - MSVC v143 - VS 2022 C++ x64/x86 build tools (Latest) _for compiling with cl_
+ - C++ Clang Compiler for Windows (16.0.5) _for compiling with clang-cl_
+ - C++/CLI support for v143 build tools (Latest)
+ - Windows 11 SDK (10.0.22621.0)
 
-|=====
-|                    | `cl` Version | Express                 | SDK/Build Tools
-| Visual Studio 2008 | 15.00.x.x    | 32-bit only             | Windows SDK 7.0 also provides 32/64-bit compilers
-| Visual Studio 2010 | 16.00.x.x    | 32-bit only             | Windows SDK 7.1 also provides 32/64-bit compilers
-| Visual Studio 2012 | 17.00.x.x    | 32/64-bit               |
-| Visual Studio 2013 | 18.00.x.x    | 32/64-bit               |
-| Visual Studio 2015 | 19.00.x.x    | 32/64-bit               | Build Tools for Visual Studio 2015 also provides 32/64-bit compilers
-| Visual Studio 2017 | 19.10.x.x    | 32/64-bit               | Build Tools for Visual Studio 2017 also provides 32/64-bit compilers
-| Visual Studio 2019 | 19.20.x.x    | 32/64-bit               | Build Tools for Visual Studio 2019 also provides 32/64-bit compilers
-| Visual Studio 2022 | 19.37.x.x    | 32/64-bit               | Build Tools for Visual Studio 2022 also provides 32/64-bit compilers
-|=====
 
 === COMPILATION FROM THE SOURCES
 
@@ -131,62 +111,21 @@ the WinZip Options Window.)
 
 Microsoft Visual C/C++ is designed to be used from special developer mode
 Command Prompts which set the environment variables for the required compiler.
-There are multiple ways of setting up your environment ready for their use.  The
-simplest is to start the appropriate command prompt shortcut from the program
-group of the compiler you have installed.
-
-The details differ depending on whether you are using a Windows SDK to provide
-the compiler or Microsoft Visual Studio itself.
-
-For the Windows SDK, there is only one command prompt called "CMD Shell" in
-versions 6.1 and 7.0 and "Windows SDK 7.1 Command Prompt" in version 7.1. This
-launches a Command Prompt which will usually select a `DEBUG` build environment
-for the operating system that you are running. You should then run:
-
-  SetEnv /Release /x86
-
-for 32-bit or:
-
-  SetEnv /Release /x64
-
-for 64-bit. For Visual Studio 2008-2013, you need to use one of the shortcuts in
-the "Visual Studio Tools" program group under the main program group for the
-version of Visual Studio you installed. For Visual Studio 2015 and 2017, you
-need to use the shortcuts in the "Windows Desktop Command Prompts" (2015) or
-"VC" (2017) group under the "Visual Studio Tools" group.
-
-Unlike `SetEnv` for the Windows SDK, the architecture is selected by using a
-different shortcut, rather than by running a command.
-
-For Visual Studio 2008-2010, excluding version-specific prefixes, these are
-named "Command Prompt" for 32-bit and "x64 Cross Tools Command Prompt" or
-"x64 Win64 Command Prompt" for 64-bit. It does not matter whether you use a
-"Cross Tools" or "Win64" version for x64, this simply refers to whether the
-compiler itself is a 32-bit or 64-bit program; both produce 64-bit output and
-work with OCaml.
-
-For Visual Studio 2012 and 2013, both x86 and x64 Command Prompt shortcuts
-indicate if they are the "Native Tools" or "Cross Tools" versions. Visual Studio
-2015, 2017, and 2022 make the shortcuts even clearer by including the full name
-of the architecture.
-
-The Build Tools for Visual Studio 2015, 2017, and 2022 provide shortcuts similar
-to the ones of their respective Visual Studio version.
-
-You cannot at present use a cross-compiler to compile 64-bit OCaml on 32-bit
-Windows.
+The easiest way to access these is via the "Visual Studio 2022" group added to
+the Start Menu by the installer, for example using the
+"x64 Native Tools Command Prompt for VS 2022" shortcut.
 
 Once you have started a Command Prompt, you can verify that you have the
 compiler you are expecting simply by running:
 
   cl
-  Microsoft (R) C/C++ Optimizing Compiler Version 19.37.32825 for x64
+  Microsoft (R) C/C++ Optimizing Compiler Version 19.38.33133 for x64
   ...
 
 You then need to start Cygwin from this Command Prompt.  Assuming you have
-installed it to its default location of `C:\cygwin`, simply run:
+installed it to its default location of `C:\cygwin64`, simply run:
 
-  C:\cygwin\bin\mintty -
+  C:\cygwin64\bin\mintty -
 
 (note the space and hyphen at the end of the command).
 
@@ -205,15 +144,15 @@ the top-level of the OCaml distribution by running:
 If you forget to do this, `make` will fail relatively
 quickly as it will be unable to link `ocamlrun`.
 
-Now run:
+For 64-bit, now run:
 
-        ./configure --build=x86_64-pc-cygwin --host=i686-pc-windows
+        ./configure --build=x86_64-pc-cygwin --host=x86_64-pc-windows
 
-for 32-bit, or:
+or, for 32-bit:
 
-        ./configure --build=x86_64-pc-cygwin --host=x86_64-pc-windows
+        ./configure --build=x86_64-pc-cygwin --host=i686-pc-windows
 
-for 64-bit.
+If you wish to compile with Clang, add `CC=clang-cl`.
 
 Finally, use `make` to build the system, e.g.
 
@@ -259,8 +198,8 @@ package for 64-bit.
   - The Cygwin version of flexdll does not work with this port.
 
   - The standalone mingw toolchain from the MinGW-w64 project
-    (http://mingw-w64.org/) is not supported. Please use the version packaged in
-    Cygwin instead.
+    (https://www.mingw-w64.org/) is not supported. Please use the version
+    packaged in Cygwin instead.
 
 === COMPILATION FROM THE SOURCES
 
@@ -270,15 +209,13 @@ The command-line tools must be compiled from the Unix source distribution
 use WinZip, you will need to deselect "TAR file smart CR/LF conversion" in
 the WinZip Options Window.)
 
-Now run:
-
-        ./configure --build=x86_64-pc-cygwin --host=i686-w64-mingw32
-
-for 32-bit, or:
+For 64-bit, now run:
 
         ./configure --build=x86_64-pc-cygwin --host=x86_64-w64-mingw32
 
-for 64-bit.
+or, for 32-bit:
+
+        ./configure --build=x86_64-pc-cygwin --host=i686-w64-mingw32
 
 Finally, use `make` to build the system, e.g.
 
@@ -287,7 +224,8 @@ Finally, use `make` to build the system, e.g.
 
 After installing, you will need to ensure that `ocamlopt` (or `ocamlc -custom`)
 can access the C compiler.  You can do this either by using OCaml from Cygwin's
-bash or by adding Cygwin's bin directory (e.g. `C:\cygwin\bin`) to your `PATH`.
+bash or by adding Cygwin's bin directory (e.g. `C:\cygwin64\bin`) to your
+`PATH`.
 
 * Libraries available in this port: `dynlink`, `num`,
   `str`, `threads`, and large parts of `unix`.
@@ -340,10 +278,10 @@ OCaml adds to this legacy mode a new "Unicode" mode, where filenames
 are UTF-8 encoded strings.  In addition to filenames,
 this applies to environment variables and command-line arguments.
 
-The mode must be decided before building the system, by tweaking
-the `WINDOWS_UNICODE` variable in `Makefile.config`.  A value of 1
-enables the the new "Unicode" mode, while a value of 0 maintains
-the legacy mode.
+The mode must be decided before building the system, by tweaking the
+`WINDOWS_UNICODE_MODE` environment variable when calling `configure`.
+The default, or a value of `compatible`, enables the new "Unicode"
+mode, while a value of `ansi` maintains the legacy mode.
 
 Technically, both modes use the Windows "wide" API, where filenames
 and other strings are made of 16-bit entities, usually interpreted as

diff --git a/VERSION b/VERSION
index c78236c7aea7674a341e9005eb4fb4d356c0009c..ba316f955c6e6c5db2a2e3f2cbc34fc316faadbc 100644 (file)
--- a/VERSION
+++ b/VERSION
@@ -1,4 +1,4 @@
-5.2.1
+5.3.0
 
 # Starting with OCaml 4.14, although the version string that appears above is
 # still correct and this file can thus still be used to figure it out,

diff --git a/aclocal.m4 b/aclocal.m4
index cb73385dda20f084698bea04953f19bbf237ee2c..7353e09a96ef214896eac5b3244aace3a93b4ad9 100644 (file)
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -26,9 +26,9 @@ m4_include([build-aux/ltoptions.m4])
 m4_include([build-aux/ltsugar.m4])
 m4_include([build-aux/ltversion.m4])
 m4_include([build-aux/lt~obsolete.m4])
-m4_include([build-aux/ax_check_compile_flag.m4])
 
 # Macros from the autoconf macro archive
+m4_include([build-aux/ax_check_compile_flag.m4])
 m4_include([build-aux/ax_func_which_gethostbyname_r.m4])
 m4_include([build-aux/ax_pthread.m4])
 
@@ -87,76 +87,28 @@ AC_DEFUN([OCAML_SIGNAL_HANDLERS_SEMANTICS], [
   AC_CHECK_FUNC([sigaction], [has_sigaction=true], [has_sigaction=false])
   AC_CHECK_FUNC([sigprocmask], [has_sigprocmask=true], [has_sigprocmask=false])
   AS_IF([$has_sigaction && $has_sigprocmask],
-    [AC_DEFINE([POSIX_SIGNALS])
+    [AC_DEFINE([POSIX_SIGNALS], [1])
       AC_MSG_NOTICE([POSIX signal handling found.])],
     [AC_MSG_NOTICE([assuming signals have the System V semantics.])
     ]
   )
 ])
 
-AC_DEFUN([OCAML_CC_HAS_FNO_TREE_VRP], [
-  AC_MSG_CHECKING([whether the C compiler supports -fno-tree-vrp])
-  saved_CFLAGS="$CFLAGS"
-  CFLAGS="-Werror -fno-tree-vrp $CFLAGS"
-  AC_COMPILE_IFELSE(
-    [AC_LANG_SOURCE([int main() { return 0; }])],
-    [cc_has_fno_tree_vrp=true
-    AC_MSG_RESULT([yes])],
-    [cc_has_fno_tree_vrp=false
-    AC_MSG_RESULT([no])])
-  CFLAGS="$saved_CFLAGS"
-])
-
-AC_DEFUN([OCAML_CC_SUPPORTS_ALIGNED], [
-  AC_MSG_CHECKING([whether the C compiler supports __attribute__((aligned(n)))])
-  AC_COMPILE_IFELSE(
-    [AC_LANG_SOURCE([typedef struct {__attribute__((aligned(8))) int t;} t;])],
-    [AC_DEFINE([SUPPORTS_ALIGNED_ATTRIBUTE])
-    AC_MSG_RESULT([yes])],
-    [AC_MSG_RESULT([no])])])
-
 AC_DEFUN([OCAML_CC_SUPPORTS_TREE_VECTORIZE], [
   AC_MSG_CHECKING(
  [whether the C compiler supports __attribute__((optimize("tree-vectorize")))])
   saved_CFLAGS="$CFLAGS"
   CFLAGS="-Werror $CFLAGS"
   AC_COMPILE_IFELSE(
-    [AC_LANG_SOURCE([
-       __attribute__((optimize("tree-vectorize"))) void f(void){}
-       int main() { f(); return 0; }
-    ])],
-    [AC_DEFINE([SUPPORTS_TREE_VECTORIZE])
+    [AC_LANG_PROGRAM(
+      [[__attribute__((optimize("tree-vectorize"))) void f(void) {}]],
+      [[f();]])],
+    [AC_DEFINE([SUPPORTS_TREE_VECTORIZE], [1])
     AC_MSG_RESULT([yes])],
     [AC_MSG_RESULT([no])])
   CFLAGS="$saved_CFLAGS"
 ])
 
-AC_DEFUN([OCAML_CC_HAS_DEBUG_PREFIX_MAP], [
-  AC_MSG_CHECKING([whether the C compiler supports -fdebug-prefix-map])
-  saved_CFLAGS="$CFLAGS"
-  CFLAGS="-fdebug-prefix-map=old=new $CFLAGS"
-  AC_COMPILE_IFELSE(
-    [AC_LANG_SOURCE([int main() { return 0; }])],
-    [cc_has_debug_prefix_map=true
-    AC_MSG_RESULT([yes])],
-    [cc_has_debug_prefix_map=false
-    AC_MSG_RESULT([no])])
-  CFLAGS="$saved_CFLAGS"
-])
-
-AC_DEFUN([OCAML_CL_HAS_VOLATILE_METADATA], [
-  AC_MSG_CHECKING([whether the C compiler supports -d2VolatileMetadata-])
-  saved_CFLAGS="$CFLAGS"
-  CFLAGS="-d2VolatileMetadata- $CFLAGS"
-  AC_COMPILE_IFELSE(
-    [AC_LANG_SOURCE([int main() { return 0; }])],
-    [cl_has_volatile_metadata=true
-    AC_MSG_RESULT([yes])],
-    [cl_has_volatile_metadata=false
-    AC_MSG_RESULT([no])])
-  CFLAGS="$saved_CFLAGS"
-])
-
 # Save C compiler related variables
 AC_DEFUN([OCAML_CC_SAVE_VARIABLES], [
   saved_CC="$CC"
@@ -203,7 +155,7 @@ camlPervasives__loop_1128:
     ])],
     [as_has_debug_prefix_map=true
     AC_MSG_RESULT([yes])],
-    [ashas_debug_prefix_map=false
+    [as_has_debug_prefix_map=false
     AC_MSG_RESULT([no])])
 
   OCAML_CC_RESTORE_VARIABLES
@@ -255,7 +207,7 @@ camlPervasives__loop_1128:
 
     AS_IF([$aspp_ok && $as_ok],
       [asm_cfi_supported=true
-      AC_DEFINE([ASM_CFI_SUPPORTED])
+      AC_DEFINE([ASM_CFI_SUPPORTED], [1])
       AC_MSG_RESULT([yes])],
       [AS_IF([test x"$enable_cfi" = "xyes"],
         [AC_MSG_RESULT([requested but not available
@@ -267,20 +219,17 @@ camlPervasives__loop_1128:
 AC_DEFUN([OCAML_MMAP_SUPPORTS_MAP_STACK], [
   AC_MSG_CHECKING([whether mmap supports MAP_STACK])
   AC_RUN_IFELSE(
-    [AC_LANG_SOURCE([[
+    [AC_LANG_PROGRAM([[
 #include <sys/mman.h>
 #include <stdio.h>
 #include <stdlib.h>
-
-int main (int argc, char *argv[]){
+      ]],[[
   void *block;
   block = mmap (NULL, 4096, PROT_READ | PROT_WRITE,
                 MAP_ANONYMOUS | MAP_PRIVATE | MAP_STACK,
                 -1, 0);
   if (block == MAP_FAILED)
      return 1;
-  return 0;
-}
     ]])],
     [has_mmap_map_stack=true
     AC_MSG_RESULT([yes])],
@@ -291,7 +240,7 @@ int main (int argc, char *argv[]){
 AC_DEFUN([OCAML_MMAP_SUPPORTS_HUGE_PAGES], [
   AC_MSG_CHECKING([whether mmap supports huge pages])
   AC_RUN_IFELSE(
-    [AC_LANG_SOURCE([[
+    [AC_LANG_PROGRAM([[
 #include <sys/mman.h>
 #include <stdio.h>
 #include <stdlib.h>
@@ -304,8 +253,7 @@ AC_DEFUN([OCAML_MMAP_SUPPORTS_HUGE_PAGES], [
    pages can be activated and deactivated easily while the system
    is running.
 */
-
-int main (int argc, char *argv[]){
+      ]],[[
   void *block;
   char *p;
   int i, res;
@@ -326,10 +274,8 @@ int main (int argc, char *argv[]){
   for (i = 0; i < huge_page_size; i += 4096){
     p[i] = (char) i;
   }
-  return 0;
-}
     ]])],
-    [AC_DEFINE([HAS_HUGE_PAGES])
+    [AC_DEFINE([HAS_HUGE_PAGES], [1])
     AC_DEFINE_UNQUOTED([HUGE_PAGE_SIZE], [(4 * 1024 * 1024)])
     AC_MSG_RESULT([yes])],
     [AC_MSG_RESULT([no])],
@@ -342,7 +288,7 @@ AC_DEFUN([OCAML_CHECK_LIBUNWIND], [
   CPPFLAGS="$CPPFLAGS $libunwind_cppflags"
   LDFLAGS="$LDFLAGS $libunwind_ldflags"
   AC_CHECK_HEADER([libunwind.h],
-    [AC_DEFINE([HAS_LIBUNWIND])
+    [AC_DEFINE([HAS_LIBUNWIND], [1])
     libunwind_available=true],
     [libunwind_available=false])
   LDFLAGS="$SAVED_LDFLAGS"
@@ -369,7 +315,7 @@ AC_DEFUN([OCAML_TEST_FLEXLINK], [
     CPPFLAGS="$3 $CPPFLAGS"
     CFLAGS=""
     AC_LINK_IFELSE(
-      [AC_LANG_SOURCE([int main() { return 0; }])],
+      [AC_LANG_PROGRAM],
       [AC_MSG_RESULT([yes])],
       [AC_MSG_RESULT([no])
       AC_MSG_ERROR([$1 does not work])])],
@@ -399,8 +345,7 @@ AC_DEFUN([OCAML_TEST_FLEXLINK_WHERE], [
   flexlink_where="$($1 -where | tr -d '\r')"
   CPPFLAGS="$CPPFLAGS -I \"$flexlink_where\""
   cat > conftest.c <<"EOF"
-#include <flexdll.h>
-int main (void) {return 0;}
+  AC_LANG_PROGRAM([[#include <flexdll.h>]])
 EOF
   cat > conftest.Makefile <<EOF
 all:
@@ -414,12 +359,22 @@ EOF
   OCAML_CC_RESTORE_VARIABLES
 ])
 
+AC_DEFUN([OCAML_TEST_WINPTHREADS_PTHREAD_H], [
+  OCAML_CC_SAVE_VARIABLES
+
+  AS_IF([test -n "$1"],[CPPFLAGS="-I $1 $CPPFLAGS"])
+  AC_CHECK_HEADER([pthread.h],[],
+    [AC_MSG_ERROR([cannot find or use pthread.h from winpthreads])])
+
+  OCAML_CC_RESTORE_VARIABLES
+])
+
 AC_DEFUN([OCAML_HOST_IS_EXECUTABLE], [
   AC_MSG_CHECKING([whether host executables can be run in the build])
   old_cross_compiling="$cross_compiling"
   cross_compiling='no'
   AC_RUN_IFELSE(
-    [AC_LANG_SOURCE([[int main (void) {return 0;}]])],
+    [AC_LANG_PROGRAM],
     [AC_MSG_RESULT([yes])
     host_runnable=true],
     [AC_MSG_RESULT([no])
@@ -442,15 +397,12 @@ AC_DEFUN([OCAML_RUN_IFELSE], [
 AC_DEFUN([OCAML_C99_CHECK_ROUND], [
   AC_MSG_CHECKING([whether round works])
   OCAML_RUN_IFELSE(
-    [AC_LANG_SOURCE([[
-#include <math.h>
-int main (void) {
+    [AC_LANG_PROGRAM([[#include <math.h>]],[[
   static volatile double d = 0.49999999999999994449;
-  return (fpclassify(round(d)) != FP_ZERO);
-}
+  if (fpclassify(round(d)) != FP_ZERO) return 1;
     ]])],
     [AC_MSG_RESULT([yes])
-    AC_DEFINE([HAS_WORKING_ROUND])],
+    AC_DEFINE([HAS_WORKING_ROUND], [1])],
     [AC_MSG_RESULT([no])
     AS_CASE([$enable_imprecise_c99_float_ops,$target],
       [no,*], [hard_error=true],
@@ -466,17 +418,15 @@ int main (void) {
     [AS_CASE([$target],
       [x86_64-w64-mingw32*],[AC_MSG_RESULT([cross-compiling; assume not])],
       [AC_MSG_RESULT([cross-compiling; assume yes])
-      AC_DEFINE([HAS_WORKING_ROUND])])])
+      AC_DEFINE([HAS_WORKING_ROUND], [1])])])
 ])
 
 AC_DEFUN([OCAML_C99_CHECK_FMA], [
   AC_MSG_CHECKING([whether fma works])
   OCAML_RUN_IFELSE(
-    [AC_LANG_SOURCE([[
-#include <math.h>
-int main (void) {
+    [AC_LANG_PROGRAM([[#include <math.h>]],[[
   /* Tests 264-266 from testsuite/tests/fma/fma.ml. These tests trigger the
-     broken implementations of Cygwin64, mingw-w64 (x86_64) and VS2013-2017.
+     broken implementations of Cygwin64 and mingw-w64 (x86_64).
      The static volatile variables aim to thwart GCC's constant folding. */
   static volatile double x, y, z;
   volatile double t264, t265, t266;
@@ -492,27 +442,23 @@ int main (void) {
   y = 0x4p-540;
   z = 0x4p-1076;
   t266 = fma(x, y, z);
-  return (!(t264 == 0x1.0989687cp-1044 ||
-            t264 == 0x0.000004277ca1fp-1022 || /* Acceptable emulated values */
-            t264 == 0x0.00000428p-1022)
-       || !(t265 == 0x1.0988p-1060 ||
-            t265 == 0x0.0000000004278p-1022 ||  /* Acceptable emulated values */
-            t265 == 0x0.000000000428p-1022)
-       || !(t266 == 0x8p-1076));
-}
+  if (!(t264 == 0x1.0989687cp-1044 ||
+        t264 == 0x0.000004277ca1fp-1022 || /* Acceptable emulated values */
+        t264 == 0x0.00000428p-1022)
+   || !(t265 == 0x1.0988p-1060 ||
+        t265 == 0x0.0000000004278p-1022 ||  /* Acceptable emulated values */
+        t265 == 0x0.000000000428p-1022)
+   || !(t266 == 0x8p-1076))
+    return 1;
     ]])],
     [AC_MSG_RESULT([yes])
-    AC_DEFINE([HAS_WORKING_FMA])],
+    AC_DEFINE([HAS_WORKING_FMA], [1])],
     [AC_MSG_RESULT([no])
     AS_CASE([$enable_imprecise_c99_float_ops,$target],
       [no,*], [hard_error=true],
       [yes,*], [hard_error=false],
       [*,x86_64-w64-mingw32*|*,x86_64-*-cygwin*], [hard_error=false],
-      [AS_CASE([$ocaml_cc_vendor],
-        [msvc-*], [AS_IF([test "${ocaml_cc_vendor#msvc-}" -lt 1920 ],
-          [hard_error=false],
-          [hard_error=true])],
-        [hard_error=true])])
+      [hard_error=true])
     AS_IF([test x"$hard_error" = "xtrue"],
       [AC_MSG_ERROR(m4_normalize([
         fma does not work, enable emulation with
@@ -523,7 +469,7 @@ int main (void) {
       [x86_64-w64-mingw32*|x86_64-*-cygwin*],
         [AC_MSG_RESULT([cross-compiling; assume not])],
       [AC_MSG_RESULT([cross-compiling; assume yes])
-      AC_DEFINE([HAS_WORKING_FMA])])])
+      AC_DEFINE([HAS_WORKING_FMA], [1])])])
 ])
 
 # Computes a suitable id to insert in quoted strings to ensure that all OCaml
@@ -551,25 +497,49 @@ AC_DEFUN([OCAML_QUOTED_STRING_ID], [
 ])
 
 AC_DEFUN([OCAML_CC_SUPPORTS_ATOMIC], [
-  AC_MSG_CHECKING([whether the C compiler supports _Atomic types])
-  saved_LIBS="$LIBS"
-  LIBS="$LIBS $1"
-  AC_LINK_IFELSE([AC_LANG_SOURCE([[
-    #include <stdint.h>
-    #include <stdatomic.h>
-    int main(void)
-    {
-      _Atomic int64_t n;
-      int m;
-      int * _Atomic p = &m;
-      atomic_store_explicit(&n, 123, memory_order_release);
-      * atomic_exchange(&p, 0) = 45;
-      return atomic_load_explicit(&n, memory_order_acquire);
-    }
-    ]])],
+  OCAML_CC_SAVE_VARIABLES
+
+  opts=""
+  AS_IF([test -n "$1"],[CFLAGS="$CFLAGS $1"; opts="$1"])
+  AS_IF([test -n "$2"],[LIBS="$LIBS $2"; opts="${opts:+$opts }$2"])
+  AC_MSG_CHECKING(m4_normalize([if $CC supports _Atomic types with
+    ${opts:-no additional options}]))
+
+  AC_LINK_IFELSE([AC_LANG_PROGRAM([[
+#include <stdint.h>
+#include <stdatomic.h>
+    ]],[[
+  _Atomic int64_t n;
+  int m;
+  int * _Atomic p = &m;
+  atomic_store_explicit(&n, 123, memory_order_release);
+  * atomic_exchange(&p, 0) = 45;
+  if (atomic_load_explicit(&n, memory_order_acquire))
+    return 1;
+  ]])],
   [cc_supports_atomic=true
    AC_MSG_RESULT([yes])],
   [cc_supports_atomic=false
    AC_MSG_RESULT([no])])
-  LIBS="$saved_LIBS"
+
+  OCAML_CC_RESTORE_VARIABLES
+])
+
+AC_DEFUN([OCAML_CC_SUPPORTS_LABELS_AS_VALUES], [
+  AC_CACHE_CHECK([whether $CC supports the labels as values extension],
+    [ocaml_cv_prog_cc_labels_as_values],
+    [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[
+  void *ptr;
+  ptr = &&foo;
+  goto *ptr;
+  return 1;
+  foo:
+     ]])],
+       [ocaml_cv_prog_cc_labels_as_values=yes],
+       [ocaml_cv_prog_cc_labels_as_values=no])
+  ])
+  if test "x$ocaml_cv_prog_cc_labels_as_values" = xyes; then
+    AC_DEFINE([HAVE_LABELS_AS_VALUES], [1],
+      [Define if the C compiler supports the labels as values extension.])
+  fi
 ])

diff --git a/asmcomp/amd64/arch.ml b/asmcomp/amd64/arch.ml
index 335edfdb5f2fc4233be328b33ef219e32568b05a..ecb5134949a2731b87854703d8d8b2f24949ba67 100644 (file)
--- a/asmcomp/amd64/arch.ml
+++ b/asmcomp/amd64/arch.ml
@@ -77,13 +77,6 @@ let offset_addressing addr delta =
   | Iscaled(scale, n) -> Iscaled(scale, n + delta)
   | Iindexed2scaled(scale, n) -> Iindexed2scaled(scale, n + delta)
 
-let num_args_addressing = function
-    Ibased _ -> 0
-  | Iindexed _ -> 1
-  | Iindexed2 _ -> 2
-  | Iscaled _ -> 1
-  | Iindexed2scaled _ -> 2
-
 (* Printing operations and addressing modes *)
 
 let print_addressing printreg addr ppf arg =

diff --git a/asmcomp/amd64/arch.mli b/asmcomp/amd64/arch.mli
index ef988a0fe7f5119c87adf44bc85d5c678261a027..dfcd43286893dbc65f64e3b76446cd0227a59c53 100644 (file)
--- a/asmcomp/amd64/arch.mli
+++ b/asmcomp/amd64/arch.mli
@@ -61,8 +61,6 @@ val identity_addressing : addressing_mode
 
 val offset_addressing : addressing_mode -> int -> addressing_mode
 
-val num_args_addressing : addressing_mode -> int
-
 val print_addressing :
   (Format.formatter -> 'a -> unit) -> addressing_mode ->
   Format.formatter -> 'a array -> unit

diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 619ce9c3c5958bdbe210c27feacdd18966ec8b10..23f5b4525c28e3b82f9ed6b138c98e44621b793c 100644 (file)
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -989,6 +989,10 @@ let begin_assembly() =
     D.extrn "caml_alloc3" NEAR;
     D.extrn "caml_ml_array_bound_error" NEAR;
     D.extrn "caml_raise_exn" NEAR;
+    D.extrn "caml_call_realloc_stack" NEAR;
+    D.extrn "caml_reraise_exn" NEAR;
+    D.extrn "caml_c_call_stack_args" NEAR;
+    D.extrn "caml_assert_stack_invariants" NEAR;
   end;
 
 
@@ -1079,7 +1083,7 @@ let end_assembly() =
     D.size frametable (ConstSub (ConstThis, ConstLabel frametable))
   end;
 
-  if system = S_linux then
+  if system = S_linux || system = S_freebsd then
     (* Mark stack as non-executable, PR#4564 *)
     D.section [".note.GNU-stack"] (Some "") [ "%progbits" ];
 

diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml
index 97e55e80ff1e15b0fd09eb5d97b36375e3dc2313..7470d88caf53d8d888a9c9946dc4940b6a1b125c 100644 (file)
--- a/asmcomp/amd64/proc.ml
+++ b/asmcomp/amd64/proc.ml
@@ -149,10 +149,6 @@ let destroyed_by_plt_stub_set = Reg.set_of_array destroyed_by_plt_stub
 let stack_slot slot ty =
   Reg.at_location ty (Stack slot)
 
-(* Instruction selection *)
-
-let word_addressed = false
-
 (* Calling conventions *)
 
 let size_domainstate_args = 64 * size_int

diff --git a/asmcomp/arm64/arch.ml b/asmcomp/arm64/arch.ml
index a46d59d91a77c25707e7d34d35984c2e69e4c14a..8ffc903093d18a351286133dcca10f86d4c9ad58 100644 (file)
--- a/asmcomp/arm64/arch.ml
+++ b/asmcomp/arm64/arch.ml
@@ -43,13 +43,13 @@ type cmm_label = int
   (* Do not introduce a dependency to Cmm *)
 
 type specific_operation =
-  | Ifar_poll of { return_label: cmm_label option }
-  | Ifar_alloc of { bytes : int; dbginfo : Debuginfo.alloc_dbginfo }
-  | Ifar_intop_checkbound
-  | Ifar_intop_imm_checkbound of { bound : int; }
+  | Ipoll_far of { return_label: cmm_label option }
+  | Ialloc_far of { bytes : int; dbginfo : Debuginfo.alloc_dbginfo }
+  | Icheckbound_far
+  | Icheckbound_imm_far of { bound : int; }
   | Ishiftarith of arith_operation * int
   | Ishiftcheckbound of { shift : int; }
-  | Ifar_shiftcheckbound of { shift : int; }
+  | Ishiftcheckbound_far of { shift : int; }
   | Imuladd       (* multiply and add *)
   | Imulsub       (* multiply and subtract *)
   | Inegmulf      (* floating-point negate and multiply *)
@@ -89,10 +89,6 @@ let offset_addressing addr delta =
   | Iindexed n -> Iindexed(n + delta)
   | Ibased(s, n) -> Ibased(s, n + delta)
 
-let num_args_addressing = function
-  | Iindexed _ -> 1
-  | Ibased _ -> 0
-
 (* Printing operations and addressing modes *)
 
 let print_addressing printreg addr ppf arg =
@@ -107,13 +103,13 @@ let print_addressing printreg addr ppf arg =
 
 let print_specific_operation printreg op ppf arg =
   match op with
-  | Ifar_poll _ ->
+  | Ipoll_far _ ->
     fprintf ppf "(far) poll"
-  | Ifar_alloc { bytes; } ->
+  | Ialloc_far { bytes; } ->
     fprintf ppf "(far) alloc %i" bytes
-  | Ifar_intop_checkbound ->
+  | Icheckbound_far ->
     fprintf ppf "%a (far) check > %a" printreg arg.(0) printreg arg.(1)
-  | Ifar_intop_imm_checkbound { bound; } ->
+  | Icheckbound_imm_far { bound; } ->
     fprintf ppf "%a (far) check > %i" printreg arg.(0) bound
   | Ishiftarith(op, shift) ->
       let op_name = function
@@ -128,7 +124,7 @@ let print_specific_operation printreg op ppf arg =
   | Ishiftcheckbound { shift; } ->
       fprintf ppf "check %a >> %i > %a" printreg arg.(0) shift
         printreg arg.(1)
-  | Ifar_shiftcheckbound { shift; } ->
+  | Ishiftcheckbound_far { shift; } ->
       fprintf ppf
         "(far) check %a >> %i > %a" printreg arg.(0) shift printreg arg.(1)
   | Imuladd ->
@@ -249,19 +245,19 @@ let is_logical_immediate x =
 (* Specific operations that are pure *)
 
 let operation_is_pure = function
-  | Ifar_alloc _
-  | Ifar_intop_checkbound
-  | Ifar_intop_imm_checkbound _
+  | Ialloc_far _
+  | Icheckbound_far
+  | Icheckbound_imm_far _
   | Ishiftcheckbound _
-  | Ifar_shiftcheckbound _ -> false
+  | Ishiftcheckbound_far _ -> false
   | _ -> true
 
 (* Specific operations that can raise *)
 
 let operation_can_raise = function
-  | Ifar_alloc _
-  | Ifar_intop_checkbound
-  | Ifar_intop_imm_checkbound _
+  | Ialloc_far _
+  | Icheckbound_far
+  | Icheckbound_imm_far _
   | Ishiftcheckbound _
-  | Ifar_shiftcheckbound _ -> true
+  | Ishiftcheckbound_far _ -> true
   | _ -> false

diff --git a/asmcomp/arm64/arch.mli b/asmcomp/arm64/arch.mli
index a84b542754f485a0d783cf467e2cdd4f8d062245..b1829a965e6803f76bf297aeecb0abaa3f7f3c01 100644 (file)
--- a/asmcomp/arm64/arch.mli
+++ b/asmcomp/arm64/arch.mli
@@ -41,13 +41,13 @@ type cmm_label = int
   (* Do not introduce a dependency to Cmm *)
 
 type specific_operation =
-  | Ifar_poll of { return_label: cmm_label option }
-  | Ifar_alloc of { bytes : int; dbginfo : Debuginfo.alloc_dbginfo }
-  | Ifar_intop_checkbound
-  | Ifar_intop_imm_checkbound of { bound : int; }
+  | Ipoll_far of { return_label: cmm_label option }
+  | Ialloc_far of { bytes : int; dbginfo : Debuginfo.alloc_dbginfo }
+  | Icheckbound_far
+  | Icheckbound_imm_far of { bound : int; }
   | Ishiftarith of arith_operation * int
   | Ishiftcheckbound of { shift : int; }
-  | Ifar_shiftcheckbound of { shift : int; }
+  | Ishiftcheckbound_far of { shift : int; }
   | Imuladd       (* multiply and add *)
   | Imulsub       (* multiply and subtract *)
   | Inegmulf      (* floating-point negate and multiply *)
@@ -86,8 +86,6 @@ val identity_addressing : addressing_mode
 
 val offset_addressing : addressing_mode -> int -> addressing_mode
 
-val num_args_addressing : addressing_mode -> int
-
 (* Printing operations and addressing modes *)
 
 val print_addressing :

diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp
index 1816f8c345370e83a562c04c1004decea4403a8f..f59a5aed7897ffd4e9cdc6f57398a411678bae5e 100644 (file)
--- a/asmcomp/arm64/emit.mlp
+++ b/asmcomp/arm64/emit.mlp
@@ -327,7 +327,9 @@ let float_literal env fl =
 let emit_literals env =
   if env.float_literals <> [] then begin
     if macosx then
-      `        .section        __TEXT,__literal8,8byte_literals\n`;
+      `        .section        __TEXT,__literal8,8byte_literals\n`
+    else
+      `        .section        .rodata\n`;
     `  .align  3\n`;
     List.iter
       (fun { fl; lbl } ->
@@ -373,11 +375,11 @@ let num_call_gc_and_check_bound_points env =
       loop instr.next (call_gc, check_bound)
     (* The following four should never be seen, since this function is run
        before branch relaxation. *)
-    | Lop (Ispecific (Ifar_alloc _))
-    | Lop (Ispecific (Ifar_poll _))
-    | Lop (Ispecific Ifar_intop_checkbound)
-    | Lop (Ispecific (Ifar_intop_imm_checkbound _))
-    | Lop (Ispecific (Ifar_shiftcheckbound _)) -> assert false
+    | Lop (Ispecific (Ialloc_far _))
+    | Lop (Ispecific (Ipoll_far _))
+    | Lop (Ispecific Icheckbound_far)
+    | Lop (Ispecific (Icheckbound_imm_far _))
+    | Lop (Ispecific (Ishiftcheckbound_far _)) -> assert false
     | _ -> loop instr.next totals
   in
   loop env.f.fun_body (0, 0)
@@ -464,7 +466,7 @@ module BR = Branch_relaxation.Make (struct
     | Lop (Iextcall {alloc; stack_ofs} ) ->
       if stack_ofs > 0 then 5
       else if alloc then 3
-      else 5
+      else 7
     | Lop (Istackoffset _) -> 2
     | Lop (Iload  { memory_chunk; addressing_mode; is_atomic }) ->
       let based = match addressing_mode with Iindexed _ -> 0 | Ibased _ -> 1
@@ -480,11 +482,11 @@ module BR = Branch_relaxation.Make (struct
       and single = match memory_chunk with Single -> 2 | _ -> 1 in
       based + barrier + single
     | Lop (Ialloc _) when f.fun_fast -> 5
-    | Lop (Ispecific (Ifar_alloc _)) when f.fun_fast -> 6
+    | Lop (Ispecific (Ialloc_far _)) when f.fun_fast -> 6
     | Lop (Ipoll _) -> 3
-    | Lop (Ispecific (Ifar_poll _)) -> 4
+    | Lop (Ispecific (Ipoll_far _)) -> 4
     | Lop (Ialloc { bytes = num_bytes; _ })
-    | Lop (Ispecific (Ifar_alloc { bytes = num_bytes; _ })) ->
+    | Lop (Ispecific (Ialloc_far { bytes = num_bytes; _ })) ->
       begin match num_bytes with
       | 16 | 24 | 32 -> 1
       | _ -> 1 + num_instructions_for_intconst (Nativeint.of_int num_bytes)
@@ -493,11 +495,11 @@ module BR = Branch_relaxation.Make (struct
     | Lop (Icompf _) -> 2
     | Lop (Iintop_imm (Icomp _, _)) -> 2
     | Lop (Iintop (Icheckbound)) -> 2
-    | Lop (Ispecific (Ifar_intop_checkbound)) -> 3
+    | Lop (Ispecific (Icheckbound_far)) -> 3
     | Lop (Iintop_imm (Icheckbound, _)) -> 2
-    | Lop (Ispecific (Ifar_intop_imm_checkbound _)) -> 3
+    | Lop (Ispecific (Icheckbound_imm_far _)) -> 3
     | Lop (Ispecific (Ishiftcheckbound _)) -> 2
-    | Lop (Ispecific (Ifar_shiftcheckbound _)) -> 3
+    | Lop (Ispecific (Ishiftcheckbound_far _)) -> 3
     | Lop (Iintop Imod) -> 2
     | Lop (Iintop Imulh) -> 1
     | Lop (Iintop _) -> 1
@@ -535,30 +537,30 @@ module BR = Branch_relaxation.Make (struct
     | Lswitch jumptbl -> 3 + Array.length jumptbl
     | Lentertrap -> 0
     | Ladjust_trap_depth _ -> 0
-    | Lpushtrap _ -> 4
+    | Lpushtrap _ -> 3
     | Lpoptrap -> 1
     | Lraise k ->
       begin match k with
       | Lambda.Raise_regular -> 1
       | Lambda.Raise_reraise -> 1
-      | Lambda.Raise_notrace -> 4
+      | Lambda.Raise_notrace -> 3
       end
 
   let relax_poll ~return_label =
-    Lop (Ispecific (Ifar_poll { return_label }))
+    Lop (Ispecific (Ipoll_far { return_label }))
 
   let relax_allocation ~num_bytes ~dbginfo =
-    Lop (Ispecific (Ifar_alloc { bytes = num_bytes; dbginfo }))
+    Lop (Ispecific (Ialloc_far { bytes = num_bytes; dbginfo }))
 
   let relax_intop_checkbound () =
-    Lop (Ispecific (Ifar_intop_checkbound))
+    Lop (Ispecific (Icheckbound_far))
 
   let relax_intop_imm_checkbound ~bound =
-    Lop (Ispecific (Ifar_intop_imm_checkbound { bound; }))
+    Lop (Ispecific (Icheckbound_imm_far { bound; }))
 
   let relax_specific_op = function
     | Ishiftcheckbound { shift; } ->
-      Lop (Ispecific (Ifar_shiftcheckbound { shift; }))
+      Lop (Ispecific (Ishiftcheckbound_far { shift; }))
     | _ -> assert false
 end)
 
@@ -638,14 +640,8 @@ let assembly_code_for_poll env i ~far ~return_label =
       gc_return_lbl = lbl_after_poll;
       gc_frame_lbl = lbl_frame; } :: env.call_gc_sites
 
-(* Output .text section directive, or named .text.caml.<name> if enabled. *)
-
 let emit_named_text_section func_name =
-  if !Clflags.function_sections then begin
-    `  .section .text.caml.{emit_symbol func_name},{emit_string_literal "ax"},%progbits\n`
-  end
-  else
-    `  .text\n`
+  Emitaux.emit_named_text_section func_name '%'
 
 (* Emit code to load an emitted literal *)
 
@@ -835,11 +831,11 @@ let emit_instr env i =
         end
     | Lop(Ialloc { bytes = n; dbginfo }) ->
         assembly_code_for_allocation env i ~n ~far:false ~dbginfo
-    | Lop(Ispecific (Ifar_alloc { bytes = n; dbginfo })) ->
+    | Lop(Ispecific (Ialloc_far { bytes = n; dbginfo })) ->
         assembly_code_for_allocation env i ~n ~far:true ~dbginfo
     | Lop(Ipoll { return_label }) ->
         assembly_code_for_poll env i ~far:false ~return_label
-    | Lop(Ispecific (Ifar_poll { return_label })) ->
+    | Lop(Ispecific (Ipoll_far { return_label })) ->
         assembly_code_for_poll env i ~far:true ~return_label
     | Lop(Iintop_imm(Iadd, n)) ->
         emit_addimm i.res.(0) i.arg.(0) n
@@ -859,7 +855,7 @@ let emit_instr env i =
         let lbl = bound_error_label env i.dbg in
         `      cmp     {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
         `      b.ls    {emit_label lbl}\n`
-    | Lop(Ispecific Ifar_intop_checkbound) ->
+    | Lop(Ispecific Icheckbound_far) ->
         let lbl = bound_error_label env i.dbg in
         let lbl2 = new_label () in
         `      cmp     {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
@@ -870,8 +866,7 @@ let emit_instr env i =
         let lbl = bound_error_label env i.dbg in
         emit_cmpimm i.arg.(0) n;
         `      b.ls    {emit_label lbl}\n`
-    | Lop(Ispecific(
-          Ifar_intop_imm_checkbound { bound; })) ->
+    | Lop(Ispecific(Icheckbound_imm_far { bound; })) ->
         let lbl = bound_error_label env i.dbg in
         let lbl2 = new_label () in
         `      cmp     {emit_reg i.arg.(0)}, #{emit_int bound}\n`;
@@ -882,7 +877,7 @@ let emit_instr env i =
         let lbl = bound_error_label env i.dbg in
         `      cmp     {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
         `      b.cs    {emit_label lbl}\n`
-    | Lop(Ispecific(Ifar_shiftcheckbound { shift; })) ->
+    | Lop(Ispecific(Ishiftcheckbound_far { shift; })) ->
         let lbl = bound_error_label env i.dbg in
         let lbl2 = new_label () in
         `      cmp     {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
@@ -1040,8 +1035,7 @@ let emit_instr env i =
     | Lpushtrap { lbl_handler; } ->
         `      adr     {emit_reg reg_tmp1}, {emit_label lbl_handler}\n`;
         env.stack_offset <- env.stack_offset + 16;
-        `      str     {emit_reg reg_trap_ptr}, [sp, -16]!\n`;
-        `      str     {emit_reg reg_tmp1}, [sp, #8]\n`;
+        `      stp     {emit_reg reg_trap_ptr}, {emit_reg reg_tmp1}, [sp, -16]!\n`;
         cfi_adjust_cfa_offset 16;
         `      mov     {emit_reg reg_trap_ptr}, sp\n`
     | Lpoptrap ->
@@ -1058,8 +1052,7 @@ let emit_instr env i =
           `{record_frame env Reg.Set.empty (Dbg_raise i.dbg)}\n`
         | Lambda.Raise_notrace ->
           `    mov     sp, {emit_reg reg_trap_ptr}\n`;
-          `    ldr     {emit_reg reg_tmp1}, [sp, #8]\n`;
-          `    ldr     {emit_reg reg_trap_ptr}, [sp], 16\n`;
+          `    ldp     {emit_reg reg_trap_ptr}, {emit_reg reg_tmp1}, [sp], 16\n`;
           `    br      {emit_reg reg_tmp1}\n`
         end
 

diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml
index 40fb6fb0637bb422f0d95b72a2f5988a6c0d5a1e..78845f33857c21815b5424e0e4fa40bfe0f0947c 100644 (file)
--- a/asmcomp/arm64/proc.ml
+++ b/asmcomp/arm64/proc.ml
@@ -24,10 +24,6 @@ open Reg
 open Arch
 open Mach
 
-(* Instruction selection *)
-
-let word_addressed = false
-
 (* Registers available for register allocation *)
 
 (* Integer register map:

diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
index ffdac2ac71c326c17060a40d443fb5141865b5dc..64fbe83a54941f0b62a58dd8e3cfa0ebce2942dd 100644 (file)
--- a/asmcomp/asmgen.ml
+++ b/asmcomp/asmgen.ml
@@ -310,15 +310,16 @@ let compile_implementation_linear target =
 
 (* Error report *)
 module Style = Misc.Style
+let fprintf, dprintf = Format_doc.fprintf, Format_doc.dprintf
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Assembler_error file ->
       fprintf ppf "Assembler error, input left in file %a"
-        Location.print_filename file
+        Location.Doc.quoted_filename file
   | Mismatched_for_pack saved ->
     let msg = function
-       | None -> Format.dprintf "without %a" Style.inline_code "-for-pack"
-       | Some s -> Format.dprintf "with %a" Style.inline_code ("-for-pack " ^ s)
+       | None -> dprintf "without %a" Style.inline_code "-for-pack"
+       | Some s -> dprintf "with %a" Style.inline_code ("-for-pack " ^ s)
      in
      fprintf ppf
        "This input file cannot be compiled %t: it was generated %t."
@@ -326,11 +327,13 @@ let report_error ppf = function
   | Asm_generation(fn, err) ->
      fprintf ppf
        "Error producing assembly code for function %a: %a"
-       Style.inline_code fn Emitaux.report_error err
+       Style.inline_code fn Emitaux.report_error_doc err
 
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli
index 12440893fe0fe97fa2d15c48e1b28e79f31ce073..b43d38559d6fe4aca52f138ee5bdf556a3928ff1 100644 (file)
--- a/asmcomp/asmgen.mli
+++ b/asmcomp/asmgen.mli
@@ -45,7 +45,8 @@ type error =
   | Asm_generation of string * Emitaux.error
 
 exception Error of error
-val report_error: Format.formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
 
 val compile_unit
    : output_prefix:string

diff --git a/asmcomp/asmlibrarian.ml b/asmcomp/asmlibrarian.ml
index 72a0303593c39bd733029bcf7e164733ff123ac0..823b07db3a8d780572556420158c7b1fe1d296fc 100644 (file)
--- a/asmcomp/asmlibrarian.ml
+++ b/asmcomp/asmlibrarian.ml
@@ -22,6 +22,7 @@ open Cmx_format
 type error =
     File_not_found of string
   | Archiver_error of string
+  | Link_error of Linkdeps.error
 
 exception Error of error
 
@@ -44,7 +45,7 @@ let read_info name =
      The linker, which is the only one that reads .cmxa files, does not
      need the approximation. *)
   info.ui_export_info <- default_ui_export_info;
-  (Filename.chop_suffix filename ".cmx" ^ ext_obj, (info, crc))
+  filename, (info, crc)
 
 let create_archive file_list lib_name =
   let archive_name = Filename.remove_extension lib_name ^ ext_lib in
@@ -54,33 +55,50 @@ let create_archive file_list lib_name =
     ~exceptionally:(fun () -> remove_file lib_name; remove_file archive_name)
     (fun () ->
        output_string outchan cmxa_magic_number;
-       let (objfile_list, descr_list) =
-         List.split (List.map read_info file_list) in
-       List.iter2
-         (fun file_name (unit, crc) ->
+       let units = List.map read_info file_list in
+       let objfiles = List.map (fun (filename,_) ->
+           Filename.chop_suffix filename ".cmx" ^ ext_obj)
+           units in
+       List.iter
+         (fun (file_name, (unit, crc)) ->
             Asmlink.check_consistency file_name unit crc)
-         file_list descr_list;
+         units;
+       let ldeps = Linkdeps.create ~complete:false in
+       List.iter
+         (fun (filename, (unit, _crc)) ->
+            Linkdeps.add ldeps
+              ~filename ~compunit:unit.ui_name
+              ~provides:[unit.ui_name]
+              ~requires:(List.map fst unit.ui_imports_cmx))
+         (List.rev units);
+       (match Linkdeps.check ldeps with
+        | None -> ()
+        | Some e -> raise (Error (Link_error e)));
        let infos =
-         { lib_units = descr_list;
+         { lib_units = List.map snd units;
            lib_ccobjs = !Clflags.ccobjs;
            lib_ccopts = !Clflags.all_ccopts } in
        output_value outchan infos;
-       if Ccomp.create_archive archive_name objfile_list <> 0
+       if Ccomp.create_archive archive_name objfiles <> 0
        then raise(Error(Archiver_error archive_name));
     )
 
 module Style = Misc.Style
-open Format
+open Format_doc
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | File_not_found name ->
       fprintf ppf "Cannot find file %a" Style.inline_code name
   | Archiver_error name ->
       fprintf ppf "Error while creating the library %a" Style.inline_code name
+  | Link_error e ->
+      Linkdeps.report_error_doc ~print_filename:Location.Doc.filename ppf e
 
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/asmcomp/asmlibrarian.mli b/asmcomp/asmlibrarian.mli
index 4d66827c0fb59ec2a9482d680c33cb394b7d3749..86d5dfa8496154340e0b229d74f1efa6a99a0397 100644 (file)
--- a/asmcomp/asmlibrarian.mli
+++ b/asmcomp/asmlibrarian.mli
@@ -15,14 +15,14 @@
 
 (* Build libraries of .cmx files *)
 
-open Format
-
 val create_archive: string list -> string -> unit
 
 type error =
     File_not_found of string
   | Archiver_error of string
+  | Link_error of Linkdeps.error
 
 exception Error of error
 
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml
index 2e10f82387caf36614e05450e1b06191f7cf3b47..e8179a729f7c22c30968fe62029b0875778e0e9d 100644 (file)
--- a/asmcomp/asmlink.ml
+++ b/asmcomp/asmlink.ml
@@ -25,13 +25,12 @@ module String = Misc.Stdlib.String
 type error =
   | File_not_found of filepath
   | Not_an_object_file of filepath
-  | Missing_implementations of (modname * string list) list
   | Inconsistent_interface of modname * filepath * filepath
   | Inconsistent_implementation of modname * filepath * filepath
   | Assembler_error of filepath
   | Linking_error of int
-  | Multiple_definition of modname * filepath * filepath
   | Missing_cmx of filepath * modname
+  | Link_error of Linkdeps.error
 
 exception Error of error
 
@@ -44,15 +43,9 @@ let interfaces = ref ([] : string list)
 module Cmx_consistbl = Consistbl.Make (Misc.Stdlib.String)
 let crc_implementations = Cmx_consistbl.create ()
 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
-    let source = List.assoc unit.ui_name !implementations_defined in
-    raise (Error(Multiple_definition(unit.ui_name, file_name, source)))
-  with Not_found -> ()
-  end;
   begin try
     List.iter
       (fun (name, crco) ->
@@ -88,8 +81,6 @@ let check_consistency file_name unit crc =
   end;
   implementations := unit.ui_name :: !implementations;
   Cmx_consistbl.check crc_implementations unit.ui_name crc file_name;
-  implementations_defined :=
-    (unit.ui_name, file_name) :: !implementations_defined;
   if unit.ui_symbol <> unit.ui_name then
     cmx_required := unit.ui_name :: !cmx_required
 
@@ -123,27 +114,6 @@ let runtime_lib () =
 
 (* First pass: determine which units are needed *)
 
-let missing_globals = (Hashtbl.create 17 : (string, string list ref) Hashtbl.t)
-
-let is_required name =
-  try ignore (Hashtbl.find missing_globals name); true
-  with Not_found -> false
-
-let add_required by (name, _crc) =
-  try
-    let rq = Hashtbl.find missing_globals name in
-    rq := by :: !rq
-  with Not_found ->
-    Hashtbl.add missing_globals name (ref [by])
-
-let remove_required name =
-  Hashtbl.remove missing_globals name
-
-let extract_missing_globals () =
-  let mg = ref [] in
-  Hashtbl.iter (fun md rq -> mg := (md, !rq) :: !mg) missing_globals;
-  !mg
-
 type file =
   | Unit of string * unit_infos * Digest.t
   | Library of string * library_infos
@@ -181,11 +151,13 @@ let read_file obj_name =
   end
   else raise(Error(Not_an_object_file file_name))
 
-let scan_file file tolink = match file with
+let scan_file ldeps file tolink = match file with
   | Unit (file_name,info,crc) ->
       (* This is a .cmx file. It must be linked in any case. *)
-      remove_required info.ui_name;
-      List.iter (add_required file_name) info.ui_imports_cmx;
+      Linkdeps.add ldeps
+        ~filename:file_name ~compunit:info.ui_name
+        ~provides:[info.ui_name]
+        ~requires:(List.map fst info.ui_imports_cmx);
       (info, file_name, crc) :: tolink
   | Library (file_name,infos) ->
       (* This is an archive file. Each unit contained in it will be linked
@@ -195,12 +167,12 @@ let scan_file file tolink = match file with
         (fun (info, crc) reqd ->
            if info.ui_force_link
            || !Clflags.link_everything
-           || is_required info.ui_name
+           || Linkdeps.required ldeps info.ui_name
            then begin
-             remove_required info.ui_name;
-             List.iter (add_required (Printf.sprintf "%s(%s)"
-                                        file_name info.ui_name))
-               info.ui_imports_cmx;
+             Linkdeps.add ldeps
+               ~filename:file_name ~compunit:info.ui_name
+               ~provides:[info.ui_name]
+               ~requires:(List.map fst info.ui_imports_cmx);
              (info, file_name, crc) :: reqd
            end else
            reqd)
@@ -293,7 +265,11 @@ let call_linker_shared file_list output_name =
 let link_shared ~ppf_dump objfiles output_name =
   Profile.record_call output_name (fun () ->
     let obj_infos = List.map read_file objfiles in
-    let units_tolink = List.fold_right scan_file obj_infos [] in
+    let ldeps = Linkdeps.create ~complete:false in
+    let units_tolink = List.fold_right (scan_file ldeps) obj_infos [] in
+    (match Linkdeps.check ldeps with
+     | None -> ()
+     | Some e -> raise (Error (Link_error e)));
     List.iter
       (fun (info, file_name, crc) -> check_consistency file_name info crc)
       units_tolink;
@@ -353,12 +329,11 @@ let link ~ppf_dump objfiles output_name =
       else if !Clflags.output_c_object then stdlib :: objfiles
       else stdlib :: (objfiles @ [stdexit]) in
     let obj_infos = List.map read_file objfiles in
-    let units_tolink = List.fold_right scan_file obj_infos [] in
-    Array.iter remove_required Runtimedef.builtin_exceptions;
-    begin match extract_missing_globals() with
-      [] -> ()
-    | mg -> raise(Error(Missing_implementations mg))
-    end;
+    let ldeps = Linkdeps.create ~complete:true in
+    let units_tolink = List.fold_right (scan_file ldeps) obj_infos [] in
+    (match Linkdeps.check ldeps with
+     | None -> ()
+     | Some e -> raise (Error (Link_error e)));
     List.iter
       (fun (info, file_name, crc) -> check_consistency file_name info crc)
       units_tolink;
@@ -384,55 +359,34 @@ let link ~ppf_dump objfiles output_name =
 
 (* Error report *)
 
-open Format
 module Style = Misc.Style
+open Format_doc
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | File_not_found name ->
       fprintf ppf "Cannot find file %a" Style.inline_code name
   | Not_an_object_file name ->
       fprintf ppf "The file %a is not a compilation unit description"
-        (Style.as_inline_code Location.print_filename) name
-  | Missing_implementations l ->
-     let print_references ppf = function
-       | [] -> ()
-       | r1 :: rl ->
-           Style.inline_code ppf r1;
-           List.iter (fun r -> fprintf ppf ",@ %a" Style.inline_code r) rl in
-      let print_modules ppf =
-        List.iter
-         (fun (md, rq) ->
-           fprintf ppf "@ @[<hov 2>%a referenced from %a@]"
-             Style.inline_code md
-             print_references rq) in
-      fprintf ppf
-       "@[<v 2>No implementations provided for the following modules:%a@]"
-       print_modules l
+        Location.Doc.quoted_filename name
   | Inconsistent_interface(intf, file1, file2) ->
       fprintf ppf
        "@[<hov>Files %a@ and %a@ make inconsistent assumptions \
               over interface %a@]"
-       (Style.as_inline_code Location.print_filename) file1
-       (Style.as_inline_code Location.print_filename) file2
+       Location.Doc.quoted_filename file1
+       Location.Doc.quoted_filename file2
        Style.inline_code intf
   | Inconsistent_implementation(intf, file1, file2) ->
       fprintf ppf
        "@[<hov>Files %a@ and %a@ make inconsistent assumptions \
               over implementation %a@]"
-       (Style.as_inline_code Location.print_filename) file1
-       (Style.as_inline_code Location.print_filename) file2
+       Location.Doc.quoted_filename file1
+       Location.Doc.quoted_filename file2
        Style.inline_code intf
   | Assembler_error file ->
       fprintf ppf "Error while assembling %a"
-        (Style.as_inline_code Location.print_filename) file
+        Location.Doc.quoted_filename file
   | Linking_error exitcode ->
       fprintf ppf "Error during linking (exit code %d)" exitcode
-  | Multiple_definition(modname, file1, file2) ->
-      fprintf ppf
-        "@[<hov>Files %a@ and %a@ both define a module named %a@]"
-        (Style.as_inline_code Location.print_filename) file1
-        (Style.as_inline_code Location.print_filename) file2
-        Style.inline_code modname
   | Missing_cmx(filename, name) ->
       fprintf ppf
         "@[<hov>File %a@ was compiled without access@ \
@@ -440,25 +394,28 @@ let report_error ppf = function
          which was produced by %a.@ \
          Please recompile %a@ with the correct %a option@ \
          so that %a@ is found.@]"
-        (Style.as_inline_code Location.print_filename) filename
+        Location.Doc.quoted_filename filename
         Style.inline_code ".cmx"
         Style.inline_code name
         Style.inline_code "ocamlopt -for-pack"
-        (Style.as_inline_code Location.print_filename) filename
+        Location.Doc.quoted_filename filename
         Style.inline_code "-I"
         Style.inline_code (name^".cmx")
+  | Link_error e ->
+      Linkdeps.report_error_doc ~print_filename:Location.Doc.filename ppf e
 
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
 
+let report_error = Format_doc.compat report_error_doc
+
 let reset () =
   Cmi_consistbl.clear crc_interfaces;
   Cmx_consistbl.clear crc_implementations;
-  implementations_defined := [];
   cmx_required := [];
   interfaces := [];
   implementations := [];

diff --git a/asmcomp/asmlink.mli b/asmcomp/asmlink.mli
index 6ee91ffb86d82ef004b569ddfa0f9fc4b31f4a1f..66596907c500641c181e6258a0a8c1c701fc1c6f 100644 (file)
--- a/asmcomp/asmlink.mli
+++ b/asmcomp/asmlink.mli
@@ -32,14 +32,14 @@ val extract_crc_implementations: unit -> crcs
 type error =
   | File_not_found of filepath
   | Not_an_object_file of filepath
-  | Missing_implementations of (modname * string list) list
   | Inconsistent_interface of modname * filepath * filepath
   | Inconsistent_implementation of modname * filepath * filepath
   | Assembler_error of filepath
   | Linking_error of int
-  | Multiple_definition of modname * filepath * filepath
   | Missing_cmx of filepath * modname
+  | Link_error of Linkdeps.error
 
 exception Error of error
 
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml
index fa9de400d0dffcda794e659f898251e7689dcf53..f0e2148f447c226eccb757aa0202c5d5c22ad125 100644 (file)
--- a/asmcomp/asmpackager.ml
+++ b/asmcomp/asmpackager.ml
@@ -281,21 +281,21 @@ let package_files ~ppf_dump initial_env files targetcmx ~backend =
 
 (* Error report *)
 
-open Format
+open Format_doc
 module Style = Misc.Style
 
-let report_error ppf = function
+let report_error_doc ppf = function
     Illegal_renaming(name, file, id) ->
       fprintf ppf "Wrong file naming: %a@ contains the code for\
                    @ %a when %a was expected"
-        (Style.as_inline_code Location.print_filename) file
+        Location.Doc.quoted_filename file
         Style.inline_code name Style.inline_code id
   | Forward_reference(file, ident) ->
       fprintf ppf "Forward reference to %a in file %a" Style.inline_code ident
-        (Style.as_inline_code Location.print_filename) file
+        Location.Doc.quoted_filename file
   | Wrong_for_pack(file, path) ->
       fprintf ppf "File %a@ was not compiled with the %a option"
-        (Style.as_inline_code Location.print_filename) file
+        Location.Doc.quoted_filename file
         Style.inline_code ("-for-pack " ^ path)
   | File_not_found file ->
       fprintf ppf "File %a not found" Style.inline_code file
@@ -307,6 +307,8 @@ let report_error ppf = function
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/asmcomp/asmpackager.mli b/asmcomp/asmpackager.mli
index 3ea2142540dd4c266c4b2b7d857e6c1a9fbfe2af..39508cec63c61ad58fa8287e517c1090d02b4c7a 100644 (file)
--- a/asmcomp/asmpackager.mli
+++ b/asmcomp/asmpackager.mli
@@ -34,4 +34,5 @@ type error =
 
 exception Error of error
 
-val report_error: Format.formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/asmcomp/cmm.ml b/asmcomp/cmm.ml
index b2783b595b8c7015fd7865bacf61948580b14824..d1abd096aa37119e72ba571e9479f134ac4bce27 100644 (file)
--- a/asmcomp/cmm.ml
+++ b/asmcomp/cmm.ml
@@ -169,6 +169,7 @@ and operation =
   | Ccheckbound
   | Copaque
   | Cdls_get
+  | Cpoll
 
 type expression =
     Cconst_int of int * Debuginfo.t

diff --git a/asmcomp/cmm.mli b/asmcomp/cmm.mli
index ed4efc823924580b50df8ac0a4fa615f4ee89ef6..c64f2c9f26ace880d1adbd1cdb6243e0c8a71889 100644 (file)
--- a/asmcomp/cmm.mli
+++ b/asmcomp/cmm.mli
@@ -168,6 +168,7 @@ and operation =
                    or equal to the bound. *)
   | Copaque (* Sys.opaque_identity *)
   | Cdls_get
+  | Cpoll
 
 (** Every basic block should have a corresponding [Debuginfo.t] for its
     beginning. *)

diff --git a/asmcomp/cmm_helpers.ml b/asmcomp/cmm_helpers.ml
index 44b3e0928dc27912438634e5913801bcebea41ef..c99c39bc0013670076b569a7986248089fd9a145 100644 (file)
--- a/asmcomp/cmm_helpers.ml
+++ b/asmcomp/cmm_helpers.ml
@@ -673,13 +673,10 @@ let tag_offset =
   if big_endian then -1 else -size_int
 
 let get_tag ptr dbg =
-  if Proc.word_addressed then           (* If byte loads are slow *)
-    Cop(Cand, [get_header ptr dbg; Cconst_int (255, dbg)], dbg)
-  else                                  (* If byte loads are efficient *)
-    (* Same comment as [get_header] above *)
-    Cop(
-      mk_load_immut Byte_unsigned,
-      [Cop(Cadda, [ptr; Cconst_int(tag_offset, dbg)], dbg)], dbg)
+  (* Same comment as [get_header] above *)
+  Cop(
+    mk_load_immut Byte_unsigned,
+    [Cop(Cadda, [ptr; Cconst_int(tag_offset, dbg)], dbg)], dbg)
 
 let get_size ptr dbg =
   Cop(Clsr, [get_header_masked ptr dbg; Cconst_int (10, dbg)], dbg)

diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 3be9e40e4188bdd9c0b4eb76046d14e091308625..8c52080980c69a59b2b198c48c7603f276a6ef84 100644 (file)
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -238,6 +238,21 @@ type unboxed_number_kind =
   | Boxed of boxed_number * bool (* true: boxed form available at no cost *)
   | No_result (* expression never returns a result *)
 
+(* A value kind [vk] is compatible with a boxed-number kind [bk]
+   if the boxing operation [bk] returns a value that may live in the
+   value kind [vk]. *)
+let compatible_kind vk bk =
+  match bk with
+  | No_unboxing | No_result -> true
+  | Boxed (bn, _) ->
+      match bn, vk with
+      | _, Pgenval -> true
+      | (Boxed_float _ | Boxed_integer _), Pintval -> false
+      | Boxed_float _, Pfloatval -> true
+      | Boxed_integer _, Pfloatval -> false
+      | Boxed_float _, Pboxedintval _ -> false
+      | Boxed_integer (bi1, _), Pboxedintval bi2 -> bi1 = bi2
+
 (* Given unboxed_number_kind from two branches of the code, returns the
    resulting unboxed_number_kind.
 
@@ -259,10 +274,24 @@ let join_unboxed_number_kind ~strict k1 k2 =
       k
   | _, _ -> No_unboxing
 
-let is_unboxed_number_cmm ~strict cmm =
+(* [is_unboxed_number_cmm ~strict ~kind cmm] computes an unboxed
+   number kind for the value returned by the expression [cmm].
+
+   See [join_unboxed_number_kind] above for the meaning of the
+   [~strict] parameter.
+
+   [~kind] is the value kind expected for the return value. If the
+   expression contains branches returning different boxed number
+   kinds, only those that are compatible with the expected return kind
+   are considered -- the other must be unreachable if the program is
+   well-typed. In particular, the unboxed number kind we return shall
+   be compatible with it in the sense of [compatible_kind] above.
+*)
+let is_unboxed_number_cmm ~strict ~kind cmm =
   let r = ref No_result in
   let notify k =
-    r := join_unboxed_number_kind ~strict !r k
+    if compatible_kind kind k then
+      r := join_unboxed_number_kind ~strict !r k
   in
   let rec aux = function
     | Cop(Calloc, [Cconst_natint (hdr, _); _], dbg)
@@ -529,7 +558,7 @@ let rec transl env e =
          | Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _
          | Pasrbint _ | Pbintcomp (_, _) | Pstring_load _ | Pbytes_load _
          | Pbytes_set _ | Pbigstring_load _ | Pbigstring_set _
-         | Pbbswap _), _)
+         | Pbbswap _ | Ppoll ), _)
         ->
           fatal_error "Cmmgen.transl:prim"
       end
@@ -667,7 +696,7 @@ and transl_catch env nfail ids body handler dbg =
            | Pintval | Pgenval -> true
          in
          u := join_unboxed_number_kind ~strict !u
-             (is_unboxed_number_cmm ~strict c)
+             (is_unboxed_number_cmm ~strict ~kind c)
       )
       ids args
   in
@@ -710,7 +739,7 @@ and transl_catch env nfail ids body handler dbg =
 and transl_make_array dbg env kind args =
   match kind with
   | Pgenarray ->
-      Cop(Cextcall("caml_make_array", typ_val, [], true),
+      Cop(Cextcall("caml_array_of_uniform_array", typ_val, [], true),
           [make_alloc dbg 0 (List.map (transl env) args)], dbg)
   | Paddrarray | Pintarray ->
       make_alloc dbg 0 (List.map (transl env) args)
@@ -836,6 +865,9 @@ and transl_prim_1 env p arg dbg =
       Cop(mk_load_atomic Word_int, [transl env arg], dbg)
   | Patomic_load {immediate_or_pointer = Pointer} ->
       Cop(mk_load_atomic Word_val, [transl env arg], dbg)
+  | Ppoll ->
+    (Csequence (remove_unit (transl env arg),
+                return_unit dbg (Cop(Cpoll, [], dbg))))
   | (Pfield_computed | Psequand | Psequor
     | Prunstack | Presume | Preperform
     | Patomic_exchange | Patomic_cas | Patomic_fetch_add
@@ -1038,7 +1070,7 @@ and transl_prim_2 env p arg1 arg2 dbg =
   | Pmakearray (_, _) | Pduparray (_, _) | Parraylength _ | Parraysetu _
   | Parraysets _ | Pbintofint _ | Pintofbint _ | Pcvtbint (_, _)
   | Pnegbint _ | Pbigarrayref (_, _, _, _) | Pbigarrayset (_, _, _, _)
-  | Pbigarraydim _ | Pbytes_set _ | Pbigstring_set _ | Pbbswap _
+  | Pbigarraydim _ | Pbytes_set _ | Pbigstring_set _ | Pbbswap _ | Ppoll
     ->
       fatal_errorf "Cmmgen.transl_prim_2: %a"
         Printclambda_primitives.primitive p
@@ -1116,7 +1148,7 @@ and transl_prim_3 env p arg1 arg2 arg3 dbg =
   | Psubbint _ | Pmulbint _ | Pdivbint _ | Pmodbint _ | Pandbint _ | Porbint _
   | Pxorbint _ | Plslbint _ | Plsrbint _ | Pasrbint _ | Pbintcomp (_, _)
   | Pbigarrayref (_, _, _, _) | Pbigarrayset (_, _, _, _) | Pbigarraydim _
-  | Pstring_load _ | Pbytes_load _ | Pbigstring_load _ | Pbbswap _
+  | Pstring_load _ | Pbytes_load _ | Pbigstring_load _ | Pbbswap _ | Ppoll
     ->
       fatal_errorf "Cmmgen.transl_prim_3: %a"
         Printclambda_primitives.primitive p
@@ -1149,7 +1181,7 @@ and transl_prim_4 env p arg1 arg2 arg3 arg4 dbg =
   | Psubbint _ | Pmulbint _ | Pdivbint _ | Pmodbint _ | Pandbint _ | Porbint _
   | Pxorbint _ | Plslbint _ | Plsrbint _ | Pasrbint _ | Pbintcomp (_, _)
   | Pbigarrayref (_, _, _, _) | Pbigarrayset (_, _, _, _) | Pbigarraydim _
-  | Pstring_load _ | Pbytes_load _ | Pbigstring_load _ | Pbbswap _
+  | Pstring_load _ | Pbytes_load _ | Pbigstring_load _ | Pbbswap _ | Ppoll
     ->
       fatal_errorf "Cmmgen.transl_prim_3: %a"
         Printclambda_primitives.primitive p
@@ -1190,14 +1222,14 @@ and transl_let env str kind id exp transl_body =
         (* It would be safe to always unbox in this case, but
            we do it only if this indeed allows us to get rid of
            some allocations in the bound expression. *)
-        is_unboxed_number_cmm ~strict:false cexp
+        is_unboxed_number_cmm ~strict:false ~kind cexp
     | _, Pgenval ->
         (* Here we don't know statically that the bound expression
            evaluates to an unboxable number type.  We need to be stricter
            and ensure that all possible branches in the expression
            return a boxed value (of the same kind).  Indeed, with GADTs,
            different branches could return different types. *)
-        is_unboxed_number_cmm ~strict:true cexp
+        is_unboxed_number_cmm ~strict:true ~kind cexp
     | _, Pintval ->
         No_unboxing
   in

diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index e177e46b0ed2215eae412be363324c0d5cfbfda1..306e2492239969b21ab1af27db76807ccec1c822 100644 (file)
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -457,9 +457,18 @@ let reset () =
 let binary_backend_available = ref false
 let create_asm_file = ref true
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Stack_frame_too_large n ->
-      Format.fprintf ppf "stack frame too large (%d bytes)" n
+      Format_doc.fprintf ppf "stack frame too large (%d bytes)" n
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
+      | _ -> None
+    )
+
+let report_error = Format_doc.compat report_error_doc
 
 let mk_env f : Emitenv.per_function_env =
   {
@@ -474,3 +483,16 @@ let mk_env f : Emitenv.per_function_env =
     float_literals = [];
     int_literals = [];
   }
+
+let emit_named_text_section func_name prefix_char =
+  if !Clflags.function_sections then begin
+    emit_string "\t.section .text.caml.";
+    emit_symbol func_name;
+    emit_char ',';
+    emit_string_literal "ax";
+    emit_char ',';
+    emit_char prefix_char;
+    emit_string "progbits\n";
+  end
+  else
+    emit_string "\t.text\n"

diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
index e5bead1e014e730288f3db3e1fe722f0a88887ed..d174fa92d40abdc373e0baedb756c4137c8f1d18 100644 (file)
--- a/asmcomp/emitaux.mli
+++ b/asmcomp/emitaux.mli
@@ -87,6 +87,10 @@ type error =
   | Stack_frame_too_large of int
 
 exception Error of error
-val report_error: Format.formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
 
 val mk_env : Linear.fundecl -> Emitenv.per_function_env
+
+(* Output .text section directive, or named .text.caml.<name> if enabled. *)
+val emit_named_text_section : string -> char -> unit

diff --git a/asmcomp/polling.ml b/asmcomp/polling.ml
index bf0206adc5cd1cc3c0d8fdc5df3ec1857d805ecf..ec238a3c0360e0c7ae8bd24219cc73e461184691 100644 (file)
--- a/asmcomp/polling.ml
+++ b/asmcomp/polling.ml
@@ -18,7 +18,7 @@
 (**************************************************************************)
 
 open Mach
-open Format
+open Format_doc
 
 module Int = Numbers.Int
 module String = Misc.Stdlib.String
@@ -316,7 +316,7 @@ let report_error ppf = function
           | Poll -> ()
           | Alloc | Function_call | External_call ->
             fprintf ppf "\t%s at " (instr_type p);
-            Location.print_loc ppf (Debuginfo.to_location dbg);
+            Location.Doc.loc ppf (Debuginfo.to_location dbg);
             fprintf ppf "\n"
           end
         ) instrs;

diff --git a/asmcomp/power/arch.ml b/asmcomp/power/arch.ml
index 649618f6cc9240429cccdf5665e09c8e195975fe..9d0666932310b5bc4a9cff93db24312ed69cf1a6 100644 (file)
--- a/asmcomp/power/arch.ml
+++ b/asmcomp/power/arch.ml
@@ -72,11 +72,6 @@ let offset_addressing addr delta =
   | Iindexed n -> Iindexed(n + delta)
   | Iindexed2 -> assert false
 
-let num_args_addressing = function
-    Ibased _ -> 0
-  | Iindexed _ -> 1
-  | Iindexed2 -> 2
-
 (* Printing operations and addressing modes *)
 
 let print_addressing printreg addr ppf arg =

diff --git a/asmcomp/power/arch.mli b/asmcomp/power/arch.mli
index a4a619a95611cc0f043634dcc6441b94d745b9cc..031b86dc20abaadd572152ab2ac1dc75dfcec48c 100644 (file)
--- a/asmcomp/power/arch.mli
+++ b/asmcomp/power/arch.mli
@@ -64,8 +64,6 @@ val identity_addressing : addressing_mode
 
 val offset_addressing : addressing_mode -> int -> addressing_mode
 
-val num_args_addressing : addressing_mode -> int
-
 (* Printing operations and addressing modes *)
 
 val print_addressing :

diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
index 70a6a0f70e431d14cd0ea492ff8678b785f4ad3a..f9303ea65d37506a396555a34e7e7cca25cce9b7 100644 (file)
--- a/asmcomp/power/emit.mlp
+++ b/asmcomp/power/emit.mlp
@@ -72,9 +72,6 @@ let emit_label lbl =
 
 (* Section switching *)
 
-let code_space =
-  "    .section \".text\"\n"
-
 let data_space =
   "    .section \".data\"\n"
 
@@ -84,6 +81,9 @@ let rodata_space =
 let toc_space =
   " .section \".toc\",\"aw\"\n"
 
+let emit_named_text_section func_name =
+  Emitaux.emit_named_text_section func_name '@'
+
 (* Output a processor register *)
 
 let emit_gpr = emit_int
@@ -177,6 +177,28 @@ let emit_tocload emit_dest dest entry =
 
 (* Output a load or store operation *)
 
+let load_mnemonic = function
+  | Byte_unsigned -> "lbz"
+  | Byte_signed -> "lbz"
+  | Sixteen_unsigned -> "lhz"
+  | Sixteen_signed -> "lha"
+  | Thirtytwo_unsigned -> "lwz"
+  | Thirtytwo_signed -> "lwa"
+  | Word_int | Word_val -> "ld"
+  | Single -> "lfs"
+  | Double -> "lfd"
+
+let store_mnemonic = function
+  | Byte_unsigned | Byte_signed -> "stb"
+  | Sixteen_unsigned | Sixteen_signed -> "sth"
+  | Thirtytwo_unsigned | Thirtytwo_signed -> "stw"
+  | Word_int | Word_val -> "std"
+  | Single -> "stfs"
+  | Double -> "stfd"
+
+let store_needs_lwsync chunk assignment =
+  assignment && (chunk = Word_int || chunk = Word_val)
+
 let valid_offset instr ofs =
   ofs land 3 = 0 || (instr <> "ld" && instr <> "std" && instr <> "lwa")
 
@@ -383,11 +405,17 @@ module BR = Branch_relaxation.Make (struct
 
   let tocload_size = 2
 
-  let load_store_size = function
+  let load_store_size instr = function
     | Ibased(_s, d) ->
-        let (_lo, hi) = low_high_s d in
-        tocload_size + (if hi = 0 then 1 else 2)
-    | Iindexed ofs -> if is_immediate ofs then 1 else 3
+      let (lo, hi) = low_high_s d in
+      tocload_size +
+      (if hi <> 0 then 1 else 0) +
+      (if valid_offset instr lo then 1 else 2)
+    | Iindexed ofs ->
+      if is_immediate ofs && valid_offset instr ofs then 1 else begin
+        let (lo, _hi) = low_high_u ofs in
+        if lo <> 0 then 3 else 2
+      end
     | Iindexed2 -> 1
 
   let instr_size f = function
@@ -415,16 +443,16 @@ module BR = Branch_relaxation.Make (struct
         else if alloc then tocload_size + 2
         else 5
     | Lop(Istackoffset _) -> 1
-    | Lop(Iload {memory_chunk; addressing_mode; _ }) ->
-      if memory_chunk = Byte_signed
-      then load_store_size addressing_mode + 1
-      else load_store_size addressing_mode
+    | Lop(Iload {memory_chunk; addressing_mode; is_atomic }) ->
+      let loadinstr = load_mnemonic memory_chunk in
+      (if is_atomic then 4 else 0) +
+      (if memory_chunk = Byte_signed then 1 else 0) +
+      load_store_size loadinstr addressing_mode
     | Lop(Istore(chunk, addr, assignment)) ->
-        (match chunk with
-         | Single -> 1
-         | Word_int | Word_val when assignment -> 1
-         | _ -> 0)
-        + load_store_size addr
+      let storeinstr = store_mnemonic chunk in
+        (if chunk = Single then 1 else 0) +
+        (if store_needs_lwsync chunk assignment then 1 else 0) +
+        load_store_size storeinstr addr
     | Lop(Ialloc _) -> 5
     | Lop(Ispecific(Ialloc_far _)) -> 6
     | Lop(Ipoll { return_label = Some(_) }) -> 5
@@ -442,12 +470,12 @@ module BR = Branch_relaxation.Make (struct
     | Lop(Ispecific(Icheckbound_imm_far _)) -> 3
     | Lop(Iintop_imm _) -> 1
     | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1
-    | Lop(Ifloatofint) -> 9
-    | Lop(Iintoffloat) -> 4
+    | Lop(Ifloatofint) -> 3
+    | Lop(Iintoffloat) -> 3
     | Lop(Iopaque) -> 0
     | Lop(Ispecific _) -> 1
-    | Lop (Idls_get) -> 1
-    | Lop (Ireturn_addr) -> 1
+    | Lop(Idls_get) -> 1
+    | Lop(Ireturn_addr) -> 1
     | Lreloadretaddr -> 2
     | Lreturn -> 2
     | Llabel _ -> 0
@@ -457,7 +485,7 @@ module BR = Branch_relaxation.Make (struct
       1 + (if lbl0 = None then 0 else 1)
         + (if lbl1 = None then 0 else 1)
         + (if lbl2 = None then 0 else 1)
-    | Lswitch _ -> 5 + tocload_size
+    | Lswitch _ -> 7 + tocload_size
     | Lentertrap -> 1
     | Ladjust_trap_depth _ -> 0
     | Lpushtrap _ -> 4 + tocload_size
@@ -705,17 +733,7 @@ let emit_instr env i =
         `      addi    1, 1, {emit_int (-n)}\n`;
         adjust_stack_offset env n
     | Lop(Iload { memory_chunk; addressing_mode; is_atomic }) ->
-        let loadinstr =
-          match memory_chunk with
-          | Byte_unsigned -> "lbz"
-          | Byte_signed -> "lbz"
-          | Sixteen_unsigned -> "lhz"
-          | Sixteen_signed -> "lha"
-          | Thirtytwo_unsigned -> "lwz"
-          | Thirtytwo_signed -> "lwa"
-          | Word_int | Word_val -> "ld"
-          | Single -> "lfs"
-          | Double -> "lfd" in
+        let loadinstr = load_mnemonic memory_chunk in
         if is_atomic then
           `    sync\n`;
         emit_load_store loadinstr addressing_mode i.arg 0 i.res.(0);
@@ -731,19 +749,12 @@ let emit_instr env i =
         `      frsp    {emit_reg tmp}, {emit_reg i.arg.(0)}\n`;
         emit_load_store "stfs" addr i.arg 1 tmp
     | Lop(Istore(chunk, addr, assignment)) ->
-        let storeinstr =
-          match chunk with
-          | Byte_unsigned | Byte_signed -> "stb"
-          | Sixteen_unsigned | Sixteen_signed -> "sth"
-          | Thirtytwo_unsigned | Thirtytwo_signed -> "stw"
-          | Word_int | Word_val -> "std"
-          | Single -> assert false
-          | Double -> "stfd" in
+        let storeinstr = store_mnemonic chunk in
         (* Non-initializing stores need a memory barrier to follow the
            Multicore OCaml memory model.  Stores of size other than
            Word_int and Word_val do not follow the memory model and therefore
            do not need a barrier *)
-        if assignment && (chunk = Word_int || chunk = Word_val) then
+        if store_needs_lwsync chunk assignment then
           `    lwsync\n`;
         emit_load_store storeinstr addr i.arg 1 i.arg.(0)
     | Lop(Ialloc { bytes; dbginfo }) ->
@@ -986,7 +997,7 @@ let max_out_of_line_code_offset fundecl =
 
 let fundecl fundecl =
   let env = mk_env fundecl in
-  emit_string code_space;
+  emit_named_text_section fundecl.fun_name;
   `    .align  2\n`;
   (* Dynamic stack checking *)
   let stack_threshold_size = Config.stack_threshold * 8 in (* bytes *)
@@ -1117,14 +1128,14 @@ let begin_assembly() =
   declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`;
   let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
-  emit_string code_space;
+  emit_named_text_section lbl_begin;
   declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly() =
   (* Emit the end of the segments *)
-  emit_string code_space;
   let lbl_end = Compilenv.make_symbol (Some "code_end") in
+  emit_named_text_section lbl_end;
   declare_global_data lbl_end;
   `{emit_symbol lbl_end}:\n`;
   `    .long   0\n`;

diff --git a/asmcomp/power/proc.ml b/asmcomp/power/proc.ml
index 8eb0c8232f3fa6f4148a1fe5ec4970661eb8b31f..f7338a9adc9b98c57288debf195defffe575ada9 100644 (file)
--- a/asmcomp/power/proc.ml
+++ b/asmcomp/power/proc.ml
@@ -22,10 +22,6 @@ open Reg
 open Arch
 open Mach
 
-(* Instruction selection *)
-
-let word_addressed = false
-
 (* Registers available for register allocation *)
 
 (* Integer register map:

diff --git a/asmcomp/printcmm.ml b/asmcomp/printcmm.ml
index 400044f0512bc77e68ba29e93c0e7b8aee88ce66..7f98cc2171490f4096d1180918ca3b1c3d367c72 100644 (file)
--- a/asmcomp/printcmm.ml
+++ b/asmcomp/printcmm.ml
@@ -159,6 +159,7 @@ let operation d = function
   | Ccheckbound -> "checkbound" ^ location d
   | Copaque -> "opaque"
   | Cdls_get -> "dls_get"
+  | Cpoll -> "poll"
 
 let rec expr ppf = function
   | Cconst_int (n, _dbg) -> fprintf ppf "%i" n

diff --git a/asmcomp/proc.mli b/asmcomp/proc.mli
index e6352e02790292ee68ede569848ebe95f675ea9e..2cd94f76ae94fac0841296a4b9591a68d5bfd5f9 100644 (file)
--- a/asmcomp/proc.mli
+++ b/asmcomp/proc.mli
@@ -15,9 +15,6 @@
 
 (* Processor descriptions *)
 
-(* Instruction selection *)
-val word_addressed: bool
-
 (* Registers available for register allocation *)
 val num_register_classes: int
 val register_class: Reg.t -> int

diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml
index 04a56bbbc49dc32eb32d99ee213ac943f13820bb..90812ae4a7fd017ab96042316b04d44994aec12b 100644 (file)
--- a/asmcomp/riscv/arch.ml
+++ b/asmcomp/riscv/arch.ml
@@ -58,9 +58,6 @@ let offset_addressing addr delta =
   match addr with
   | Iindexed n -> Iindexed(n + delta)
 
-let num_args_addressing = function
-  | Iindexed _ -> 1
-
 (* Printing operations and addressing modes *)
 
 let print_addressing printreg addr ppf arg =

diff --git a/asmcomp/riscv/arch.mli b/asmcomp/riscv/arch.mli
index 248697e453a2163284d34f23c5f87b56adf26740..23f96855223386cee1cf1f9bab6054079eace2c7 100644 (file)
--- a/asmcomp/riscv/arch.mli
+++ b/asmcomp/riscv/arch.mli
@@ -55,8 +55,6 @@ val identity_addressing : addressing_mode
 
 val offset_addressing : addressing_mode -> int -> addressing_mode
 
-val num_args_addressing : addressing_mode -> int
-
 (* Printing operations and addressing modes *)
 
 val print_addressing :

diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp
index 7ad823ca70f445c2f2c45f1c048a9350d723226c..964dc4db5c1138f14aeee337ccebefb1adc902cb 100644 (file)
--- a/asmcomp/riscv/emit.mlp
+++ b/asmcomp/riscv/emit.mlp
@@ -51,7 +51,7 @@ let slot_offset env loc cls =
 (* Output a symbol *)
 
 let emit_jump op s =
-  if !Clflags.dlcode || !Clflags.pic_code
+  if !Clflags.dlcode
   then `{emit_string op}       {emit_symbol s}@plt`
   else `{emit_string op}       {emit_symbol s}`
 
@@ -68,12 +68,12 @@ let emit_label lbl =
 let data_space =
   ".section .data"
 
-let code_space =
-  ".section .text"
-
 let rodata_space =
   ".section .rodata"
 
+let emit_named_text_section func_name =
+  Emitaux.emit_named_text_section func_name '@'
+
 (* Names for special regs *)
 
 let reg_tmp = phys_reg 23 (* t1 *)
@@ -620,7 +620,7 @@ let fundecl fundecl =
   let env = mk_env fundecl in
   `    .globl  {emit_symbol fundecl.fun_name}\n`;
   `    .type   {emit_symbol fundecl.fun_name}, @function\n`;
-  `    {emit_string code_space}\n`;
+  emit_named_text_section fundecl.fun_name;
   `    .align  2\n`;
   `{emit_symbol fundecl.fun_name}:\n`;
   emit_debug_info fundecl.fun_dbg;
@@ -717,7 +717,7 @@ let data l =
 (* Beginning / end of an assembly file *)
 
 let begin_assembly() =
-  if !Clflags.dlcode || !Clflags.pic_code then `       .option pic\n`;
+  if !Clflags.dlcode then `    .option pic\n`;
   `    .file \"\"\n`; (* PR#7073 *)
   reset_debug_info ();
   (* Emit the beginning of the segments *)
@@ -726,13 +726,13 @@ let begin_assembly() =
   declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`;
   let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
-  `    {emit_string code_space}\n`;
+  emit_named_text_section lbl_begin;
   declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly() =
-  `    {emit_string code_space}\n`;
   let lbl_end = Compilenv.make_symbol (Some "code_end") in
+  emit_named_text_section lbl_end;
   declare_global_data lbl_end;
   `{emit_symbol lbl_end}:\n`;
   `    .long   0\n`;

diff --git a/asmcomp/riscv/proc.ml b/asmcomp/riscv/proc.ml
index 827ef3d03abbb688f03bf930698c8323a21be8b9..48e33a9665ddfb0369b5dc18e685658d30066a21 100644 (file)
--- a/asmcomp/riscv/proc.ml
+++ b/asmcomp/riscv/proc.ml
@@ -22,10 +22,6 @@ open Reg
 open Arch
 open Mach
 
-(* Instruction selection *)
-
-let word_addressed = false
-
 (* Registers available for register allocation *)
 
 (* Integer register map

diff --git a/asmcomp/s390x/arch.ml b/asmcomp/s390x/arch.ml
index 44bed8bc48ef1fd1b95945a1a77816c934d67316..e1d0a2cc03a642c9e1325063c3ce37c672d12313 100644 (file)
--- a/asmcomp/s390x/arch.ml
+++ b/asmcomp/s390x/arch.ml
@@ -22,12 +22,10 @@ open Format
 
 (* Machine-specific command-line options *)
 
-let pic_code = ref true
-
 let command_line_options =
-  [ "-fPIC", Arg.Set pic_code,
+  [ "-fPIC", Arg.Set Clflags.pic_code,
       " Generate position-independent machine code (default)";
-    "-fno-PIC", Arg.Clear pic_code,
+    "-fno-PIC", Arg.Clear Clflags.pic_code,
       " Generate position-dependent machine code" ]
 
 (* Specific operations *)
@@ -65,10 +63,6 @@ let offset_addressing addr delta =
   | Iindexed n -> Iindexed(n + delta)
   | Iindexed2 n -> Iindexed2(n + delta)
 
-let num_args_addressing = function
-  | Iindexed _ -> 1
-  | Iindexed2 _ -> 2
-
 (* Printing operations and addressing modes *)
 
 let print_addressing printreg addr ppf arg =

diff --git a/asmcomp/s390x/arch.mli b/asmcomp/s390x/arch.mli
index d1bcaec1f25ed4842e41f4d291f37a39191d70b6..4b8f6dc2d415494d720dfda3d6b241ee55b357f0 100644 (file)
--- a/asmcomp/s390x/arch.mli
+++ b/asmcomp/s390x/arch.mli
@@ -20,8 +20,6 @@
 
 (* Machine-specific command-line options *)
 
-val pic_code : bool ref
-
 val command_line_options : (string * Arg.spec * string) list
 
 (* Specific operations *)
@@ -58,8 +56,6 @@ val identity_addressing : addressing_mode
 
 val offset_addressing : addressing_mode -> int -> addressing_mode
 
-val num_args_addressing : addressing_mode -> int
-
 (* Printing operations and addressing modes *)
 
 val print_addressing :

diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp
index 2d6bc4d1dc30d17b0157f41a6b0b7a5bd12d9a29..9959ff1531d5c41ada361f0ee73bb5601a1b6a11 100644 (file)
--- a/asmcomp/s390x/emit.mlp
+++ b/asmcomp/s390x/emit.mlp
@@ -47,7 +47,7 @@ let slot_offset env loc cls =
 (* Output function call *)
 
 let emit_call s =
-  if !pic_code then
+  if !Clflags.pic_code then
    `   brasl   %r14, {emit_symbol s}@PLT\n`
   else
    `   brasl   %r14, {emit_symbol s}\n`
@@ -63,10 +63,11 @@ let emit_label lbl =
 
 let data_space = "     .section \".data\"\n"
 
-let code_space = "     .section \".text\"\n"
-
 let rodata_space = "   .section \".rodata\"\n"
 
+let emit_named_text_section func_name =
+  Emitaux.emit_named_text_section func_name '@'
+
 (* Output a pseudo-register *)
 
 let emit_reg r =
@@ -120,7 +121,7 @@ let emit_stack env r =
 (* Output a load of the address of a global symbol *)
 
 let emit_load_symbol_addr reg s =
-  if !pic_code then
+  if !Clflags.pic_code then
   `    lgrl    {emit_reg reg}, {emit_symbol s}@GOT\n`
   else
   `    larl    {emit_reg reg}, {emit_symbol s}\n`
@@ -359,7 +360,7 @@ let emit_instr env i =
           if env.f.fun_frame_required then
             `  lg      %r14, {emit_int(n - size_addr)}(%r15)\n`;
           emit_stack_adjust (-n);
-          if !pic_code then
+          if !Clflags.pic_code then
             `  brcl    15, {emit_symbol func}@PLT\n`
           else
             `  brcl    15, {emit_symbol func}\n`
@@ -666,7 +667,7 @@ let emit_instr env i =
         for i = 0 to Array.length jumptbl - 1 do
           `    .long   {emit_label jumptbl.(i)} - {emit_label lbl}\n`
         done;
-        emit_string code_space
+        emit_named_text_section env.f.fun_name
     | Lentertrap ->
         ()
     | Ladjust_trap_depth { delta_traps } ->
@@ -718,7 +719,7 @@ let fundecl fundecl =
   `    .globl  {emit_symbol fundecl.fun_name}\n`;
   emit_debug_info fundecl.fun_dbg;
   `    .type   {emit_symbol fundecl.fun_name}, @function\n`;
-  emit_string code_space;
+  emit_named_text_section fundecl.fun_name;
   `    .align  8\n`;
   `{emit_symbol fundecl.fun_name}:\n`;
   cfi_startproc ();
@@ -827,14 +828,14 @@ let begin_assembly() =
   declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`;
   let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
-  emit_string code_space;
+  emit_named_text_section lbl_begin;
   declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly() =
   (* Emit the end of the segments *)
-  emit_string code_space;
   let lbl_end = Compilenv.make_symbol (Some "code_end") in
+  emit_named_text_section lbl_end;
   declare_global_data lbl_end;
   `{emit_symbol lbl_end}:\n`;
   `    .long   0\n`;

diff --git a/asmcomp/s390x/proc.ml b/asmcomp/s390x/proc.ml
index e6daa98b7ee20163d09ae531706eb535a59ffc15..d2258b90ac18206bb23da3797f12dc57a032a164 100644 (file)
--- a/asmcomp/s390x/proc.ml
+++ b/asmcomp/s390x/proc.ml
@@ -24,10 +24,6 @@ open Reg
 open Arch
 open Mach
 
-(* Instruction selection *)
-
-let word_addressed = false
-
 (* Registers available for register allocation *)
 
 (* Integer register map:

diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
index 3d4c4f0ab8f59e85b99750333efab0ba0809c79a..8226a39c9daa1dd15f6fc9ca0e37eb4e9b5cc6dc 100644 (file)
--- a/asmcomp/selectgen.ml
+++ b/asmcomp/selectgen.ml
@@ -87,6 +87,7 @@ let oper_result_type = function
   | Craise _ -> typ_void
   | Ccheckbound -> typ_void
   | Copaque -> typ_val
+  | Cpoll -> typ_void
 
 (* Infer the size in bytes of the result of an expression whose evaluation
    may be deferred (cf. [emit_parts]). *)
@@ -268,7 +269,7 @@ module Effect_and_coeffect : sig
   val none : t
   val arbitrary : t
 
-  val effect : t -> Effect.t
+  val effect_ : t -> Effect.t
   val coeffect : t -> Coeffect.t
 
   val pure_and_copure : t -> bool
@@ -284,7 +285,7 @@ end = struct
   let none = Effect.None, Coeffect.None
   let arbitrary = Effect.Arbitrary, Coeffect.Arbitrary
 
-  let effect (e, _ce) = e
+  let effect_ (e, _ce) = e
   let coeffect (_e, ce) = ce
 
   let pure_and_copure (e, ce) = Effect.pure e && Coeffect.copure ce
@@ -325,7 +326,8 @@ method is_simple_expr = function
   | Cop(op, args, _) ->
       begin match op with
         (* The following may have side effects *)
-      | Capply _ | Cextcall _ | Calloc | Cstore _ | Craise _ | Copaque -> false
+      | Capply _ | Cextcall _ | Calloc | Cstore _ | Craise _ | Copaque
+      | Cpoll -> false
         (* The remaining operations are simple if their args are *)
       | Cload _ | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi | Cand | Cor
       | Cxor | Clsl | Clsr | Casr | Ccmpi _ | Caddv | Cadda | Ccmpa _ | Cnegf
@@ -365,7 +367,7 @@ method effects_of exp =
   | Cop (op, args, _) ->
     let from_op =
       match op with
-      | Capply _ | Cextcall _ | Copaque -> EC.arbitrary
+      | Capply _ | Cextcall _ | Copaque | Cpoll -> EC.arbitrary
       | Calloc -> EC.none
       | Cstore _ -> EC.effect_only Effect.Arbitrary
       | Craise _ | Ccheckbound -> EC.effect_only Effect.Raise
@@ -433,6 +435,7 @@ method select_operation op args _dbg =
         (* Inversion addr/datum in Istore *)
       end
   | (Cdls_get, _) -> Idls_get, args
+  | (Cpoll, _) -> (Ipoll { return_label = None }), args
   | (Calloc, _) -> (Ialloc {bytes = 0; dbginfo = []}), args
   | (Caddi, _) -> self#select_arith_comm Iadd args
   | (Csubi, _) -> self#select_arith Isub args
@@ -839,7 +842,7 @@ method private emit_parts (env:environment) ~effects_after exp =
   let module EC = Effect_and_coeffect in
   let may_defer_evaluation =
     let ec = self#effects_of exp in
-    match EC.effect ec with
+    match EC.effect_ ec with
     | Effect.Arbitrary | Effect.Raise ->
       (* Preserve the ordering of effectful expressions by evaluating them
          early (in the correct order) and assigning their results to
@@ -861,14 +864,14 @@ method private emit_parts (env:environment) ~effects_after exp =
            every [exp'] (for [exp'] as in the comment above) has no effects
            "worse" (in the sense of the ordering in [Effect.t]) than raising
            an exception. *)
-        match EC.effect effects_after with
+        match EC.effect_ effects_after with
         | Effect.None | Effect.Raise -> true
         | Effect.Arbitrary -> false
       end
       | Coeffect.Arbitrary -> begin
         (* Arbitrary expressions may only be deferred if evaluation of
            every [exp'] (for [exp'] as in the comment above) has no effects. *)
-        match EC.effect effects_after with
+        match EC.effect_ effects_after with
         | Effect.None -> true
         | Effect.Arbitrary | Effect.Raise -> false
       end

diff --git a/asmcomp/selectgen.mli b/asmcomp/selectgen.mli
index 2cc4b199eccfe65523bdc0e99306103bf8f4d7ae..1c11b523bcde17764551b47be222bcdb2192886a 100644 (file)
--- a/asmcomp/selectgen.mli
+++ b/asmcomp/selectgen.mli
@@ -49,7 +49,7 @@ module Effect_and_coeffect : sig
   val none : t
   val arbitrary : t
 
-  val effect : t -> Effect.t
+  val effect_ : t -> Effect.t
   val coeffect : t -> Coeffect.t
 
   val effect_only : Effect.t -> t

diff --git a/asmcomp/stackframegen.ml b/asmcomp/stackframegen.ml
index 52fe8bb6fade706ad2671e4ae7b87e42b3828670..b0ee6035340270d092d643e98ca82f2ae5f940e4 100644 (file)
--- a/asmcomp/stackframegen.ml
+++ b/asmcomp/stackframegen.ml
@@ -42,7 +42,7 @@ method virtual trap_handler_size : int
    by treating them as non-tail calls, even if they are implemented as
    tail calls.
 
-   This method can be overriden in [Stackframe] to implement target-specific
+   This method can be overridden in [Stackframe] to implement target-specific
    behaviors. *)
 
 method is_call = function
@@ -61,7 +61,7 @@ method is_call = function
    This is the case if it contains calls, but also if it allocates
    variables on the stack.
 
-   This method can be overriden in [Stackframe] to implement target-specific
+   This method can be overridden in [Stackframe] to implement target-specific
    behaviors. *)
 
 method frame_required f contains_calls =

diff --git a/asmcomp/thread_sanitizer.ml b/asmcomp/thread_sanitizer.ml
index fa1fbf7fcc4b637759dae1872b72c8948f0f7e43..362a89536acddd9914942be01e37a543946386d8 100644 (file)
--- a/asmcomp/thread_sanitizer.ml
+++ b/asmcomp/thread_sanitizer.ml
@@ -146,7 +146,7 @@ let wrap_entry_exit expr =
           ( ( Calloc | Caddi | Csubi | Cmuli | Cdivi | Cmodi | Cand | Cmulhi
             | Cor | Cxor | Clsl | Clsr | Casr | Caddv | Cadda | Cnegf | Cabsf
             | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat
-            | Ccheckbound | Copaque | Cdls_get | Capply _ | Cextcall _
+            | Ccheckbound | Copaque | Cdls_get | Cpoll | Capply _ | Cextcall _
             | Cload _ | Cstore _ | Ccmpi _ | Ccmpa _ | Ccmpf _ | Craise _ ),
             _,
             _ )
@@ -254,8 +254,8 @@ let instrument body =
         ( (( Capply _ | Caddi | Calloc | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
            | Cand | Cor | Cxor | Clsl | Clsr | Casr | Caddv | Cadda | Cnegf
            | Cabsf | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat
-           | Ccheckbound | Copaque | Cdls_get | Cextcall _ | Ccmpi _ | Ccmpa _
-           | Ccmpf _ ) as op),
+           | Ccheckbound | Copaque | Cdls_get | Cpoll | Cextcall _ | Ccmpi _
+           | Ccmpa _ | Ccmpf _ ) as op),
           es,
           dbg_none ) ->
       Cop (op, List.map aux es, dbg_none)

diff --git a/boot/menhir/menhirLib.ml b/boot/menhir/menhirLib.ml
index 753d5e7c388ad187c4207466e04c93dfa77838c8..ee7f581f25e28dafc795743dfedff6c9b7523a93 100644 (file)
--- a/boot/menhir/menhirLib.ml
+++ b/boot/menhir/menhirLib.ml
@@ -1,14 +1,11 @@
 module General = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -89,14 +86,11 @@ end
 module Convert = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -212,14 +206,11 @@ end
 module IncrementalEngine = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -300,12 +291,12 @@ module type INCREMENTAL_ENGINE = sig
     'a checkpoint
 
   (* [resume] allows the user to resume the parser after it has suspended
-     itself with a checkpoint of the form [AboutToReduce (env, prod)] or
-     [HandlingError env]. [resume] expects the old checkpoint and produces a
+     itself with a checkpoint of the form [Shifting _], [AboutToReduce _], or
+     [HandlingError _]. [resume] expects the old checkpoint and produces a
      new checkpoint. It does not raise any exception. *)
 
   (* The optional argument [strategy] influences the manner in which [resume]
-     deals with checkpoints of the form [ErrorHandling _]. Its default value
+     deals with checkpoints of the form [HandlingError _]. Its default value
      is [`Legacy]. It can be briefly described as follows:
 
      - If the [error] token is used only to report errors (that is, if the
@@ -701,14 +692,11 @@ end
 module EngineTypes = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -789,6 +777,53 @@ type ('state, 'semantic_value, 'token) env = {
 
 (* --------------------------------------------------------------------------- *)
 
+(* A number of logging hooks are used to (optionally) emit logging messages. *)
+
+(* The comments indicate the conventional messages that correspond
+   to these hooks in the code-based back-end; see [CodeBackend]. *)
+
+module type LOG = sig
+
+  type state
+  type terminal
+  type production
+
+  (* State %d: *)
+
+  val state: state -> unit
+
+  (* Shifting (<terminal>) to state <state> *)
+
+  val shift: terminal -> state -> unit
+
+  (* Reducing a production should be logged either as a reduction
+     event (for regular productions) or as an acceptance event (for
+     start productions). *)
+
+  (* Reducing production <production> / Accepting *)
+
+  val reduce_or_accept: production -> unit
+
+  (* Lookahead token is now <terminal> (<pos>-<pos>) *)
+
+  val lookahead_token: terminal -> Lexing.position -> Lexing.position -> unit
+
+  (* Initiating error handling *)
+
+  val initiating_error_handling: unit -> unit
+
+  (* Resuming error handling *)
+
+  val resuming_error_handling: unit -> unit
+
+  (* Handling error in state <state> *)
+
+  val handling_error: state -> unit
+
+end
+
+(* --------------------------------------------------------------------------- *)
+
 (* This signature describes the parameters that must be supplied to the LR
    engine. *)
 
@@ -910,6 +945,16 @@ module type TABLE = sig
     ('env -> 'answer) ->
     'env -> 'answer
 
+  (**[maybe_shift_t s t] determines whether there exists a transition out of
+     the state [s], labeled with the terminal symbol [t], to some state
+     [s']. If so, it returns [Some s']. Otherwise, it returns [None]. *)
+  val maybe_shift_t : state -> terminal -> state option
+
+  (**[may_reduce_prod s t prod] determines whether in the state [s], with
+     lookahead symbol [t], the automaton reduces production [prod]. This test
+     accounts for the possible existence of a default reduction. *)
+  val may_reduce_prod : state -> terminal -> production -> bool
+
   (* This is the automaton's goto table. This table maps a pair of a state
      and a nonterminal symbol to a new state. By extension, it also maps a
      pair of a state and a production to a new state. *)
@@ -925,6 +970,11 @@ module type TABLE = sig
   val       goto_prod: state -> production  -> state
   val maybe_goto_nt:   state -> nonterminal -> state option
 
+  (* [lhs prod] returns the left-hand side of production [prod],
+     a nonterminal symbol. *)
+
+  val lhs: production -> nonterminal
+
   (* [is_start prod] tells whether the production [prod] is a start production. *)
 
   val is_start: production -> bool
@@ -965,51 +1015,17 @@ module type TABLE = sig
 
   val may_reduce: state -> production -> bool
 
-  (* The LR engine requires a number of hooks, which are used for logging. *)
-
-  (* The comments below indicate the conventional messages that correspond
-     to these hooks in the code-based back-end; see [CodeBackend]. *)
-
   (* If the flag [log] is false, then the logging functions are not called.
      If it is [true], then they are called. *)
 
   val log : bool
 
-  module Log : sig
-
-    (* State %d: *)
-
-    val state: state -> unit
-
-    (* Shifting (<terminal>) to state <state> *)
-
-    val shift: terminal -> state -> unit
-
-    (* Reducing a production should be logged either as a reduction
-       event (for regular productions) or as an acceptance event (for
-       start productions). *)
-
-    (* Reducing production <production> / Accepting *)
-
-    val reduce_or_accept: production -> unit
-
-    (* Lookahead token is now <terminal> (<pos>-<pos>) *)
-
-    val lookahead_token: terminal -> Lexing.position -> Lexing.position -> unit
-
-    (* Initiating error handling *)
-
-    val initiating_error_handling: unit -> unit
+  (* The logging hooks required by the LR engine. *)
 
-    (* Resuming error handling *)
-
-    val resuming_error_handling: unit -> unit
-
-    (* Handling error in state <state> *)
-
-    val handling_error: state -> unit
-
-  end
+  module Log : LOG
+    with type state := state
+     and type terminal := terminal
+     and type production := production
 
 end
 
@@ -1102,14 +1118,11 @@ end
 module Engine = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1256,8 +1269,7 @@ module Make (T : TABLE) = struct
 
   (* The following recursive group of functions are tail recursive, produce a
      checkpoint of type [semantic_value checkpoint], and cannot raise an
-     exception. A semantic action can raise [Error], but this exception is
-     immediately caught within [reduce]. *)
+     exception. *)
 
   let rec run env please_discard : semantic_value checkpoint =
 
@@ -1413,33 +1425,22 @@ module Make (T : TABLE) = struct
 
     (* Invoke the semantic action. The semantic action is responsible for
        truncating the stack and pushing a new cell onto the stack, which
-       contains a new semantic value. It can raise [Error]. *)
-
-    (* If the semantic action terminates normally, it returns a new stack,
+       contains a new semantic value. The semantic action returns a new stack,
        which becomes the current stack. *)
 
-    (* If the semantic action raises [Error], we catch it and initiate error
-       handling. *)
-
-    (* This [match/with/exception] construct requires OCaml 4.02. *)
+    let stack = T.semantic_action prod env in
 
-    match T.semantic_action prod env with
-    | stack ->
+    (* By our convention, the semantic action has produced an updated
+       stack. The state now found in the top stack cell is the return
+       state. *)
 
-        (* By our convention, the semantic action has produced an updated
-           stack. The state now found in the top stack cell is the return
-           state. *)
+    (* Perform a goto transition. The target state is determined
+       by consulting the goto table at the return state and at
+       production [prod]. *)
 
-        (* Perform a goto transition. The target state is determined
-           by consulting the goto table at the return state and at
-           production [prod]. *)
-
-        let current = T.goto_prod stack.state prod in
-        let env = { env with stack; current } in
-        run env false
-
-    | exception Error ->
-        initiate env
+    let current = T.goto_prod stack.state prod in
+    let env = { env with stack; current } in
+    run env false
 
   and accept env prod =
     (* Log an accept event. *)
@@ -1618,10 +1619,10 @@ module Make (T : TABLE) = struct
      checkpoint of the form [InputNeeded env]. It checks that [checkpoint] is
      indeed of this form, and invokes [discard]. *)
 
-  (* [resume checkpoint] is invoked by the user in response to a checkpoint of
-     the form [AboutToReduce (env, prod)] or [HandlingError env]. It checks
-     that [checkpoint] is indeed of this form, and invokes [reduce] or
-     [error], as appropriate. *)
+  (* [resume checkpoint] is invoked by the user in response to a checkpoint
+     of the form [Shifting _], [AboutToReduce _], or [HandlingError env]. It
+     checks that [checkpoint] is indeed of this form, and invokes [reduce]
+     or [error], as appropriate. *)
 
   (* In reality, [offer] and [resume] accept an argument of type
      [semantic_value checkpoint] and produce a checkpoint of the same type.
@@ -2063,14 +2064,11 @@ end
 module ErrorReports = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -2229,14 +2227,11 @@ end
 module LexerUtil = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -2280,18 +2275,40 @@ let range ((pos1, pos2) as range) =
     sprintf "File \"%s\", line %d, characters %d-%d:\n"
       file line char1 char2
       (* use [char1 + 1] and [char2 + 1] if *not* using Caml mode *)
+
+let tabulate (type a) (is_eof : a -> bool) (lexer : unit -> a) : unit -> a =
+  (* Read tokens from the lexer until we hit an EOF token. *)
+  let rec read tokens =
+    let token = lexer() in
+    let tokens = token :: tokens in
+    if is_eof token then
+      (* Once done, reverse the list and convert it to an array. *)
+      tokens |> List.rev |> Array.of_list
+    else
+      read tokens
+  in
+  (* We now have an array of tokens. *)
+  let tokens = read [] in
+  (* Define a pseudo-lexer that reads from this array. *)
+  let i = ref 0 in
+  let lexer () =
+    (* If this assertion is violated, then the parser is trying to read
+       past an EOF token. This should not happen. *)
+    assert (!i < Array.length tokens);
+    let token = Array.unsafe_get tokens !i in
+    i := !i + 1;
+    token
+  in
+  lexer
 end
 module Printers = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -2407,14 +2424,11 @@ end
 module InfiniteArray = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -2472,14 +2486,11 @@ end
 module PackedIntArray = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -2681,14 +2692,11 @@ end
 module RowDisplacement = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -2941,14 +2949,11 @@ end
 module LinearizedArray = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -3023,14 +3028,11 @@ end
 module TableFormat = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -3162,14 +3164,11 @@ end
 module InspectionTableFormat = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -3238,14 +3237,11 @@ end
 module InspectionTableInterpreter = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -3549,14 +3545,11 @@ end
 module TableInterpreter = struct
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -3630,9 +3623,12 @@ module MakeEngineTable (T : TableFormat.TABLES) = struct
   let default_reduction state defred nodefred env =
     let code = PackedIntArray.get T.default_reduction state in
     if code = 0 then
+      (* no default reduction *)
       nodefred env
     else
-      defred env (code - 1)
+      (* default reduction *)
+      let prod = code - 1 in
+      defred env prod
 
   let is_start prod =
     prod < T.start
@@ -3666,13 +3662,59 @@ module MakeEngineTable (T : TableFormat.TABLES) = struct
         assert (c = 0);
         fail env
 
+  let maybe_shift_t state terminal =
+    match PackedIntArray.unflatten1 T.error state terminal with
+    | 1 ->
+        let action = unmarshal2 T.action state terminal in
+        let opcode = action land 0b11 in
+        if opcode >= 0b10 then
+          (* 0b10 : shift/discard *)
+          (* 0b11 : shift/nodiscard *)
+          let state' = action lsr 2 in
+          Some state'
+        else
+          (* 0b01 : reduce *)
+          (* 0b00 : cannot happen *)
+          None
+    | c ->
+        assert (c = 0);
+        None
+
+  let may_reduce_prod state terminal prod =
+    let code = PackedIntArray.get T.default_reduction state in
+    if code = 0 then
+      (* no default reduction *)
+      match PackedIntArray.unflatten1 T.error state terminal with
+      | 1 ->
+          let action = unmarshal2 T.action state terminal in
+          let opcode = action land 0b11 in
+          if opcode >= 0b10 then
+            (* 0b10 : shift/discard *)
+            (* 0b11 : shift/nodiscard *)
+            false
+          else
+            (* 0b01 : reduce *)
+            (* 0b00 : cannot happen *)
+            let prod' = action lsr 2 in
+            prod = prod'
+      | c ->
+          assert (c = 0);
+          false
+    else
+      (* default reduction *)
+      let prod' = code - 1 in
+      prod = prod'
+
   let goto_nt state nt =
     let code = unmarshal2 T.goto state nt in
     (* code = 1 + state *)
     code - 1
 
+  let[@inline] lhs prod =
+    PackedIntArray.get T.lhs prod
+
   let goto_prod state prod =
-    goto_nt state (PackedIntArray.get T.lhs prod)
+    goto_nt state (lhs prod)
 
   let maybe_goto_nt state nt =
     let code = unmarshal2 T.goto state nt in
@@ -3792,5 +3834,5 @@ module MakeEngineTable (T : TableFormat.TABLES) = struct
 end
 end
 module StaticVersion = struct
-let require_20210419 = ()
+let require_20231231 = ()
 end

diff --git a/boot/menhir/menhirLib.mli b/boot/menhir/menhirLib.mli
index 9d19a7ca69bff5c66b66a1081bdfde631d8346d3..2156459dc602f5216044b2eea9489467f78a9903 100644 (file)
--- a/boot/menhir/menhirLib.mli
+++ b/boot/menhir/menhirLib.mli
@@ -1,14 +1,11 @@
 module General : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -65,14 +62,11 @@ end
 module Convert : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -144,14 +138,11 @@ end
 module IncrementalEngine : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -232,12 +223,12 @@ module type INCREMENTAL_ENGINE = sig
     'a checkpoint
 
   (* [resume] allows the user to resume the parser after it has suspended
-     itself with a checkpoint of the form [AboutToReduce (env, prod)] or
-     [HandlingError env]. [resume] expects the old checkpoint and produces a
+     itself with a checkpoint of the form [Shifting _], [AboutToReduce _], or
+     [HandlingError _]. [resume] expects the old checkpoint and produces a
      new checkpoint. It does not raise any exception. *)
 
   (* The optional argument [strategy] influences the manner in which [resume]
-     deals with checkpoints of the form [ErrorHandling _]. Its default value
+     deals with checkpoints of the form [HandlingError _]. Its default value
      is [`Legacy]. It can be briefly described as follows:
 
      - If the [error] token is used only to report errors (that is, if the
@@ -633,14 +624,11 @@ end
 module EngineTypes : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -721,6 +709,53 @@ type ('state, 'semantic_value, 'token) env = {
 
 (* --------------------------------------------------------------------------- *)
 
+(* A number of logging hooks are used to (optionally) emit logging messages. *)
+
+(* The comments indicate the conventional messages that correspond
+   to these hooks in the code-based back-end; see [CodeBackend]. *)
+
+module type LOG = sig
+
+  type state
+  type terminal
+  type production
+
+  (* State %d: *)
+
+  val state: state -> unit
+
+  (* Shifting (<terminal>) to state <state> *)
+
+  val shift: terminal -> state -> unit
+
+  (* Reducing a production should be logged either as a reduction
+     event (for regular productions) or as an acceptance event (for
+     start productions). *)
+
+  (* Reducing production <production> / Accepting *)
+
+  val reduce_or_accept: production -> unit
+
+  (* Lookahead token is now <terminal> (<pos>-<pos>) *)
+
+  val lookahead_token: terminal -> Lexing.position -> Lexing.position -> unit
+
+  (* Initiating error handling *)
+
+  val initiating_error_handling: unit -> unit
+
+  (* Resuming error handling *)
+
+  val resuming_error_handling: unit -> unit
+
+  (* Handling error in state <state> *)
+
+  val handling_error: state -> unit
+
+end
+
+(* --------------------------------------------------------------------------- *)
+
 (* This signature describes the parameters that must be supplied to the LR
    engine. *)
 
@@ -842,6 +877,16 @@ module type TABLE = sig
     ('env -> 'answer) ->
     'env -> 'answer
 
+  (**[maybe_shift_t s t] determines whether there exists a transition out of
+     the state [s], labeled with the terminal symbol [t], to some state
+     [s']. If so, it returns [Some s']. Otherwise, it returns [None]. *)
+  val maybe_shift_t : state -> terminal -> state option
+
+  (**[may_reduce_prod s t prod] determines whether in the state [s], with
+     lookahead symbol [t], the automaton reduces production [prod]. This test
+     accounts for the possible existence of a default reduction. *)
+  val may_reduce_prod : state -> terminal -> production -> bool
+
   (* This is the automaton's goto table. This table maps a pair of a state
      and a nonterminal symbol to a new state. By extension, it also maps a
      pair of a state and a production to a new state. *)
@@ -857,6 +902,11 @@ module type TABLE = sig
   val       goto_prod: state -> production  -> state
   val maybe_goto_nt:   state -> nonterminal -> state option
 
+  (* [lhs prod] returns the left-hand side of production [prod],
+     a nonterminal symbol. *)
+
+  val lhs: production -> nonterminal
+
   (* [is_start prod] tells whether the production [prod] is a start production. *)
 
   val is_start: production -> bool
@@ -897,51 +947,17 @@ module type TABLE = sig
 
   val may_reduce: state -> production -> bool
 
-  (* The LR engine requires a number of hooks, which are used for logging. *)
-
-  (* The comments below indicate the conventional messages that correspond
-     to these hooks in the code-based back-end; see [CodeBackend]. *)
-
   (* If the flag [log] is false, then the logging functions are not called.
      If it is [true], then they are called. *)
 
   val log : bool
 
-  module Log : sig
-
-    (* State %d: *)
-
-    val state: state -> unit
-
-    (* Shifting (<terminal>) to state <state> *)
-
-    val shift: terminal -> state -> unit
-
-    (* Reducing a production should be logged either as a reduction
-       event (for regular productions) or as an acceptance event (for
-       start productions). *)
-
-    (* Reducing production <production> / Accepting *)
-
-    val reduce_or_accept: production -> unit
-
-    (* Lookahead token is now <terminal> (<pos>-<pos>) *)
+  (* The logging hooks required by the LR engine. *)
 
-    val lookahead_token: terminal -> Lexing.position -> Lexing.position -> unit
-
-    (* Initiating error handling *)
-
-    val initiating_error_handling: unit -> unit
-
-    (* Resuming error handling *)
-
-    val resuming_error_handling: unit -> unit
-
-    (* Handling error in state <state> *)
-
-    val handling_error: state -> unit
-
-  end
+  module Log : LOG
+    with type state := state
+     and type terminal := terminal
+     and type production := production
 
 end
 
@@ -1034,14 +1050,11 @@ end
 module Engine : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1067,14 +1080,11 @@ end
 module ErrorReports : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1147,57 +1157,61 @@ end
 module LexerUtil : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
 open Lexing
 
-(* [init filename lexbuf] initializes the lexing buffer [lexbuf] so
+(**[init filename lexbuf] initializes the lexing buffer [lexbuf] so
    that the positions that are subsequently read from it refer to the
    file [filename]. It returns [lexbuf]. *)
-
 val init: string -> lexbuf -> lexbuf
 
-(* [read filename] reads the entire contents of the file [filename] and
+(**[read filename] reads the entire contents of the file [filename] and
    returns a pair of this content (a string) and a lexing buffer that
    has been initialized, based on this string. *)
-
 val read: string -> string * lexbuf
 
-(* [newline lexbuf] increments the line counter stored within [lexbuf]. It
+(**[newline lexbuf] increments the line counter stored within [lexbuf]. It
    should be invoked by the lexer itself every time a newline character is
    consumed. This allows maintaining a current the line number in [lexbuf]. *)
-
 val newline: lexbuf -> unit
 
-(* [range (startpos, endpos)] prints a textual description of the range
+(**[range (startpos, endpos)] prints a textual description of the range
    delimited by the start and end positions [startpos] and [endpos].
    This description is one line long and ends in a newline character.
    This description mentions the file name, the line number, and a range
    of characters on this line. The line number is correct only if [newline]
    has been correctly used, as described dabove. *)
-
 val range: position * position -> string
+
+(**[tabulate is_eof lexer] tabulates the lexer [lexer]: that is, it
+   immediately runs this lexer all the way until an EOF token is found, stores
+   the tokens in an array in memory, and returns a new lexer which (when
+   invoked) reads tokens from this array. The function [lexer] is not allowed
+   to raise an exception, and must produce a finite stream of tokens: that is,
+   after a finite number of invocations, it must return a token that is
+   identified by the function [is_eof] as an EOF token.
+
+   Both the existing lexer [lexer] and the new lexer returned by [tabulate
+   is_eof lexer] are functions of type [unit -> 'a], where the type ['a] is
+   likely to be instantiated with a triple of a token and two positions, as
+   per the revised lexer API described in the module {!Convert}. *)
+val tabulate: ('a -> bool) -> (unit -> 'a) -> (unit -> 'a)
 end
 module Printers : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1268,14 +1282,11 @@ end
 module InfiniteArray : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1306,14 +1317,11 @@ end
 module PackedIntArray : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1365,14 +1373,11 @@ end
 module RowDisplacement : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1429,14 +1434,11 @@ end
 module LinearizedArray : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1503,14 +1505,11 @@ end
 module TableFormat : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1642,14 +1641,11 @@ end
 module InspectionTableFormat : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1718,14 +1714,11 @@ end
 module InspectionTableInterpreter : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
-(*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1770,14 +1763,11 @@ end
 module TableInterpreter : sig
 (******************************************************************************)
 (*                                                                            *)
-(*                                   Menhir                                   *)
-(*                                                                            *)
-(*                       François Pottier, Inria Paris                        *)
-(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                    Menhir                                  *)
 (*                                                                            *)
-(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
-(*  terms of the GNU Library General Public License version 2, with a         *)
-(*  special exception on linking, as described in the file LICENSE.           *)
+(*   Copyright Inria. All rights reserved. This file is distributed under     *)
+(*   the terms of the GNU Library General Public License version 2, with a    *)
+(*   special exception on linking, as described in the file LICENSE.          *)
 (*                                                                            *)
 (******************************************************************************)
 
@@ -1803,5 +1793,5 @@ module MakeEngineTable
      and type nonterminal = int
 end
 module StaticVersion : sig
-val require_20210419: unit
+val require_20231231: unit
 end

diff --git a/boot/menhir/parser.ml b/boot/menhir/parser.ml
index c31d5f98e27269491642932c6dba496775290d68..5dc3ac7eda3c5219acef999bd29191963e9c5f84 100644 (file)
--- a/boot/menhir/parser.ml
+++ b/boot/menhir/parser.ml
@@ -2,12 +2,16 @@
 (* This generated code requires the following version of MenhirLib: *)
 
 let () =
-  MenhirLib.StaticVersion.require_20210419
+  MenhirLib.StaticVersion.require_20231231
 
 module MenhirBasics = struct
   
   exception Error = Parsing.Parse_error
   
+  let _eRR =
+    fun _s ->
+      raise Error
+  
   type token = 
     | WITH
     | WHILE
@@ -16,9 +20,9 @@ module MenhirBasics = struct
     | VAL
     | UNDERSCORE
     | UIDENT of (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 22 "parsing/parser.ml"
+# 26 "parsing/parser.ml"
   )
     | TYPE
     | TRY
@@ -28,9 +32,9 @@ module MenhirBasics = struct
     | THEN
     | STRUCT
     | STRING of (
-# 816 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
        (string * Location.t * string option)
-# 34 "parsing/parser.ml"
+# 38 "parsing/parser.ml"
   )
     | STAR
     | SIG
@@ -41,22 +45,22 @@ module MenhirBasics = struct
     | RBRACKET
     | RBRACE
     | QUOTED_STRING_ITEM of (
-# 820 "parsing/parser.mly"
+# 839 "parsing/parser.mly"
        (string * Location.t * string * Location.t * string option)
-# 47 "parsing/parser.ml"
+# 51 "parsing/parser.ml"
   )
     | QUOTED_STRING_EXPR of (
-# 818 "parsing/parser.mly"
+# 837 "parsing/parser.mly"
        (string * Location.t * string * Location.t * string option)
-# 52 "parsing/parser.ml"
+# 56 "parsing/parser.ml"
   )
     | QUOTE
     | QUESTION
     | PRIVATE
     | PREFIXOP of (
-# 802 "parsing/parser.mly"
+# 821 "parsing/parser.mly"
        (string)
-# 60 "parsing/parser.ml"
+# 64 "parsing/parser.ml"
   )
     | PLUSEQ
     | PLUSDOT
@@ -64,9 +68,9 @@ module MenhirBasics = struct
     | PERCENT
     | OR
     | OPTLABEL of (
-# 795 "parsing/parser.mly"
+# 814 "parsing/parser.mly"
        (string)
-# 70 "parsing/parser.ml"
+# 74 "parsing/parser.ml"
   )
     | OPEN
     | OF
@@ -79,17 +83,20 @@ module MenhirBasics = struct
     | MINUSDOT
     | MINUS
     | METHOD
+    | METAOCAML_ESCAPE
+    | METAOCAML_BRACKET_OPEN
+    | METAOCAML_BRACKET_CLOSE
     | MATCH
     | LPAREN
     | LIDENT of (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 88 "parsing/parser.ml"
+# 95 "parsing/parser.ml"
   )
     | LETOP of (
-# 760 "parsing/parser.mly"
+# 779 "parsing/parser.mly"
        (string)
-# 93 "parsing/parser.ml"
+# 100 "parsing/parser.ml"
   )
     | LET
     | LESSMINUS
@@ -107,49 +114,49 @@ module MenhirBasics = struct
     | LBRACE
     | LAZY
     | LABEL of (
-# 765 "parsing/parser.mly"
+# 784 "parsing/parser.mly"
        (string)
-# 113 "parsing/parser.ml"
+# 120 "parsing/parser.ml"
   )
     | INT of (
-# 764 "parsing/parser.mly"
+# 783 "parsing/parser.mly"
        (string * char option)
-# 118 "parsing/parser.ml"
+# 125 "parsing/parser.ml"
   )
     | INITIALIZER
     | INHERIT
     | INFIXOP4 of (
-# 758 "parsing/parser.mly"
+# 777 "parsing/parser.mly"
        (string)
-# 125 "parsing/parser.ml"
+# 132 "parsing/parser.ml"
   )
     | INFIXOP3 of (
-# 757 "parsing/parser.mly"
+# 776 "parsing/parser.mly"
        (string)
-# 130 "parsing/parser.ml"
+# 137 "parsing/parser.ml"
   )
     | INFIXOP2 of (
-# 756 "parsing/parser.mly"
+# 775 "parsing/parser.mly"
        (string)
-# 135 "parsing/parser.ml"
+# 142 "parsing/parser.ml"
   )
     | INFIXOP1 of (
-# 755 "parsing/parser.mly"
+# 774 "parsing/parser.mly"
        (string)
-# 140 "parsing/parser.ml"
+# 147 "parsing/parser.ml"
   )
     | INFIXOP0 of (
-# 754 "parsing/parser.mly"
+# 773 "parsing/parser.mly"
        (string)
-# 145 "parsing/parser.ml"
+# 152 "parsing/parser.ml"
   )
     | INCLUDE
     | IN
     | IF
     | HASHOP of (
-# 813 "parsing/parser.mly"
+# 832 "parsing/parser.mly"
        (string)
-# 153 "parsing/parser.ml"
+# 160 "parsing/parser.ml"
   )
     | HASH
     | GREATERRBRACKET
@@ -160,9 +167,9 @@ module MenhirBasics = struct
     | FUN
     | FOR
     | FLOAT of (
-# 743 "parsing/parser.mly"
+# 762 "parsing/parser.mly"
        (string * char option)
-# 166 "parsing/parser.ml"
+# 173 "parsing/parser.ml"
   )
     | FALSE
     | EXTERNAL
@@ -172,26 +179,27 @@ module MenhirBasics = struct
     | EOF
     | END
     | ELSE
+    | EFFECT
     | DOWNTO
     | DOTOP of (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 180 "parsing/parser.ml"
+# 188 "parsing/parser.ml"
   )
     | DOTDOT
     | DOT
     | DONE
     | DOCSTRING of (
-# 837 "parsing/parser.mly"
+# 856 "parsing/parser.mly"
        (Docstrings.docstring)
-# 188 "parsing/parser.ml"
+# 196 "parsing/parser.ml"
   )
     | DO
     | CONSTRAINT
     | COMMENT of (
-# 836 "parsing/parser.mly"
+# 855 "parsing/parser.mly"
        (string * Location.t)
-# 195 "parsing/parser.ml"
+# 203 "parsing/parser.ml"
   )
     | COMMA
     | COLONGREATER
@@ -200,9 +208,9 @@ module MenhirBasics = struct
     | COLON
     | CLASS
     | CHAR of (
-# 723 "parsing/parser.mly"
+# 741 "parsing/parser.mly"
        (char)
-# 206 "parsing/parser.ml"
+# 214 "parsing/parser.ml"
   )
     | BEGIN
     | BARRBRACKET
@@ -213,9 +221,9 @@ module MenhirBasics = struct
     | ASSERT
     | AS
     | ANDOP of (
-# 761 "parsing/parser.mly"
+# 780 "parsing/parser.mly"
        (string)
-# 219 "parsing/parser.ml"
+# 227 "parsing/parser.ml"
   )
     | AND
     | AMPERSAND
@@ -225,9 +233,6 @@ end
 
 include MenhirBasics
 
-let _eRR =
-  MenhirBasics.Error
-
 # 25 "parsing/parser.mly"
   
 
@@ -265,6 +270,7 @@ let mkmod ~loc ?attrs d = Mod.mk ~loc:(make_loc loc) ?attrs d
 let mkstr ~loc d = Str.mk ~loc:(make_loc loc) d
 let mkclass ~loc ?attrs d = Cl.mk ~loc:(make_loc loc) ?attrs d
 let mkcty ~loc ?attrs d = Cty.mk ~loc:(make_loc loc) ?attrs d
+let mkconst ~loc c = Const.mk ~loc:(make_loc loc) c
 
 let pstr_typext (te, ext) =
   (Pstr_typext te, ext)
@@ -357,20 +363,31 @@ let neg_string f =
   then String.sub f 1 (String.length f - 1)
   else "-" ^ f
 
-let mkuminus ~oploc name arg =
-  match name, arg.pexp_desc with
-  | "-", Pexp_constant(Pconst_integer (n,m)) ->
-      Pexp_constant(Pconst_integer(neg_string n,m))
-  | ("-" | "-."), Pexp_constant(Pconst_float (f, m)) ->
-      Pexp_constant(Pconst_float(neg_string f, m))
+(* Pre-apply the special [-], [-.], [+] and [+.] prefix operators into
+   constants if possible, otherwise turn them into the corresponding prefix
+   operators [~-], [~-.], etc.. *)
+let mkuminus ~sloc ~oploc name arg =
+  match name, arg.pexp_desc, arg.pexp_attributes with
+  | "-",
+    Pexp_constant({pconst_desc = Pconst_integer (n,m); pconst_loc=_}),
+    [] ->
+      Pexp_constant(mkconst ~loc:sloc (Pconst_integer(neg_string n, m)))
+  | ("-" | "-."),
+    Pexp_constant({pconst_desc = Pconst_float (f, m); pconst_loc=_}), [] ->
+      Pexp_constant(mkconst ~loc:sloc (Pconst_float(neg_string f, m)))
   | _ ->
       Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
 
-let mkuplus ~oploc name arg =
+let mkuplus ~sloc ~oploc name arg =
   let desc = arg.pexp_desc in
-  match name, desc with
-  | "+", Pexp_constant(Pconst_integer _)
-  | ("+" | "+."), Pexp_constant(Pconst_float _) -> desc
+  match name, desc, arg.pexp_attributes with
+  | "+",
+    Pexp_constant({pconst_desc = Pconst_integer _ as desc; pconst_loc=_}),
+    []
+  | ("+" | "+."),
+    Pexp_constant({pconst_desc = Pconst_float _ as desc; pconst_loc=_}),
+    [] ->
+      Pexp_constant(mkconst ~loc:sloc desc)
   | _ ->
       Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
 
@@ -685,7 +702,8 @@ let wrap_mksig_ext ~loc (item, ext) =
 
 let mk_quotedext ~loc (id, idloc, str, strloc, delim) =
   let exp_id = mkloc id idloc in
-  let e = ghexp ~loc (Pexp_constant (Pconst_string (str, strloc, delim))) in
+  let const = Const.mk ~loc:strloc (Pconst_string (str, strloc, delim)) in
+  let e = ghexp ~loc (Pexp_constant const) in
   (exp_id, PStr [mkstrexp e []])
 
 let text_str pos = Str.text (rhs_text pos)
@@ -855,6 +873,11 @@ let mkfunction params body_constraint body =
       | Some newtypes ->
           mkghost_newtype_function_body newtypes body_constraint body_exp
 
+let mk_functor_typ args mty =
+  List.fold_left (fun acc (startpos, arg) ->
+      mkmty ~loc:(startpos, mty.pmty_loc.loc_end) (Pmty_functor (arg, acc)))
+    mty args
+
 (* Alternatively, we could keep the generic module type in the Parsetree
    and extract the package type during type-checking. In that case,
    the assertions below should be turned into explicit checks. *)
@@ -904,7 +927,7 @@ let mk_directive ~loc name arg =
     }
 
 
-# 908 "parsing/parser.ml"
+# 931 "parsing/parser.ml"
 
 module Tables = struct
   
@@ -914,158 +937,166 @@ module Tables = struct
     fun _tok ->
       match _tok with
       | AMPERAMPER ->
-          123
+          127
       | AMPERSAND ->
-          122
+          126
       | AND ->
-          121
+          125
       | ANDOP _ ->
-          120
+          124
       | AS ->
-          119
+          123
       | ASSERT ->
-          118
+          122
       | BACKQUOTE ->
-          117
+          121
       | BANG ->
-          116
+          120
       | BAR ->
-          115
+          119
       | BARBAR ->
-          114
+          118
       | BARRBRACKET ->
-          113
+          117
       | BEGIN ->
-          112
+          116
       | CHAR _ ->
-          111
+          115
       | CLASS ->
-          110
+          114
       | COLON ->
-          109
+          113
       | COLONCOLON ->
-          108
+          112
       | COLONEQUAL ->
-          107
+          111
       | COLONGREATER ->
-          106
+          110
       | COMMA ->
-          105
+          109
       | COMMENT _ ->
-          104
+          108
       | CONSTRAINT ->
-          103
+          107
       | DO ->
-          102
+          106
       | DOCSTRING _ ->
-          101
+          105
       | DONE ->
-          100
+          104
       | DOT ->
-          99
+          103
       | DOTDOT ->
-          98
+          102
       | DOTOP _ ->
-          97
+          101
       | DOWNTO ->
-          96
+          100
+      | EFFECT ->
+          99
       | ELSE ->
-          95
+          98
       | END ->
-          94
+          97
       | EOF ->
-          93
+          96
       | EOL ->
-          92
+          95
       | EQUAL ->
-          91
+          94
       | EXCEPTION ->
-          90
+          93
       | EXTERNAL ->
-          89
+          92
       | FALSE ->
-          88
+          91
       | FLOAT _ ->
-          87
+          90
       | FOR ->
-          86
+          89
       | FUN ->
-          85
+          88
       | FUNCTION ->
-          84
+          87
       | FUNCTOR ->
-          83
+          86
       | GREATER ->
-          82
+          85
       | GREATERRBRACE ->
-          81
+          84
       | GREATERRBRACKET ->
-          80
+          83
       | HASH ->
-          79
+          82
       | HASHOP _ ->
-          78
+          81
       | IF ->
-          77
+          80
       | IN ->
-          76
+          79
       | INCLUDE ->
-          75
+          78
       | INFIXOP0 _ ->
-          74
+          77
       | INFIXOP1 _ ->
-          73
+          76
       | INFIXOP2 _ ->
-          72
+          75
       | INFIXOP3 _ ->
-          71
+          74
       | INFIXOP4 _ ->
-          70
+          73
       | INHERIT ->
-          69
+          72
       | INITIALIZER ->
-          68
+          71
       | INT _ ->
-          67
+          70
       | LABEL _ ->
-          66
+          69
       | LAZY ->
-          65
+          68
       | LBRACE ->
-          64
+          67
       | LBRACELESS ->
-          63
+          66
       | LBRACKET ->
-          62
+          65
       | LBRACKETAT ->
-          61
+          64
       | LBRACKETATAT ->
-          60
+          63
       | LBRACKETATATAT ->
-          59
+          62
       | LBRACKETBAR ->
-          58
+          61
       | LBRACKETGREATER ->
-          57
+          60
       | LBRACKETLESS ->
-          56
+          59
       | LBRACKETPERCENT ->
-          55
+          58
       | LBRACKETPERCENTPERCENT ->
-          54
+          57
       | LESS ->
-          53
+          56
       | LESSMINUS ->
-          52
+          55
       | LET ->
-          51
+          54
       | LETOP _ ->
-          50
+          53
       | LIDENT _ ->
-          49
+          52
       | LPAREN ->
-          48
+          51
       | MATCH ->
+          50
+      | METAOCAML_BRACKET_CLOSE ->
+          49
+      | METAOCAML_BRACKET_OPEN ->
+          48
+      | METAOCAML_ESCAPE ->
           47
       | METHOD ->
           46
@@ -1222,6 +1253,8 @@ module Tables = struct
           Obj.repr _v
       | DOWNTO ->
           Obj.repr ()
+      | EFFECT ->
+          Obj.repr ()
       | ELSE ->
           Obj.repr ()
       | END ->
@@ -1320,6 +1353,12 @@ module Tables = struct
           Obj.repr ()
       | MATCH ->
           Obj.repr ()
+      | METAOCAML_BRACKET_CLOSE ->
+          Obj.repr ()
+      | METAOCAML_BRACKET_OPEN ->
+          Obj.repr ()
+      | METAOCAML_ESCAPE ->
+          Obj.repr ()
       | METHOD ->
           Obj.repr ()
       | MINUS ->
@@ -1414,22 +1453,22 @@ module Tables = struct
           Obj.repr ()
   
   and default_reduction =
-    (16, "\000\000\000\000\000\000\003I\003H\003G\003F\003E\003\024\003D\003C\003B\003A\003@\003?\003>\003=\003<\003;\003:\0039\0038\0037\0036\0035\0034\0033\0032\003\023\0031\0030\003/\003.\003-\003,\003+\003*\003)\003(\003'\003&\003%\003$\003#\003\"\003!\003 \003\031\003\030\003\029\003\028\003\027\003\026\003\025\000\000\000\000\000\"\000\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\141\001\227\001\206\001\224\001\223\001\222\001\228\001\232\000\000\003\142\001\226\001\225\001\207\001\230\001\221\001\220\001\219\001\218\001\217\001\215\001\231\001\229\000\000\000\000\000\000\001\011\000\000\000\000\001\210\000\000\000\000\000\000\001\212\000\000\000\000\000\000\001\214\001\236\001\233\001\216\001\208\001\234\001\235\000\000\003\140\003\139\003\143\000\000\000\000\000 \001u\000\132\000\000\001\007\001\b\000\000\000\000\000\000\002\005\002\004\000\000\000\000\000\031\000\000\000\000\000\000\000\000\000\000\001\160\000\000\000\000\000\000\000\000\000\000\003\136\000\000\003\131\000\000\000\000\003\133\000\000\003\135\000\000\003\132\003\134\000\000\003~\000\000\003}\003y\002|\000\000\003|\000\000\002}\000\000\000\000\000\000\000\000\000c\000\000\000\000\000a\000\000\000\000\001s\000\000\000\000\000\000\000\000\000\000\000\237\001\129\000\000\000\000\000\000\000\000\000\000\000\000\002e\000\000\000\000\000\000\000\000\000\000\000\000\000^\000\000\000\000\000\000\000\000\000\000\003\005\000\000\002\181\002\182\000\000\002\179\002\180\000\000\000\000\000\000\000\000\000\000\001\155\001\154\000\000\003\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\014\000\017\000\016\000\000\000\000\000\000\000\000\000\000\001\146\000\000\000\000\000\000\000\000\000\000\000\000\001\127\000\000\000\000\001\130\001\128\001\136\000:\002\214\000\000\001E\003a\003`\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\000\001\022\000\000\002\184\002\183\000\000\000\000\000\000\001\240\000\000\000\000\000|\000\000\000\000\000\000\000\000\000\000\001\135\000\000\001\134\000\000\001v\001\133\000\000\001t\000[\000\027\000\000\000\000\001\181\000\024\000\000\000\000\000\000\000\000\000s\000\000\000\000\000\000\000\000\000\000\000\000\003x\000\246\000t\000\135\000u\000\023\000\000\000\000\000\000\000\000\000\028\000\025\000\018\000\000\000v\000r\000\000\000\000\000\000\000\019\000\030\000\000\000\248\002\138\002x\000\000\000y\000\000\002y\000\000\000\000\001\237\000\000\000\000\000\000\000\000\003b\000\000\003c\000\000\000\000\000x\000\000\000\000\000\000\000z\000\000\000{\000\000\000}\000\000\000\000\000~\002n\002m\000\000\000\000\000\000\000\000\000\000\000\000\000\\\000\000\003\n\000_\000b\000]\002\255\003\144\003\000\0027\003\002\000\000\000\000\003\007\002\178\003\t\000\000\000\000\000\000\003\016\003\r\000\000\000\000\000\000\0023\002%\000\000\000\000\000\000\000\000\002)\000\000\002$\000\000\0026\003\022\000\000\000\000\000\000\000\000\001\183\000\000\000\000\0025\003\b\000j\000\000\000\000\000i\000\000\003\017\003\001\000\000\002/\000\000\000\000\003\020\000\000\003\019\003\018\000\000\002+\000\000\000\000\002'\002&\0024\002,\000\000\000h\000\000\003\015\003\014\000\000\003\012\000\000\002\186\002\185\000\000\000\000\002\151\003\011\000\000\000\000\000\000\000\000\001\242\001`\001a\002\188\000\000\002\189\002\187\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\166\000\000\000\000\000\000\000\000\000\000\000\000\003\167\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003{\000\000\000\000\000\000\000\000\000\000\001\165\000\000\000\000\000\000\001~\001\173\001}\001\170\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002v\000\000\000\000\002w\002j\002i\000\000\000\000\001\164\001\163\000\000\000\250\000\000\000\000\001\148\000\000\000\000\001\152\000\000\002\t\002\b\000\000\000\000\002\007\002\006\001\151\001\149\000\000\001\153\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\220\001\131\002\225\002\223\000\000\000\000\000\000\002\236\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\254\000\000\002\253\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002B\000\000\000\000\000\000\000\000\000\000\000\000\001\031\002A\001 \000\000\000\000\000\000\000\238\000\000\001#\001$\000\000\000\239\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002s\002q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\207\000\000\000\000\000\000\000\000\000\000\003u\000\000\000\000\003t\000\000\000\000\000\000\000\000\001\026\001\025\000\000\001\027\000\000\000\000\000\000\002\233\000\000\000\000\000\000\002\202\002\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\145\002\235\002\222\002\221\000\000\000\000\000\210\002\155\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\236\000\000\000\000\000\000\000\000\000\000\000\000\000\209\000\208\000\000\000\000\000\000\000\244\000\243\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003L\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\002p\000\000\000\000\000\000\001)\000\000\000\000\001(\001'\000\000\002\003\000\000\000\000\000\140\003M\002g\000\000\000\000\000\000\000\000\001,\000\000\000\000\001+\000\000\0022\000\000\000\000\002>\000\000\000\000\002@\000\000\000\000\002<\002;\0029\002:\000\000\000\000\000\000\001%\000\000\000\000\001K\000\020\001.\000\000\000\000\000\000\002\204\002\195\000\000\000\000\002\203\002\194\000\000\000\000\000\000\000\000\002\206\002\197\000\000\000\000\002\144\000\000\000\000\002\210\002\201\000\000\000\000\002\208\002\199\002\229\000\000\000\000\000\000\000\000\000\000\002\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\002k\000\206\002\145\000\000\002\196\000\000\000\000\002\200\000\000\000\000\002\198\000\000\000\127\000\128\000\000\000\000\000\000\000\000\000\159\000\158\000\000\000\146\000\000\000\000\001c\000\000\001d\001b\002r\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0016\000\000\000\000\0017\000\000\000\000\000\211\000\000\0019\0018\000\000\000\000\002\237\002\230\000\000\002\246\000\000\002\247\002\245\000\000\002\251\000\000\002\252\002\250\000\000\000\000\002\232\002\231\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\002\154\002W\000\000\002\241\002\240\000\000\000\000\000\000\001\132\000\000\002\212\000\000\002\213\002\211\000\000\002\239\002\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\148\002\228\000\000\002\227\002\226\000\000\002\249\002\248\000\145\000\000\000\000\000\000\000\000\000\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\138\000\000\000\000\000\000\000\000\000\000\000\142\000\000\001\140\000\000\000\000\000\000\000d\000\000\000\000\000e\000\000\000\000\000\000\000\000\001\175\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000n\000\000\001\019\001\017\000\000\000\000\000\000\000\252\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\143\000f\000\000\000\000\002V\000\000\000\000\001-\002\001\000\000\001\029\001\030\0014\000\000\000\000\000\000\000\000\000\000\002\244\000\000\002\243\002\242\002\224\000\000\000\000\000\000\000\000\002\215\000\000\002\217\000\000\002\216\000\000\002\191\002\190\000\000\002\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\023\002\011\000\000\002\021\000\000\002\017\000\000\002\019\000\000\002\r\000\000\000\000\002\015\000\000\002\022\002\n\000\000\002\020\000\000\002\016\000\000\002\018\000\000\002\012\000\000\000\000\002\014\000\000\001\203\000\000\000\000\000\000\001\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\171\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001A\003Z\000\000\000\000\003Y\000\000\000\000\000\000\000\000\000\000\002G\000\000\000\000\000\000\000\000\000\000\000\000\003_\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\185\000\000\002M\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003K\000\000\000\000\002\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\205\000\000\000\000\000\000\001\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\172\000\000\000\000\000\000\000\000\001\157\000\000\001\156\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001C\002\171\000\000\000\000\001\142\000\000\002\169\000\000\000\000\000\000\002\168\000\000\000\000\001\143\000\000\000\000\000\000\000\000\002\175\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\153\000\000\000\000\000\000\000\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\001\180\000\000\001\179\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\002T\000\000\002S\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000G\000\000\000\000\000\000\000H\000F\000\000\000K\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000C\000\000\000J\000I\000\000\000D\000E\000\000\001T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001?\000Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000W\000\000\000Y\000X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001=\002\176\002\161\000\000\002\167\002\162\002\174\002\173\002\172\002\170\001N\000\000\002\159\000\000\000\000\000\000\000\000\000\000\002e\000\000\000\000\001G\002\163\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\196\001\192\000\000\000\000\000\000\001\001\000\000\000\000\002[\002e\000\000\000\000\001I\002Y\002Z\000\000\000\000\000\000\000\000\000\000\001\199\001\195\001\191\000\000\000\000\001\002\000\000\000\000\001\198\001\194\001\190\001\188\002\164\002\160\002\177\001M\002D\002\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\148\000\000\000\000\003\150\000\000\000/\000\000\000\000\003\156\000\000\003\155\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\147\000\000\000\000\003\149\000\000\000\000\000\000\002O\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001r\000\000\000\000\001p\001n\000\000\0000\000\000\000\000\003\159\000\000\003\158\000\000\000\000\000\000\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001q\000\000\000\000\001o\001m\000\000\000\000\000\000\0002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Q\000\000\000\000\000\000\000\000\000\000\000\000\000,\000\000\000\000\000P\000\000\000*\0011\000\000\0009\000&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001/\000\000\000O\000N\000\000\000\000\000T\000S\000\000\000\000\001\244\000\000\000.\000\000\000\000\000\000\000-\000\000\000\000\000\000\0001\000\000\000R\000U\000\000\0003\0004\000\000\001V\000\000\000\000\000\000\000\000\000\000\000\000\0007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001;\003]\003T\000\000\000\000\003X\003J\003S\003\\\003[\001R\000\000\000\000\003Q\000\000\003U\003R\003^\002C\000\000\000\000\003O\000#\003N\000\000\000\000\000\136\000\000\001\r\000\000\000\000\001Q\001P\000\000\001\145\001\144\000\000\000\000\003\021\003\004\000\000\000;\000\000\000\000\000<\000\000\000\000\002\219\002\218\000\000\000\000\000\149\000\000\000\000\002L\001\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\000\000\003W\002`\002a\002\\\002^\002]\002_\000\000\000\000\000\000\000\134\000\000\000\000\002e\000\000\001\005\000\000\000\000\000\000\000\000\003V\000\000\000\131\000\000\000\000\000\000\000\000\001k\001e\000\000\000\000\001f\001\201\000\000\001\200\000\000\000\000\000\247\000\000\000\000\000\000\000\029\000\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\197\001\193\000\000\001\189\003w\000\000\002e\000\000\001\004\000\000\000\000\000\000\000\000\002\166\002d\002b\002c\000\000\000\000\000\000\002e\000\000\001\003\000\000\000\000\000\000\000\000\002\165\000\000\001\159\001\158\000\000\000w\000\000\003\151\000\000\000$\000\000\000\000\000\000\000\000\000\157\000\156\000\000\001\t\000\001\000\000\000\000\001\012\000\002\000\000\000\000\000\000\001x\001y\000\003\000\000\000\000\000\000\000\000\001{\001|\001z\000\021\001w\000\022\000\000\002\024\000\000\000\004\000\000\002\025\000\000\000\005\000\000\002\026\000\000\000\000\002\027\000\006\000\000\000\007\000\000\002\028\000\000\000\b\000\000\002\029\000\000\000\t\000\000\002\030\000\000\000\n\000\000\002\031\000\000\000\011\000\000\002 \000\000\000\000\002!\000\012\000\000\000\000\002\"\000\r\000\000\000\000\000\000\000\000\000\000\003j\003e\003f\003i\003g\000\000\003n\000\014\000\000\003m\000\000\001X\000\000\000\000\003k\000\000\003l\000\000\000\000\000\000\000\000\001\\\001]\000\000\000\000\001[\001Z\000\015\000\000\000\000\000\000\003\138\000\000\003\137")
+    (16, "\000\000\000\000\000\000\003L\003K\003J\003I\003H\003\027\003G\003F\003E\003D\003C\003B\003A\003@\003?\003>\003=\003<\003;\003:\0039\0038\0037\0036\0035\003\026\0034\0033\0032\0031\0030\003/\003.\003-\003,\003+\003*\003)\003(\003'\003&\003%\003$\003#\003\"\003!\003 \003\031\003\030\003\029\003\028\000\000\000\000\000\"\000\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\144\001\227\001\206\001\224\001\223\001\222\001\228\001\232\000\000\003\145\001\226\001\225\001\207\001\230\001\221\001\220\001\219\001\218\001\217\001\215\001\231\001\229\000\000\000\000\000\000\001\011\000\000\000\000\001\210\000\000\000\000\000\000\001\212\000\000\000\000\000\000\001\214\001\236\001\233\001\216\001\208\001\234\001\235\000\000\003\143\003\142\003\146\000\000\000\000\000 \001u\000\132\000\000\001\007\001\b\000\000\000\000\000\000\002\005\002\004\000\000\000\000\000\031\000\000\000\000\000\000\000\000\000\000\001\160\000\000\000\000\000\000\000\000\000\000\003\139\000\000\003\134\000\000\000\000\003\136\000\000\003\138\000\000\003\135\003\137\000\000\003\129\000\000\003\128\003|\002}\000\000\003\127\000\000\002~\000\000\000\000\000\000\000\000\000c\000\000\000\000\000a\000\000\000\000\001s\000\000\000\000\000\000\000\000\000\000\000\237\001\129\000\000\000\000\000\000\000\000\000\000\000\000\002f\000\000\000\000\000\000\000\000\000\000\000\000\000^\000\000\000\000\000\000\000\000\000\000\003\b\000\000\002\182\002\183\000\000\002\180\002\181\000\000\000\000\000\000\000\000\000\000\001\155\001\154\000\000\003\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\014\000\017\000\016\000\000\000\000\000\000\000\000\000\000\001\146\000\000\000\000\000\000\000\000\000\000\000\000\001\127\000\000\000\000\001\130\001\128\001\136\000:\002\217\000\000\001E\003d\003c\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000`\000\000\001\022\000\000\002\185\002\184\000\000\000\000\000\000\001\240\000\000\000\000\000|\000\000\000\000\000\000\000\000\000\000\001\135\000\000\001\134\000\000\001v\001\133\000\000\001t\000[\000\027\000\000\000\000\001\181\000\024\000\000\000\000\000\000\000\000\000s\000\000\000\000\000\000\000\000\000\000\000\000\003{\000\246\000t\000\135\000u\000\023\000\000\000\000\000\000\000\000\000\028\000\025\000\018\000\000\000v\000r\000\000\000\000\000\000\000\019\000\030\000\000\000\248\002\139\002y\000\000\000y\000\000\002z\000\000\000\000\001\237\000\000\000\000\000\000\000\000\003e\000\000\003f\000\000\000\000\000x\000\000\000\000\000\000\000z\000\000\000{\000\000\000}\000\000\000\000\000~\002o\002n\000\000\000\000\000\000\000\000\000\000\000\000\000\\\000\000\003\r\000_\000b\000]\003\002\003\147\003\003\0028\003\005\000\000\000\000\003\n\002\179\003\012\000\000\000\000\000\000\003\019\003\016\000\000\000\000\000\000\000\000\0024\000\000\000\000\002-\003\025\003\011\000j\000\000\002%\000\000\000\000\000\000\000\000\002)\000\000\002$\000\000\000\000\000\000\000\000\001\183\000\000\000\000\0026\000\000\000\000\000i\000\000\003\020\003\004\000\000\0020\000\000\000\000\003\023\000\000\003\022\003\021\000\000\002+\000\000\000\000\002'\002&\0025\0027\002,\000\000\000h\000\000\003\018\003\017\000\000\003\015\000\000\002\187\002\186\000\000\000\000\002\152\003\014\000\000\000\000\000\000\000\000\001\242\001`\001a\002\189\000\000\002\190\002\188\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\167\000\000\000\000\000\000\000\000\000\000\000\000\003\170\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003~\000\000\000\000\000\000\000\000\000\000\001\166\000\000\000\000\000\000\001~\001\173\001}\002j\001\170\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002w\000\000\000\000\002x\002k\000\000\000\000\001\165\001\164\000\000\000\250\000\000\000\000\001\148\000\000\000\000\001\152\000\000\002\t\002\b\000\000\000\000\002\007\002\006\001\151\001\149\000\000\001\153\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\223\001\131\002\228\002\226\000\000\000\000\000\000\002\239\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\001\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002C\000\000\000\000\000\000\000\000\000\000\000\000\001\031\002B\001 \000\000\000\000\000\000\000\238\000\000\001#\001$\000\000\000\239\002i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002t\002r\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\207\000\000\000\000\000\000\000\000\000\000\003x\000\000\000\000\003w\000\000\000\000\000\000\000\000\001\026\001\025\000\000\001\027\000\000\000\000\000\000\002\236\000\000\000\000\000\000\002\203\002\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\148\002\238\002\225\002\224\000\000\000\000\000\210\002\156\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\236\000\000\000\000\000\000\000\000\000\000\000\000\000\209\000\208\000\000\000\000\000\000\000\244\000\243\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003O\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\002q\000\000\000\000\000\000\001)\000\000\000\000\001(\001'\000\000\002\003\000\000\000\000\000\140\003P\002h\000\000\000\000\000\000\000\000\001,\000\000\000\000\001+\000\000\0023\000\000\000\000\002?\000\000\000\000\002A\000\000\000\000\002=\002<\002:\002;\000\000\000\000\000\000\001%\000\000\000\000\001K\000\020\001.\000\000\000\000\000\000\002\205\002\196\000\000\000\000\002\204\002\195\000\000\000\000\000\000\000\000\002\207\002\198\000\000\000\000\002\145\000\000\000\000\002\211\002\202\000\000\000\000\002\209\002\200\002\232\000\000\000\000\000\000\000\000\000\000\002\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\210\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002m\002l\000\206\002\146\000\000\002\197\000\000\000\000\002\201\000\000\000\000\002\199\000\000\000\127\000\128\000\000\000\000\000\000\000\000\000\159\000\158\000\000\000\146\000\000\000\000\001c\000\000\001d\001b\002s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0016\000\000\000\000\0017\000\000\000\000\000\211\000\000\0019\0018\000\000\000\000\002\240\002\233\000\000\002\249\000\000\002\250\002\248\000\000\002\254\000\000\002\255\002\253\000\000\000\000\002\235\002\234\000\000\000\000\000\000\002Y\000\000\000\000\000\000\000\000\002\155\002X\000\000\002\244\002\243\000\000\000\000\000\000\001\132\000\000\002\215\000\000\002\216\002\214\000\000\002\242\002\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\231\000\000\002\230\002\229\000\000\002\252\002\251\000\145\000\000\000\000\000\000\000\000\000\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\138\000\000\000\000\000\000\000\000\000\000\000\142\000\000\001\140\000\000\000\000\000\000\000d\000\000\000\000\000e\000\000\000\000\000\000\000\000\001\175\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000n\000\000\001\019\001\017\000\000\000\000\000\000\000\252\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\143\000f\000\000\000\000\002W\000\000\000\000\001-\002\001\000\000\001\029\001\030\0014\000\000\000\000\000\000\000\000\000\000\002\247\000\000\002\246\002\245\002\227\000\000\000\000\000\000\000\000\002\218\000\000\002\220\000\000\002\219\000\000\002\192\002\191\000\000\002\193\000\000\000\000\000\000\000\000\002\213\002\212\000\000\000\000\000\000\000\000\002\023\002\011\000\000\002\021\000\000\002\017\000\000\002\019\000\000\002\r\000\000\000\000\002\015\000\000\002\022\002\n\000\000\002\020\000\000\002\016\000\000\002\018\000\000\002\012\000\000\000\000\002\014\000\000\001\203\000\000\000\000\000\000\001\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\171\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001A\003]\000\000\000\000\003\\\000\000\000\000\000\000\000\000\000\000\002H\000\000\000\000\000\000\000\000\000\000\000\000\003b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\185\000\000\002N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003N\000\000\000\000\002\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\205\000\000\000\000\000\000\001\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\172\000\000\000\000\000\000\000\000\001\157\000\000\001\156\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001C\002\172\000\000\000\000\001\142\000\000\002\170\000\000\000\000\000\000\002\169\000\000\000\000\001\143\000\000\000\000\000\000\000\000\002\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\156\000\000\000\000\000\000\000\138\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\001\180\000\000\001\179\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\002U\000\000\002T\000\000\000\000\000\000\000\000\000B\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000G\000\000\000\000\000\000\000H\000F\000\000\000K\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000C\000\000\000J\000I\000\000\000D\000E\000\000\001T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001?\000Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000W\000\000\000Y\000X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001=\002\177\002\162\000\000\002\168\002\163\002\175\002\174\002\173\002\171\001N\000\000\002\160\000\000\000\000\000\000\000\000\000\000\002f\000\000\000\000\001G\002\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\196\001\192\000\000\000\000\000\000\001\001\000\000\000\000\002\\\002f\000\000\000\000\001I\002Z\002[\000\000\000\000\000\000\000\000\000\000\001\199\001\195\001\191\000\000\000\000\001\002\000\000\000\000\001\198\001\194\001\190\001\188\002\165\002\161\002\178\001M\002E\002\159\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\151\000\000\000\000\003\153\000\000\000/\000\000\000\000\003\159\000\000\003\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\150\000\000\000\000\003\152\000\000\000\000\000\000\002P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001r\000\000\000\000\001p\001n\000\000\0000\000\000\000\000\003\162\000\000\003\161\000\000\000\000\000\000\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001q\000\000\000\000\001o\001m\000\000\000\000\000\000\0002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Q\000\000\000\000\000\000\000\000\000\000\000\000\000,\000\000\000\000\000P\000\000\000*\0011\000\000\0009\000&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001/\000\000\000O\000N\000\000\000\000\000T\000S\000\000\000\000\001\244\000\000\000.\000\000\000\000\000\000\000-\000\000\000\000\000\000\0001\000\000\000R\000U\000\000\0003\0004\000\000\001V\000\000\000\000\000\000\000\000\000\000\000\000\0007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001;\003`\003W\000\000\000\000\003[\003M\003V\003_\003^\001R\000\000\000\000\003T\000\000\003X\003U\003a\002D\000\000\000\000\003R\000#\003Q\000\000\000\000\000\136\000\000\001\r\000\000\000\000\001Q\001P\000\000\001\145\001\144\000\000\000\000\003\024\003\007\000\000\000;\000\000\000\000\000<\000\000\000\000\002\222\002\221\000\000\000\000\000\149\000\000\000\000\002M\001\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\000\000\003Z\002a\002b\002]\002_\002^\002`\000\000\000\000\000\000\000\134\000\000\000\000\002f\000\000\001\005\000\000\000\000\000\000\000\000\003Y\000\000\000\131\000\000\000\000\000\000\000\000\001k\001e\000\000\000\000\001f\001\201\000\000\001\200\000\000\000\000\000\247\000\000\000\000\000\000\000\029\000\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\197\001\193\000\000\001\189\003z\000\000\002f\000\000\001\004\000\000\000\000\000\000\000\000\002\167\002e\002c\002d\000\000\000\000\000\000\002f\000\000\001\003\000\000\000\000\000\000\000\000\002\166\000\000\001\159\001\158\000\000\000w\000\000\003\154\000\000\000$\000\000\000\000\000\000\000\000\000\157\000\156\000\000\001\t\000\001\000\000\000\000\001\012\000\002\000\000\000\000\000\000\001x\001y\000\003\000\000\000\000\000\000\000\000\001{\001|\001z\000\021\001w\000\022\000\000\002\024\000\000\000\004\000\000\002\025\000\000\000\005\000\000\002\026\000\000\000\000\002\027\000\006\000\000\000\007\000\000\002\028\000\000\000\b\000\000\002\029\000\000\000\t\000\000\002\030\000\000\000\n\000\000\002\031\000\000\000\011\000\000\002 \000\000\000\000\002!\000\012\000\000\000\000\002\"\000\r\000\000\000\000\000\000\000\000\000\000\003m\003h\003i\003l\003j\000\000\003q\000\014\000\000\003p\000\000\001X\000\000\000\000\003n\000\000\003o\000\000\000\000\000\000\000\000\001\\\001]\000\000\000\000\001[\001Z\000\015\000\000\000\000\000\000\003\141\000\000\003\140")
   
   and error =
-    (124, "'\225 \197\138\173\2433\208\020\015\228\000\003\142\0026\016\004\\(\223\018}\000@\248\000\000\024\224}\246D\b/\227P\000L\028\030\227\139\002\131@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175\235f\245\155\175\2437\252\149\031\226\017\007\158\007\223d@\130\2545\000\004\193\193\2388\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241'\208\004\015\128\000\001\142\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\000\000\000\000\004\000\012\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\007\224,$\000\003\226 \016@\016(\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\128\179\160\b2R\028\012\025 v\017\"\017@\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\002\012\\ \000\016\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@@ \193\004\000\000\016\000\000\000\000\000\016$\004\000\002\012\016@\000\001\000\000\000\000\000\001\002@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\003 \004\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128 \128\b \002\020\000\016\000b\000\002\000\bH\002\b\000\130\000!\000\001\000\006 \000 \000\003\000\000$\193\004\192\004\000\128\000\000\000\000\b\0000\000\002H\016L\000@\b\000\000\000\000\000\128\003\000\000$\129\004\192\000\000\128\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\b\000 \000\002\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002H\000@\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\128\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\000!\128\001\000\007`\017 \004\003 \000x\016\000\197\194\128\001\000\128 \000\016\bH\002(\000\194\t!\192\001\016\006a\016a\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\000\007\001\000\012\\(\000\016\b\002\000\001\000\003\000\bp\016 \197\194\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\128\b2R\028\012\017 v\001f\017`0\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\018\000\002\000\000\000\001\000\016\000\000\000@\000\000\001 \000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\193\004\192\004\000\128\000\000\000\000\b\0000\000\002H\016L\000@\b\000\000\000\000\000\128\003\000\000$\129\004\192\000\000\128\000\000\000\000\b\0000\000\002H\000L\000\000\b\000\000\000\000\000\128\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016 \004}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\002\128\193#\144\000\001\128\000\001\140\b@\000\b\004\000(!@\192\000\000 \016\000\000\132\000\000\128\000\002\130\020\012\000\000\002\001\000\000\b@\000\b\000\000(!\000\192\000\000 \016\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\136G\224,\229\"\211\227!\176@\025,\184\000\000\128\000\000\000\000\001\000\000\016\000\000\000\000\131\000\000\000@\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000@\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\001\002@@\000\000\129\004\000\000\016\000\000\000\000\000\016$\004\000\000\b\016\000\000\001\000\000\000\000\000\167\225 \197\138\173\2437\208\020\015\226\000\003\142\n~\018\012X\170\2233=\001@\254 \0008\224\167\225\"\197\138\173\2433\208\020\015\230\000\003\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@@\000\129\004\000\000\016\000\000\000\b\000\016$\004\004\000\b\016@\000\001\000\000\000\000\000\001\002@@\000\000\129\004\000\000\016\000\000\000\000\000\016$\004\000\000\b\016\000\000\001\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\002@@\000\000\129\000\000\000\016\000\000\000\000\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175\235w\253\155\239\247\255\252\157?\230!\003\158@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\n6\024\132~*\223R=>b\249\004\001\154\235\129!\bD\002\128\193#\144\000\001\128\000\001\140\0026\016\004X(\223\018=\000@\248\000\000\028\224\197\189\187\215\250\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\128\004\193\"\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\026\000\000\020@\003!\002@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\001\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\003\000\002p\016\000\197\194\000\001\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\004\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\128\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\003\184\000\131!!\192\193\018\007`\022!\022\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\011\184\000\131!!\192\193\018\007`\022!\022\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\012\012 \000\000\000\000\000\000\000\003\000\000p\016 \197\194\000\001\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\128\b2R\028\012\017 v\001b\017`0\000\006\000\000\012\\ \000\016\000\000\000\000\000\197\128\187\128\b2R\028\012\017 v\001b\017`\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128;\128\b2\018\028\012\017 v\001b\017@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000@\000\000@\000\002\000\000\000\001\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\002\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000 \000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000 \000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000@\000\000\001\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\016\000\000\000\0002\016\004\b\000L\018-\000\016\026\000\000\016@\003!\000@\192\004\193&\144\001\001\128\000\001\004\0002\016\004\b\000L\018i\000\016\024\000\000\016@\003!\000@\128\004\193\"\144\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147)\027P\144\020\193&\176\001\001\148 mU\000\000\016\000\b\000@\000\001\000\000\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t2\145\181\t\001L\018o\000\016\027A\006\213P\001\000\000\000\000\000\128\"\128\000\000\000\000\000\000\b2\016\132\b\000L\018-\000\016\026\000\000\144@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018m\000\016\026\000\000\016@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\003!\000@\128\004\193\"\208\001\001\160\000\001\004\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\131!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\027\000\000\016\000\004\000\000\000\020\000LQ\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027@\128\020\193&\208\001\001\180\000MU\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t2\017\180\b\001L\018m\000\016\027@\004\213P\131\161\136G\224,\229\"\211\227!\176@\025,\176\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000@\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\b\000L\018)\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000\001\000\000\016\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\004\000\000\000\000\000L\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\131\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\128\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000@\000\000\000\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\002@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001 \000\000\000\000@\000\000\000\000\004\133\016\131!\002@\128\004\193\"\208\001\001\160\000\001D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000@\000\000\000\000\004\129\016\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\016\000\000\004\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193&\176\t\001\144\000M\021\128\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016D\012\130L\018m\000\016\026\000\000\016@\001\002@@@\000\129\004\000\000\016\000\000\000\b\000\016$\004\004\000\b\016@\000\001\000\000\000\000\000\001\002@@\000\000\129\004\000\000\016\000\000\000\000\000\016$\004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\001\002H@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\001\002@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\001\002@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\000@\b\000\000\000\002\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\b\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\000\0000\000\007\129\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\001@0\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\001\"\001LH\002\168\000\131\001!\192\001\016\007`\018 \004\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\018 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\001\000\000\001\002@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\003 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\001\002@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\000\000\000\000\000\000\000\000\000\000\000\016\016\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\017\000v\016\"\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\000L\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\128\000\000\000\000\000\000\000\000\000\016$\004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\144\007`\002`\004\005\002H@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\128\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\192\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\144\007a\002`\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\128\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0026\016$X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000@\000\000\000@\000\000\000\000\b\000\001\000\000\000\000\000\000\000\004\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\018\016\004@(\012\0189\000\000\024\000\000\024\192\192\000\017\000\000\000\000\000\000\003\000\016P$\000\0026\016\004\\(\223\018}\000@\248 \000\024\224#a\000E\130\141\241'\208\004\015\130\000\001\142\0026\016\004X(\223\018=\000@\248 \000\024\224\001!\000DB\128\193'\144\000\001\128\000\001\140\000\018\016\004@(\012\018y\000\000\024\000\000\024\192\001!\000D\002\128\193#\144\000\001\128\000\001\140\000\018\016\004@(\012\0189\000\000\024\000\000\024\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\190\215?\191\251a\247\219\127\253\240\016\000\000\000\000\012\0028\000\000\000\000\000\000\000\163a\136G\226\173\245#\211\230/\144@\025\174\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\163a\bE\130\141\241#\208\004\015\128\000\001\142\n6\016\132X(\223\018=\000@\248\000\000\024\224\129\002@@@\000\129\004\000\000\016\000\000\000\000\000\016$\004\000\000\b\016@\000\001\000\000\000\000\000\001\002@@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000@\000\129\002@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\163a\bE\130\141\241#\208\004\015\128\000\001\142\n6\016\132X(\223\018=\000@\248\000\000\024\224\131!\b@\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000@\000\000\001\000\004\193\016\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0026\016\004\\(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\016@\016\000\000\000\000\016\000\004\000\000\000\000\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\003)\000P\208\004\193&\176\001\001\128\000\001\004\0002\144\005\t\000L\018k\000\016\024\000\000\016@\003)\000P\144\004\193\"\176\001\001\128\000\001\004\000 \000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\b\000\000\000\000\004\000\000\000\016\000L\017\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\016\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\161\136G\224,\229\"\211\227!\176@\025,\176\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\144\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\005\t\001L\018+\000\016\025\000\002P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\004\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\001\000\000\000\000\016@\000\000\001\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\012\000L\018m\000\016\026\000\000\016@\003!\000@\128\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\001!\000DB\128\193'\144\000\001\128\000\001\140\000\018\016\004@(\012\018y\000\000\024\000\000\024\192\001!\000D\002\128\193#\144\000\001\128\000\001\140\012IK\184>\131\225a\192\255\182\007}\183\231\015\001!\000D\002\128\193#\144\000\001\128\000\001\140\012[\219\189\127\171\237s\251\255\182\031}\183\255\223\000\000\000\000\000\000\128\002\128\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\b\000\001\176\000\000\000\000\000\000\000\000\000\004\005\000\163a\011E\130\141\241#\208\004\015\128\000\001\206\0026\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\190\215?\191\251a\247\219\127\252\240\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\000\131\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\025\000\000\000\000\004\000\000\000\016\000\000\000\b0\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\144\000\000\000\000@\000\000\001\000\002\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b\000\001\144\000\000\000\000@\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\004@(\012\0189\000\000\024\000\000\024\192\197\189\187\215\250\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\012\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\197\189\187\215\250\190\215?\191\251a\247\219\127\252\252IK\184>\131\225a\192\255\182\007}\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000B6\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\190\215?\191\251a\247\219\127\252\252IK\184>\131\225a\192\255\182\007}\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\231\245\187\199\234\191\247?\223\253o\247\139\127\254\247\223d@\130\2545\000\004\193\193\2388\176(4#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2402\016\004\b\000L\018m\000\016\024\000\000\016@\003!\000@\128\004\193\"\208\001\001\128\000\001\004\bz\146-\t\130M3\235\001\144\031`\006\241T#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\128\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\193\016\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\131!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\128\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\144\006`\000 \004\132\128\"\128\b\"\018\024\012\025\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\000\000\128\002\128\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\t\176>\000\192@@>\002\001\000\005\134\003\163a\011E\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\004@(\012\0189\000\000\024\000\000\024\192\197\189\187\215\250\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\252IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\252IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\252IK\184>\131\225a\192\255\150\007x\183\231\015\001\000\000\000\000\000\192\002\128\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\252IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\252IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000P\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\252IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\252[\219\189\127\171\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\252IK\184>\131\225a\192\255\150\007x\183\231\015\197\189\187\215\250\190\215?\191\251a\247\219\127\253\252[\219\189\127\171\237s\251\255\150\031x\183\255\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\016\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\240\000@\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\252IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\252IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\1306\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129!\bD\002\128\193#\144\000\001\128\000\001\140\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016$X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\002\128\193#\144\000\001\128\000\001\140\004\000\000\000\000\000\000\000\000\0000\000\005\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\016\000$\000\b\000\001\016\000\000\000\000\000\000\000\001\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\b\016\000\016\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\0000\000\005\000\000\000\001\000\000\000\000\000\192#\128\000\000\000\000\000\000\012\000\001\016\000\000\000\000\000\0000\001\005\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\182\007}\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\128\000\017\000\000\000\000\000\000\000@\000\000@\016\b\000\t\016>\000\192@@>\006\001\000\005\130\003\128\000\016\000\000\000\000\000\000\000@\000\000\000\000\b\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016$\004\000\000\b\016@\000\001\000\000\000\000\000\001\002@@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000@\000\128\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000@\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000@\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\000@\000\001\002@@\000\000\129\000\000\000\016\000\000\000\000\bH\002(\000\130\t!\192\001\144\006`\000 \004\129\002@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\016\000\004\000\000\000\016\000\000\000\000\016$\004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\025\000f\000\002\000@\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\004\000\b\000\000\000\004\000\0000\000\006\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\001\016\000\000\000\000@\000\002\000\000\000\000\016\000\000\017\000\000\000\000\004\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@@\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\004\000\000 \000\000\000\001\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\133\128\162\128\b0R\028\000\025\000f\001\002\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\128\162\128\b R\028\000\025\000f\001\002\016@0\000\006\000\000\012\\(\000\016\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\016\000\000\0000\000\006\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\133\128\"\128\b R\028\000\025\000f\001\002\016HX\n(\000\131\005!\192\001\144\006`\016!\004\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\133\128\"\128\b R\028\000\025\000f\001\002\016HX\n(\000\131\005!\192\001\144\006`\016!\004\000\000\000\000\000\000\000\004\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016D\b\000L\018m\000\016\024\000\000\016@\003!\004@\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\001\128\000\001\004\bH\002(\000\130\001!\128\001\144\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\196\148\187\131\232>\022\028\015\249`w\139~p\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\002@@@\000\129\004\000\000\016\000\000\000\000\000\016$\004\000\000\b\016@\000\001\000\000\000\000\000\001\002@@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\128\000\000\b\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000\000\000\000\000\000\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\2402\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\128\000\b\000\000\000\000\000\000\000\000\000\000d\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016$\004\000\002\012\016\000\000\001\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\136\003\224\012\004\004\003\224 \016\000| 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016$\004\000\002\012\016\000\000\001\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000\000\129\004\000\000\016\000\000\000\000\000\016$\004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000v\000\002\000\000\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\018\028\000\017\000f\000\002\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000@\000\000\000\000@\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\bH\002(\000\130\001!\128\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@0\000\000\000\000\000\000@\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\000@\000\132\128\"\128\b \018\024\000\017\000f\000\002\000HH\002(\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\0002\016\004\b\000L\018-\000\016\026\000\000\016@\016\000\002\000\000\000\000\004\000\000\000\000\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\000\016$\004\004\000\b\016@\000\001\000\000\000\000\000\001\002@@\000\000\129\004\000\000\016\000\000\000\000\000\016$\004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\bH\002(\000\130!!\192\193\016\007`\016 \000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\132\129\"\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b\"\018\028\012\017\000v\001\002\000\000\018\000\000\004\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\012 \018\028\000\017\000v\000\006\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\b\000\bH\002(\000\130\001!\192\001\016\006a\000!\000\001\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\132\128\"\128\b \018\028\000\017\000f\000\002\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \000\132\128\"\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\128\"\240\024 \199\210\000\017\000`\000\002\000\bH\002(\000\130\000!\000\001\000\006`\000 \000\001\000\000\000@\000\000\004\000\000\000\000\000\000\b\000\016\000\000\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \130\024\000\016\000f\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \130\024\000\016\000f\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000v\000\018\000\000\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\004\000\000\000\000\004\000\000\000\000\000\000\000\0000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\020\000\b\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\b!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\003\000\000\000\000\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\b\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016$\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000\bH\002(\000\130\000!\128\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\000@\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@@ \193\004\000\000\016\000\000\000\000\000\016$\004\000\002\012\016@\000\001\000\000\000\000\000\001\002@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\004\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\012 \002\028\000\016\000f\000\006\000\000\136\000\000\004\000\004\000`\000\000\000\000\000\000\000\b\000\000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000 \000\002H\000@\000\000\b\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\b@\000\b\000\000(!@@\000\000 \016\000\000\132\000\000\128\000\002\130\016\004\000\000\002\001\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\016\004\000\000\002\001\000\000\000\128\000\000\000\004\004\000@\000\000\000\000\000\000\000\b\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\028\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\128\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\128@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\000 \005\016`\000\000\000\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\b\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000@\000\000\000\000 \000\000\000\000@\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\018\028\004\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\bH\002\168\000\130!!\192A\016\007`\016 \004\132\000\000\128\000\002\002\028\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\198\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\001\000\000\b@\000\b\000\000 !\128@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\024\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\000@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\bX\n\168\000\131\004!\192\001\016\007`\000`\004\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\000\000\002\000\000\000\000\004\000\000\000\000\000@\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\133\128\170\128\b0B\028\000\017\000v\000\002\000HX\n\168\000\131\004!\192\001\016\007`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\168\000\130\000!\192\001\000\007`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\000\001\000\006`\000 \004\002\000\000$\128\004\192\004\000\128\000\000\000\000\b\000 \000\002H\000L\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\000\001\000\006`\000 \004\002\000\000$\128\004\192\004\000\128\000\000\000\000\b\000 \000\002H\000L\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\003 \000x\016\000\197\194\128\001\000\128 \000\016\0000\000'\001\000\012\\ \000\016\000\000\000\001@\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\160\"\128\b \146\026\000\017\000\230\001\002\000HH\002(\000\194\001!\192\001\016\006`\016a\004\132\128\"\128\b \018\028\000\017\000f\001\002\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\001\002\016@\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\001\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\007`\016 \004\001 \000\b\000\000\128\002\128\000\000\128 \000\016\000\018\000\000\000\000\b\000(\000\000\b\002\000\001\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\194\001!\192\001\016\006`\016a\004\132\128\"\128\b \018\028\000\017\000f\001\002\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000\000\000\000\136\000\000\004\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\000\000\128\000\002\130\020\012\000\000\002\001\000\000\b@\000\b\000\000(!\000\192\000\000 \016\000\000\132\000\000\128\000\002\002\016\012\000\000\002\001\000\000\000\128\000\000\000\004\004\000@\000\000\000\000\000\000\128\000\000\000\000\000@@\004\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\002@\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\192\192\000\000 \016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\002@\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\128\000\004\000@\000\000\000\000\000\000\128\000\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\0008\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\0008\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\132\000\000\128\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\002\000\209\006\000\000\004\000\000\000\b\000\016\000\004\000 \r\016`\000\000@\000\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\003!\004@\200\004\193&\208\001\001\128\000\001\004\007\223d@\130\2545\000\004\193\193\2388\176(4\003!\004@\128\004\193&\208\001\001\128\000\001\004\0002\016D\b\000L\018-\000\016\024\000\000\016@\003!\000@\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\128\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\128\001\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\016\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193&\176\001\001\128\000\001\004\0002\144\005\t\000L\018+\000\016\024\000\000\016@\003)\000P\144\020\193\"\176\001\001\128\000\001\004\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\016\000\004\000 \r\016 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bZ\146\173A\170-3\251\193\016\030`\016x\212\133\169*\212\026\162\211?\188\017\001\230\001\007\141@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\018\028\012\017\000f\001\006\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\168\000\130!!\192\193\016\006`\016`\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\018\028\012\017\000f\001\006\001@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\016\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\128*\128\b\"\018\028\012\017\000f\001\006\001@2\016D\b\000L\018-\000\016\024\000\000\016@\003!\000@\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\128\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\001\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\001\000\001\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\`\000\016\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\000\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\003)\000P\144\004\193\"\176\001\001\144\000\005\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\000\002\000HH\002(\000\130\001!\000\001\016\006`\000 \004\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\bH\002(\000\130\001!\128\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\016\000\016\000f\000\002\000\0002\016D\012\000L\018m\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\016\000\017\000f\000\002\000HH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\016\000f\000\002\000\bH\002(\000\130\001!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\000\001\144\006`\000 \004\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\016\000f\000\002\000\bH\002(\000\130\001!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007`\002 \004\192\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\000\000\004\193\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\016\012\000\000\002\001\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\b\000L\018-\000\016\026\000\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\130\b \018\024\000\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002(\000\130\001!\128\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\002\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000 \000\000\000\000\0000\000\006\000\000\012\\`\000\018\000\002\000\000\000\003\000\000`\000\000\197\194\000\001 \000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\001\000\000\000\004\000\000\000\018\000\000\000\000\000\003\000\000`\000\000\197\194\000\001 \000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\016\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\128\000\000\000\000@\000\000\000\000\004\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\000\000\004\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\000\007\129\000\012\\(\000\016\b\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\001\000\132\128\"\128\b \002\024\000\016\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\130\b \002\024\000\016\000v\001\018\000@2\000\007\129\000\012\\(\000\016\b\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\001\000\132\128\"\128\b \002\024\000\016\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002\016\000\016\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\192\002\000\000\000\128\000\000\000\b\000\b\128~\002\194@\000>\"\001\004\001\130\139\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\007\224,$\000\003\226 \016@\024(\176\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\016\000\004\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\000@\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000'\225 \197\138\173\2433\208\021\015\228\000\003\142\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\005\161 \128\b \210\016\016\017\000\228\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \018\016\000\017\000d\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002\b\000\130\001!\000\001\000\006\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\225 \197\138\173\2433\208\021\015\228\000\003\142\002~\018\012X\170\2233=\001P\254@\0008\224\004\128 \128\b \018\016\000\017\000d\000\002\000\000H\002\b\000\130\001!\000\001\016\006@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \018\024\000\017\000d\000\002\000\000H\002\b\000\130\001!\000\001\016\006@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002\b\000\130\001!\128\001\016\006@\000 \000\004\128 \128\b \018\016\000\017\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000")
+    (128, "'\225 \197\138\173\190fz\002\129\252\128\0008\224#a\000E\194\141\190$\250\000\129\240\000\000\024\224}\246D\b/\226*\000\t\131\131\220h\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175\235f\245\155\175\190f\255\146\163\252Q\016y\224}\246D\b/\226*\000\t\131\131\220h\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$\250\000\129\240\000\000\024\224}\246D\b/\226*\000\t\131\131\220h\176(4'\225\"\213\138\173\190fz\002\129\252\000\000x\224\000\000\000\000@\000\024\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\128\000\128\007\224,\004\128\000|D\002\004\001\002\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\128\179\160\b2\nC\129\131$\014\193\018!\020\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016 \024\184@\000 \000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@@ \024 \128\000\002\000\000\000\000\000\001\002@@\000 \024 \128\000\002\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\196\128*\128\b0\018C\128\002 \014\193\003 \004\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128 \128\b \000B\128\002\000\012@\000 \000\132\128 \128\b \000B\000\002\000\012@\000 \000\003\000\000$\193\004\024\000\128\016\000\000\000\000\000\128\003\000\000$\129\004\024\000\128\016\000\000\000\000\000\128\003\000\000$\129\004\024\000\000\016\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\024\000\000\016\000\000\000\000\000\128\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\016\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \128\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\016\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\132\128\"\130\b \000C\000\002\000\014\192\017 \004\003 \000x\016\000\024\184P\000 \016\002\000\001\000\132\128\"\128\012 \018C\128\002 \012\193\016a\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000p\016\000\024\184P\000 \016\002\000\001\000\003\000\bp\016 \024\184@\000 \000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\128\b2\nC\129\130$\014\192\022a\022\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\024\184@\000$\000\002\000\000\000\001\000\016\000\000\000\b\000\000\000$\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000}\246D\b/\226*\000\t\131\131\220h\176(4'\225\"\213\138\173\190fz\002\129\252\000\000x\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\193\004\024\000\128\016\000\000\000\000\000\128\003\000\000$\129\004\024\000\128\016\000\000\000\000\000\128\003\000\000$\129\004\024\000\000\016\000\000\000\000\000\128\003\000\000$\128\004\024\000\000\016\000\000\000\000\000\128\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\132\128\"\130\b \002C\000\002 \014\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002 \012\192\016 \004}\246D\b/\226*\000\t\131\131\220h\176(4'\225\"\213\138\173\190fz\002\129\252\000\000x\224#a\000E\194\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\002\129\152$r\000\0000\000\000\024\192\132\000\000\128@\002\016B\129\128\000\000@\016\000\000\132\000\000\128\000\002\016B\129\128\000\000@\016\000\000\132\000\000\128\000\002\016B\001\128\000\000@\016\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\136G\224,\028\164Z|d6\020\001\146\203\128\000\b\000\000\000\000\000\002\000\000 \000\000\000\000\131\000\000\000@\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\167\225 \197\138\173\190f\250\002\129\252@\0008\224\167\225 \197\138\173\190fz\002\129\252@\0008\224\167\225\"\197\138\173\190fz\002\129\252\192\0008\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@@\000\016 \128\000\002\000\000\000\000\128\001\002@@@\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\002@@\000\000\016 \000\000\002\000\000\000\000\000#a\000E\130\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\001\000\000\000@\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175\235w\253\155\239\190\255\255\147\167\252\210\0169\228\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\002\129\152$r\000\0000\000\000\024\192#a\000E\130\141\190$z\000\129\240\000\000\024\224#a\000E\194\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\163a\136G\226\173\190\164z|\197\242\004\001\154\235\129!\bD\002\129\152$r\000\0000\000\000\024\192#a\000E\130\141\190$z\000\129\240\000\000\028\224\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 4\016\000\020@\003!\002@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\002\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\003\000\002p\016\000\024\184@\000 \000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\003\000\000p\016\000\024\184@\000 \000\000\000\001@\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128;\128\b2\002C\129\130$\014\192\022!\022\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\196\128\187\128\b2\002C\129\130$\014\192\022!\022\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\024\024@\000\000\000\000\000\000\000\003\000\000p\016 \024\184@\000 \000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\128\b2\nC\129\130$\014\192\022!\022\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\197\128\187\128\b2\nC\129\130$\014\192\022!\022\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128;\128\b2\002C\129\130$\014\192\022!\020\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\128\b2\nC\129\130$\014\192\022!\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\004\000\000\000\128\000\004\000\000\000\001\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\004\000\000\000\001\002\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\004\000\000\000\001\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\004\000\000\000\001\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\004\000\000\000\001\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\003\000\000p\016\000\024\184@\000 \000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\004\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\128\000\000\002\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\002\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\003!\000@\192\004\024$\210\000 0\000\000\016@\003!\000@\128\004\024$\210\000 0\000\000\016@\003!\000@\128\004\024$R\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147)\027P\144\020\024$\214\000 2\130\006\213P\000\001\000\000\128\004\000\000\002\000\000 \000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147)\027P\144\020\024$\222\000 6\145\006\213P\001\000\000\000\000\000\016\004P\000\000\000\000\000\000\000\131!\b@\128\004\024$Z\000 4\016\000\144@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\024$\218\000 4\016\000\016@\003!\000@\128\004\024$\218\000 4\016\000\016@\003!\000@\128\004\024$Z\000 4\016\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\003!\000@\128\004\024$R\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027@\128\020\024$\218\000 6\144\004\213P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\027\000\000\016\000\000\128\000\000\002\128\004\197\016\003!\000@\128\004\024$Z\000 4\016\000\016@\144\000\027\000\000\016\000\000\128\000\000\002\128\004\197\016\131!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\027\000\000\016\000\000\128\000\000\002\128\004\197\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027@\128\020\024$\218\000 6\144\004\213P\131\161\136G\224,\028\164Z|d6\020\001\146\203\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\b\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$R\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\128\000\000\000\000\004\193\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\027\000\000\016\000\000\128\000\000\002\128\004\197\016\131\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\027\000\000\016\000\000\128\000\000\002\128\004\197\016\128\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\128\000\000\000\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\002@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\018\000\000\000\000\000\128\000\000\000\000\004\133\016\131!\002@\128\004\024$Z\000 4\016\000\020@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\128\000\000\000\000\004\129\016\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\131\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$\214\001 2\000\004\209X\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\002\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\004@\200$\024$\218\000 4\000\000\016@\001\002@@@\000\016 \128\000\002\000\000\000\000\128\001\002@@@\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\003\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\003\002H@\000 \024 \000\000\002\000\000\000\000\000\192\000\b\000\000\016\016\000\128\000\000\000\001\000@\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\002C\128\002 \014\192\002 \004\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\024\000\000\016\000\000\000\000\000\128\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\001\000\000\003\000\000x\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\196\128*\128\b0\002C\128\002 \014\192\002 \020\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\196\128*\128\b0\002C\128\002 \014\192\018 \020\196\128*\128\b0\002C\128\002 \014\192\018 \004\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\196\128*\128\b0\002C\128\002 \014\192\018 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\001\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\196\128*\128\b0\002C\128\002 \014\192\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018C\128\002 \014\193\003 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\196\128*\128\b0\002C\128\002 \014\192\002 \004\001\002@@\000 \024 \000\000\002\000\000\000\000\000\196\128*\128\b0\002C\128\002 \014\192\002 \004\000\000\000\000\000\000\000\000\000\000\000\002\001\001\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018C\128\002 \014\193\002 \004\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018C\128\002 \014\193\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\002C\128\002 \014\192\002 \004\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\002C\128\002 \014\192\002 \004\192\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\016\000\000\000\000\000\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018C\128\003 \014\192\002`\004\005\002H@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\016\000\128\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\192\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018C\128\003 \014\193\002`\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\128\001\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224#a\002E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\b\000\000\000\b\000\000\000\000\000\128\000\016\000\000\000\000\000\000\000\b\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\001!\000D\002\129\152$r\000\0000\000\000\024\192\192\000\017\000\000\000\000\000\000\000`\002\005\002@\000#a\000E\194\141\190$\250\000\129\240@\000\024\224#a\000E\130\141\190$\250\000\129\240@\000\024\224#a\000E\130\141\190$z\000\129\240@\000\024\224\001!\000DB\129\152$\242\000\0000\000\000\024\192\001!\000D\002\129\152$\242\000\0000\000\000\024\192\001!\000D\002\129\152$r\000\0000\000\000\024\192\001!\000D\002\129\152$r\000\0000\000\000\024\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\218\231\247\255l>\237\183\255\223\001\000\000\000\000\000\024\004p\000\000\000\000\000\000\000\163a\136G\226\173\190\164z|\197\242\004\001\154\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\163a\bE\130\141\190$z\000\129\240\000\000\024\224\163a\bE\130\141\190$z\000\129\240\000\000\024\224\129\002@@@\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\000\000@\000\129\002@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\163a\bE\130\141\190$z\000\129\240\000\000\024\224\163a\bE\130\141\190$z\000\129\240\000\000\024\224\131!\b@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\000\128\000\000\002\000\004\193\016\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224#a\000E\194\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\016@\016\000\000\000\000\016\000\000\128\000\000\000\000\004\129\016#a\000E\130\141\190$z\000\129\240\000\000\024\224\003)\000P\208\004\024$\214\000 0\000\000\016@\003)\000P\144\004\024$\214\000 0\000\000\016@\003)\000P\144\004\024$V\000 0\000\000\016@\002\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\b\000\000\000\000\000\128\000\000\002\000\004\193\016\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\161\136G\224,\028\164Z|d6\020\001\146\203\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$R\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\020\024$V\000 2\000\002P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000@\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\001\000\000\000\000\016\b\000\000\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\024$\218\000 4\016\000\016@\003!\000@\128\004\024$\218\000 4\016\000\016@\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016#a\000E\130\141\190$z\000\129\240\000\000\024\224\001!\000DB\129\152$\242\000\0000\000\000\024\192\001!\000D\002\129\152$\242\000\0000\000\000\024\192\001!\000D\002\129\152$r\000\0000\000\000\024\192\196\148\187\131\232>B\195\129\255l\014\237\183\231\015\001!\000D\002\129\152$r\000\0000\000\000\024\192\197\189\187\215\250\191\218\231\247\255l>\237\183\255\223\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\128\000\027\000\000\000\000\000\000\000\000\000\000\004\005\000\163a\011E\130\141\190$z\000\129\240\000\000\028\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\218\231\247\255l>\237\183\255\207\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\000\131\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\025\000\000\000\000\000\128\000\000\002\000\000\000\000\131\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\025\000\000\000\000\000\128\000\000\002\000\002\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\128\000\025\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\002\129\152$r\000\0000\000\000\024\192\197\189\187\215\250\191\218\231\247\255l>\237\183\255\223\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\024\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\197\189\187\215\250\191\218\231\247\255l>\237\183\255\207\196\148\187\131\232>B\195\129\255l\014\237\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\004#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\218\231\247\255l>\237\183\255\207\196\148\187\131\232>B\195\129\255l\014\237\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\231\245\187\199\234\191\254\231\251\255\173\254\232\183\255\239}\246D\b/\226*\000\t\131\131\220h\176(4#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\003!\000@\128\004\024$\218\000 0\000\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\135\169\"\208\152$\026g\214\003 >\192\006\241T#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\128\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\193\016\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016\131!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016\131!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016\128\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\003 \012\192\000 \004\132\128\"\128\b\"\002C\001\131 \012\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\155\003\224\012\000\128\128|\004\002\000\005\134\003\163a\011E\130\141\190$z\000\129\240\000\000\028\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\002\129\152$r\000\0000\000\000\024\192\197\189\187\215\250\191\218\231\247\255l>\237\183\255\223\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\001\000\000\000\000\000\024\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\000\000\016\000P\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\197\189\187\215\250\191\219\231\247\255l>\237\183\255\207#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\197\189\187\215\250\191\218\231\247\255l>\237\183\255\223\197\189\187\215\250\191\218\231\247\255,>\232\183\255\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\001\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015#a\000E\130\141\190$z\000\129\240\000\000\024\224\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\004\129\016#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129!\bD\002\129\152$r\000\0000\000\000\024\192\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\028\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\002E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\002\129\152$r\000\0000\000\000\024\192@\000\000\000\000\000\000\000\000\000`\000\005\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\002\000\002@\000\128\000\017\000\000\000\000\000\000\000\000\002\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000`\000\005\000\000\000\001\000\000\000\000\000\024\004p\000\000\000\000\000\000\000\192\000\017\000\000\000\000\000\000\000`\002\005\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>B\195\129\255l\014\237\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\128\000\017\000\000\000\000\000\000\000\b\000\000\004\001\000\128\000\145\003\224\012\000\128\128|\012\002\000\005\130\003\128\000\016\000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\128\001\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000@\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\132\128\"\128\b \018C\128\003 \012\192\000 \004\129\002@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\016\000\000\128\000\000\002\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\132\128\"\128\b \018C\128\003 \012\192\000 \004\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\128\001\000\000\000\000@\000\003\000\000`\000\000\024\184P\000 \000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\017\000\000\000\000\000\128\000\004\000\000\000\000\016\000\000\017\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\b\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\128\000\004\000\000\000\000\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\133\128\162\128\b0\nC\128\003 \012\192\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\128\162\128\b \nC\128\003 \012\192\016!\004\003\000\000`\000\000\024\184P\000 \000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\001\000\000\000\003\000\000`\000\000\024\184P\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\133\128\"\128\b \nC\128\003 \012\192\016!\004\133\128\162\128\b0\nC\128\003 \012\192\016!\004\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\133\128\"\128\b \nC\128\003 \012\192\016!\004\133\128\162\128\b0\nC\128\003 \012\192\016!\004\000\000\000\000\000\000\000\000\128\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\004@\128\004\024$\218\000 0\000\000\016@\003!\004@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 0\000\000\016@\132\128\"\128\b \002C\000\003 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\002@@@\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\000\000\b\000\000\000\016\000\128\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\002@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\017@\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$\218\000 4\016\000\017@\003!\000@\128\004\024$Z\000 4\016\000\017@\128\000\b\000\000\000\000\000\000\000\000\000\000\006A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\002@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\002@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\136\003\224\012\000\128\128|\004\002\000\007\194\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\002@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\002@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018C\128\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\132\128\"\128\b \018C\128\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\000@\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000@\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002 \014\192\000 \000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\196\128\"\128\b0\002C\128\002 \012\192\000 \000\132\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\132\128\"\128\b \002C\000\002 \012\192\000 \004\132\128\"\128\b \002B\000\002 \012\192\000 \004\003\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\132\128\"\128\b \002C\000\002 \012\192\000 \004\132\128\"\128\b \002B\000\002 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\132\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\246D\b/\226*\000\t\131\131\220h\176(4'\225\"\213\138\173\190fz\002\129\252\000\000x\224\003!\000@\128\004\024$Z\000 4\016\000\016@\016\000\002\000\000\000\000\000\128\000\000\000\000\004\129\016#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\246D\b/\226*\000\t\131\131\220h\176(4'\225\"\213\138\173\190fz\002\129\252\000\000x\224\001\002@@@\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \128\000\002\000\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\132\128\"\128\b \018C\128\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\024\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\132\128\"\128\b\"\002C\129\130 \014\192\016 \000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\129\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b\"\002C\129\130 \014\192\016 \000\001 \000\000@\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\132\128\"\128\012 \002C\128\002 \014\192\000`\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\128\000\132\128\"\128\b \002C\128\002 \012\193\000!\000\001\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\132\128\"\128\b \002C\128\002 \012\192\000 \000\132\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\128\002 \012\192\000 \000\132\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\128\"\240\024 \024\250@\002 \012\000\000 \000\132\128\"\128\b \000B\000\002\000\012\192\000 \000\001\000\000\000@\000\000\000\128\000\000\000\000\000\000\128\001\000\000\000@\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \016C\000\002\000\012\193\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \016C\000\002\000\012\193\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\000@\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000@\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\132\128\"\128\b \000C\000\002\000\014\192\001 \000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\196\128\"\128\b0\000C\128\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\001@\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \016C\000\002\000\012\193\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\196\128\"\128\b0\000C\128\002\000\012\192\000 \004\132\128\"\128\b \000B\000\002\000\012\192\000 \004\003\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\196\128\"\128\b0\000C\128\002\000\012\192\000 \004\132\128\"\128\b \000B\000\002\000\012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \000C\000\002\000\012\193\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\196\128\"\128\b0\000C\128\002\000\012\192\000 \000\132\128\"\128\b \000C\000\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\002\000\000@\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@@ \024 \128\000\002\000\000\000\000\000\001\002@@\000 \024 \128\000\002\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\196\128\"\128\b0\000C\128\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000\192\000\000\016\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\132\128\"\128\012 \000C\128\002\000\012\192\000`\000\b\128\000\000@\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000@\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\016\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\132\000\000\128\000\002\016B\128\128\000\000@\016\000\000\132\000\000\128\000\002\016B\000\128\000\000@\016\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\000B\000\128\000\000@\016\000\000\b\000\000\000\000@\b\000\128\000\000\000\000\000\000\000\b\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\132\000\000\128\000\002\000C\128\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\b\000\128\000\000\000\000\000\000\000\b\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\132\000\000\128\000\002\000C\000\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\002\000\n \192\000\000\000\000\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\128\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\002C\128\130 \014\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\132\128*\128\b\"\002C\128\130 \014\192\016 \004\132\000\000\128\000\002\000C\128\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184\192\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\132\000\000\128\000\002\000C\129\128\000\000@\016\000\000\132\000\000\128\000\002\000C\000\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\000C\000\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\000B\000\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\128\002 \012\192\000 \004\132\128\"\128\b \002B\000\002 \012\192\000 \004\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\001\000\000@\002\000\n @\000\000\000\000\000\000\000\132\128\"\128\b \002C\128\002 \012\192\000 \004\132\128\"\128\b \002B\000\002 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\133\128\170\128\b0\bC\128\002 \014\192\000`\004\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\001@\000\000\002\000\000\000\000\000\128\000\000\000\000\004\001\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\003\000\000`\000\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\133\128\170\128\b0\bC\128\002 \014\192\000 \004\133\128\170\128\b0\bC\128\002 \014\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b \000C\128\002\000\014\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \000C\000\002\000\012\192\000 \004\132\128\"\128\b \000B\000\002\000\012\192\000 \004\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\132\128\"\128\b \000C\000\002\000\012\192\000 \004\132\128\"\128\b \000B\000\002\000\012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \000B\000\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \000C\000\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \000B\000\002\000\012\192\000 \004\002\000\000$\128\004\024\000\128\016\000\000\000\000\000\128\002\000\000$\128\004\024\000\000\016\000\000\000\000\000\128\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002 \014\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002 \012\192\016 \004\132\128\"\128\b \002B\000\002 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \000B\000\002\000\012\192\000 \004\002\000\000$\128\004\024\000\128\016\000\000\000\000\000\128\002\000\000$\128\004\024\000\000\016\000\000\000\000\000\128\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\003 \000x\016\000\024\184P\000 \016\002\000\001\000\003\000\002p\016\000\024\184@\000 \000\000\000\001@\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\160\"\128\b \018C@\002 \028\192\016 \004\132\128\"\128\012 \002C\128\002 \012\192\016a\004\132\128\"\128\b \002C\128\002 \012\192\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002 \012\192\016!\004\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \000C\000\002\000\012\192\016 \004\132\128\"\128\b \000B\000\002\000\012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\128\002 \014\192\016 \004\001 \000\b\000\000\016\000P\000\000\016\002\000\001\000\001 \000\000\000\000\016\000P\000\000\016\002\000\001\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\012 \002C\128\002 \012\192\016a\004\132\128\"\128\b \002C\128\002 \012\192\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\000\000\000\b\128\000\000@\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$V\000 2\000\000P@\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\132\000\000\128\000\002\016B\129\128\000\000@\016\000\000\132\000\000\128\000\002\016B\001\128\000\000@\016\000\000\132\000\000\128\000\002\000B\001\128\000\000@\016\000\000\b\000\000\000\000@\b\000\128\000\000\000\000\000\000\128\000\000\000\000\000@\b\000\128\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\002@\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\132\000\000\128\000\002\000C\129\128\000\000@\016\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\002@\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\b\000\128\000\000\000\000\000\000\128\000\000\000\b\000\000\b\000\128\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$V\000 2\000\000P@\003\128\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$V\000 2\000\000P@\003\128\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$\250\000\129\240\000\000\024\224#a\000E\130\141\190$z\000\129\240\000\000\024\224\132\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\002\000\026 \192\000\000\128\000\000\000\128\001\000\000@\002\000\026 \192\000\000\128\000\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\003!\004@\200\004\024$\218\000 0\000\000\016@}\246D\b/\226*\000\t\131\131\220h\176(4\003!\004@\128\004\024$\218\000 0\000\000\016@\003!\004@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\001\000\001\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\128\001\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$\214\000 0\000\000\016@\003)\000P\144\004\024$V\000 0\000\000\016@\003)\000P\144\020\024$V\000 0\000\000\016@\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\004\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\169*\212\026\163\154g\247\130 <\192\016x\212\133\169*\212\026\163\154g\247\130 <\192\016x\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\002C\129\130 \012\192\016`\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\002C\129\130 \012\192\016`\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\002C\129\130 \012\192\016`\020\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\001\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\132\128*\128\b\"\002C\129\130 \012\192\016`\020\003!\004@\128\004\024$Z\000 0\000\000\016@\003!\000@\128\004\024$Z\000 0\000\000\016@\000\000\000\000\000\000\000\001\000\001\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\128\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\000C\129\128\000\000@\016\000\016\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\132\000\000\128\000\002\000C\129\128\000\000@\016\000\016\132\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184\192\000 \000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\132\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\000C\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\000B\001\128\000\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\128\002 \012\192\000 \004\003\000\000p\018\000\026\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\001\000\000@\002\000\026 @\000\000\128\000\000\000\000\132\128\"\128\b \002C\128\002 \012\192\000 \004\003)\000P\144\004\024$V\000 2\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002 \012\192\000 \004\132\128\"\128\b \002B\000\002 \012\192\000 \004\b\000\000\000\000\000\b\000\192\000\000\000\000\000\000\000\b\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003)\000P\144\004\024$V\000 2\000\000P@\132\128\"\128\b \002C\000\002 \012\192\000 \004\132\128\"\128\b \002B\000\002 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002B\000\002\000\012\192\000 \000\003!\004@\192\004\024$\218\000 0\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002B\000\002 \012\192\000 \004\132\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002B\000\002 \012\192\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002\000\012\192\000 \000\132\128\"\128\b \002B\000\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002B\000\003 \012\192\000 \004\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002\000\012\192\000 \000\132\128\"\128\b \002B\000\002\000\012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018C\128\002 \014\192\002 \004\192\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\004\193\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\000B\001\128\000\000@\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\000@\128\004\024$Z\000 4\016\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>B\195\129\255,\014\232\183\231\015\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\132\128\"\128\012 \002C\128\002 \014\192\000a\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\132\128\"\128\b \002C\128\002 \012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002 \012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\012 \002C\128\002 \014\192\000a\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\132\128\"\128\b \002C\128\002 \012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\132\128\"\130\b \002C\000\002 \014\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002 \012\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\132\128\"\128\b \002C\000\002 \012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\004\000\000\000\000\000\003\000\000`\000\000\024\184\192\000$\000\002\000\000\000\003\000\000`\000\000\024\184@\000$\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\016\000\000\000\b\000\000\000$\000\000\000\000\000\003\000\000`\000\000\024\184@\000$\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000\b\000\000\000 \000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\004\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\b\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000@\b\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\128\002 \012\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000x\016\000\024\184P\000 \016\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \000C\000\002\000\012\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\132\128\"\128\b \000C\000\002\000\012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\132\128\"\130\b \000C\000\002\000\014\192\017 \004\003 \000x\016\000\024\184P\000 \016\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \000C\000\002\000\012\192\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\016\000@\000\000\016\000\000\001\000\001 \000\000\000\000\016\000@\000\000\016\000\000\001\000\132\128\"\128\b \000C\000\002\000\012\192\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002C\000\002 \012\192\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\128\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \000B\000\002\000\012\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\024\000@\000\000\016\000\000\000\000\128\000\136\007\224,\004\128\000|D\002\004\001\130\139\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\128\000\128\007\224,\004\128\000|D\002\004\001\130\139\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\016\000@\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\024\184@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\190$z\000\129\240\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000\000\016 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\128\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002@@\000 \024 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\016\000\000\128\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\024$Z\000 4\016\000\016@\000\000\000\000\000\000\000\000\128\000\000\000\128\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000'\225 \197\138\173\190fz\002\161\252\128\0008\224\001\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\005\161 \128\b \026B\002\002 \028\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002B\000\002 \012\129\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002B\000\002\000\012\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\001\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\225 \197\138\173\190fz\002\161\252\128\0008\224'\225 \197\138\173\190fz\002\161\252\128\0008\224\004\128 \128\b \002B\000\002 \012\128\000 \000\004\128 \128\b \002B\000\002 \012\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002C\000\002 \012\128\000 \000\004\128 \128\b \002B\000\002 \012\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002C\000\002 \012\128\000 \000\004\128 \128\b \002B\000\002 \012\128\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000")
   
   and start =
     15
   
   and action =
-    ((16, "kby\132n\030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021Hn\030\000\000\000\000\020Xn\030kb\020\182\000-\000[\164L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\138\001\208\001d\000\000\002t\001\188\000\000\003\214\003$\007\140\000\000\005\244\003r\b\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\220\000\000\000\000\000\000\002\216tj\000\000\000\000\000\000\006&\000\000\000\000zh\0046\0046\000\000\000\000\179N\006&\000\000y\140\020Xj6\164\228\005\236\000\000\020X\129&o8\020Xzx\000\000\005\144\000\000l(\006\136\000\000kJ\000\000\021\224\000\000\000\000\003\224\000\000\006&\000\000\000\000\000\000\006\242\000\000kJ\000\000\006\214\194L\166\164\173&\000\000\203\252\205\226\000\000t\242\132\164\000\000\132\"\0218tjn\030kb\000\000\000\000o8\020X{\194l(\007\030\190\180\000\000\185\024n\030kby\132\020X\000\000\000\000\016xy~\020X\130\172\131\142\000\000\001\026\000\000\000\000\004\250\000\000\000\000qn\001\026\025\130\005\200\b$\000\000\000\000\002\026\000\000j6\005\248\005\228\020X\023.\020Xkbkb\000\000\000\000\000\000u\254u\254\020X\023.\b`\000\000q\152\020X\129&\023\022\bZ\b\004\000\000\000\220\b\022\000\000\000\000\000\000\000\000\000\000\020X\000\000\000\000\000\000y\132\020X\000\000i\134\191:}\252\000\248\129\218\131\142\193\254\194\230\000\000\b\004\000\000\007:\000\000\000\000\020\250\177\148~X\000\000\177\148~X\000\000\177\148\177\148\000b\006\n\0008\000\000\020\190\000\000\bL\000\000\000\000\bL\000\000\000\000\000\000\177\148\006&\000\000\000\000\130\164\177\148~\224\132\164\000\000\0072\028\254\179N\132\164\011\228\177\148\000\000\000\000\000\000\000\000\000\000\000\000v\204\132\164w\194\000b\000\000\000\000\000\000\004\006\000\000\000\000\162&\012$\006&\000\000\000\000x\184\000\000\000\000\000\000\003b\000\000\177\148\000\000\001\000\180F\000\000\177\148\005\216\177\148\023\224\000\000\024\216\000\000\006\208\006\230\000\000\011\132\177\148\t\206\000\000\t\246\000\000\t\184\000\000\000\000\005\016\000\000\000\000\000\000\029\n\030D\131\142yp\020X\131\142\000\000\000b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000u\220\027v\000\000\000\000\000\000\001\244%\182\188\132\000\000\000\000yp\020X\131\142\000\000\000\000\207p\131\142\207\184\194\230\000\000\208N\000\000\131\142\000\000\000\000\132zqn\001\154\001\154\000\000\014\020\131\142\000\000\000\000\000\000\004\250\014,\000\000h\196\000\000\000\000\195.\000\000\208`\177\148\000\000\004R\000\000\000\000\195\186\000\000\208\150\012\226\000\000\000\000\000\000\000\000\014\178\000\000\023\160\000\000\000\000\195\186\000\000\004\224\000\000\000\000l\000\189\016\000\000\000\000j&\024t\019\252\025\"\000\000\000\000\000\000\000\000\002>\000\000\000\000\162\240\n\238\014\168\000\017\177\148\000\226\015t\000\000\000\000\011\176\014\168\005\"\000\000y\132yvu\254\020X\023.\000-\000\018\r\138\000\000\015Lj6\131\196\015\212j6\000-\000\018\000\018j6\000\000\178\132\t`l(\b\004\bT\209 \000\000\177\148\173\198\177\148\167\132\174f\177\148\006`\177\148\175\000\000\000\012\250\tD\nDj6\179$\000\000\b*\t\190\165\006\000\000\000\000\000\000\000\000j6\179|j6\180\028\020d\0008\168$\b\022\0008\168|\000\000\180t\t`\000\000\000\000\000\000\181\020\002\152\000\000\000\000\006x\000\000\007|\023.\000\000\165\196q\152\000\000\0268\000\000\000\000j6\003\144\000\000\000\000\000\000\000\000\163\168\000\000\001\248\000\000\127\172\t \0032\133<\0226\131\132y\132\020Xo\244y\132\020X\016x\016x\000\000\000\000\000\000\000\000\001\240\025\030jt\000\000{,{\224u\254\020X\023.\007hnB\000\000\007p\000\000|\148}H\196\002qZ\177\148\006p\000\000y\132\020X\000\000yp\020X\193\254\131\142ih\000\000y\132\020Xo\b\001\b\000\000\131\142ih\177\148\002\210\005\"\016r\000\000\000\000\000\000rZ\001\154\016\136\000\000\131\142\000\000\000\000\175\140\000\000\000\000\t\014\132\164\000b\016\200\133\240yp\020X\193\254\026\022\134\164yp\020X\193\254\027\014\131\142\000\000\000\000yp\020X\131\142\026J\000\000y\132\020X\016x\0226\016x\002\232\021\238sHyp\020X\193\254m\200sH\135Xyp\020X\193\254\000\000\016x\r\160\016\190\000*\177\180\000\000\021\146\179N\000\000\026\"\177\148\028\018\016\250\000\000\000\000\016\206\000\000\016x\003\224\017\004\000\000&\174\000\000\n\202\000\000\000\000\028\006\136\012yp\020X\193\254\028\254\017p\023.\000\000\000\000\000\000\000\000\004\234\000\000\000\000\000\000\029\246\136\192yp\020X\193\254\030\238\031\230\137typ\020X\193\254 \222!\214\000\000\018h\024&\138(yp\020X\193\254\000\000\000\000\000\000n\030\000\000\000\000\000\000\138\220yp\020X\193\254\"\206#\198\139\144yp\020X\193\254$\190%\182\140Dyp\020X\193\254&\174'\166\140\248yp\020X\193\254(\158)\150\141\172yp\020X\193\254*\142+\134\142`yp\020X\193\254,~-v\143\020yp\020X\193\254.n/f\143\200yp\020X\193\2540^1V\144|yp\020X\193\2542N3F\1450yp\020X\193\2544>56\145\228yp\020X\193\2546.7&\146\152yp\020X\193\2548\0309\022\147Lyp\020X\193\254:\014;\006\148\000yp\020X\193\254;\254<\246\148\180yp\020X\193\254=\238>\230\149hyp\020X\193\254?\222@\214\150\028yp\020X\193\254A\206B\198\150\208yp\020X\193\254C\190D\182\151\132yp\020X\193\254E\174F\166\1528yp\020X\193\254G\158H\150\020X\131\142o\b\000\000\000\000tj\001\154\016\182\177\148\bP\000\000\000\000\nF\006&\000\000\177\148\b\162\000\000\000\000\017\"\000\000\000\000\000\000\004\164\000\000\017,\133\240\000\000\000\000\000\000q\154\177\148\t\154\000\000\000\000\0292\000\000\000\000\196\142\000\000\030*\196\214\000\000\031\"\197b\000\000 \026\014\210\000\000\000\000\000\000\000\000!\018\131\142\"\n\000\000\185\004\185\004\000\000\000\000\000\000I\142\000\000\006\212\000\000\000\000\000\000\011\188\000\000\000\000\000\220\025\158sH\011\172\000\000\000\000\166ft\014\000\000sH\t\210\000\000\000\000sH\012\140\000\000\000\000\000\000\016x\004\216\026\bsH\012\164\000\000\005\208\152\236yp\020X\193\254J\134K~sH\r\156\000\000\006\200\153\160yp\020X\193\254LvMnsH\r\172\000\000\007\192\154Typ\020X\193\254NfO^'\166\000\000\r\186\b\184\155\byp\020X\193\254PVQN\000\000\014\144\t\176\155\188yp\020X\193\254RFS>\000\000\014\250\n\168\156pyp\020X\193\254T6U.\007H\026\198sH\015L\011\160\157$yp\020X\193\254V&W\030sH\014\148\012\152\157\216yp\020X\193\254X\022Y\014sH\015\134\r\144\158\140yp\020X\193\254Z\006Z\254\014\136\159@yp\020X\193\254[\246\\\238\015\128\019`\000\000\000\000\000\000\000\000\015\162\000\000sH\014\170\000\000sH\015\242\000\000\t\236\000\000\000\000\000\000\017J\000\000\n\224\000\000\000\000]\230\000\000\017\196\000\000\000\000\000\000\000\000\000\000\000\000^\222\018\014\159\244yp\020X\193\254_\214\160\168yp\020X\193\254`\206a\198b\190\161\\yp\020X\193\254c\182d\174\000\000#\002\000\000\000\000\005\134\000\000\000\000\131\142\000\000\000\000\191\150\016D\000\000\000\000\127\172\000\000\b\218\000\000\000\000\128r\000\000\015\140\000\000\000\000\005@\011\194\000\000\000\000\0226\022\028\b\004\000\000j\228\031<\027\\\021\218\000\000\000\000\016\148\000\000\000\000\001\238\026\022\133D\000\000\025\030\000\000\n\246\000\000\000\000\016\234\000\000\000\000yp\020X\193\254i*\175\244\t\002\005@\000\000\000\000\012H\000\000\000\000\016\128\000\000\000\000\000\000\020X\023.\003\202\000\000\000\000\023\022\005\200\b$\b`\023.\192&\162\016\000\000\020X\023.\192\164\017\162\000\000\000\000\b`\000\000n\174\019\248\023\228\000\000\011\220\0184\000\000\018H\000V\132\164\000\244\000\000\018\024\017\170tj\011,\177\148\026\160\020F\016V\003\b\000\000\029\136\018d\000\000\000\244\000\000\000\000\018|\132\164\169\028\000\000\176\146\168N\012\156\132\164\018J\132\164\181\146\169\188\018\\\132\164\182\016\170\\\001\024\018\030\000\000\000\000\000\000\020X\200\164\000\000\131\142\185\004\000\000\000\000\018\146\000\000\000\000\000\000yp\020X\193\254e\166f\158\000\000\015\228\000\000\000\000\000\000u\254\020X\023.\003\202\000\000\163\148\000\000\bh\000\000\000*\000\000\000\000\018\158\000\000\018\202\193\254g\150yp\020X\193\254\022`\000\000\000\000\165\228\000\000\t`\000\000\167\164\000\000\020X\000\000j6\nX\000\000\176\250\000\000\000\000\171(\000\000\011P\000\000\171\196\000\000\025\198\000\000j6\012H\000\000\200\234\000\000\020X\023.\200\234\000\000\023l\023\022\bZ\006&\202\150j6\197\168\185\004\000\000\005\200\tR\b$\b`\185\004\204p\005\200\b$\b`\185\004\204p\000\000\000\000\b`\185\004\000\000n\030kb\131\142\027B\000\000\000\000n\030kbu\254\020X\023.\200\234\000\000\020\182\000-\000[\017\246tj\r(\177\148\185\150\018$\018\204\203\020\000\000\185\004\000\000\186\018n\174\019\248\023\228\192\252\024\220\r\204\198$\n<\018*\020X\185\004\000\000\020X\185\004\000\000\177\180\174\202\019\134\003\214\005\200\0008w\140\000\000\005\200\0008w\140\000\000\026\178\023\022\bZ\006&x\130j6\185\024\000\000\005\200\nJ\022\214\012\156\000\000w\140\000\000\b$\0184j6\185\024\206*\005\200\b$\0186j6\185\024\206*\000\000\000\000\tX\r\148\000\000\205j\000\000j6\203lw\140\000\000\nP\r\148\000\000y\140\020Xj6\185\024\000\000n\174\019\248\023\228\186\142kr\024\014\019\170\002\142\000\000\rbkJ\000\017\000\000\018\176\018^\024\196\020X\162\190\177\148\n@\000\000\135X\012\238\004\212\r\230\000\000\014\132\000\000\018\190\018X\177\148w\202\000\000\0032\002\228\011\016\000\000\014\240\000\000\018\214\018ztjw\202\000\000\020X\024\196\019\014\011^\005\200\000\000\016\176\024\196\177\148\012\020\000b\000\000\177\148\004\018\007\242\000\000\000\000\182j\000\000\000\000\016\204\024\196\182\232w\202\000\000\020X\177\148\015d\177\148tXw\202\000\000\016\232\000\000\000\000w\202\000\000\000\000\135X\000\000\185\024\204~\019\170\002\142\rb\019\002\018\176\024\196\185\024\204~\000\000\000\000\019\170\002\142\rb\019\006\018\146v\158t\252\132\164\019\028v\158\177\148\020\184\019&v\158\132\164\019,v\158\183\136\184\b\000\000\201h\000\000\000\000\185\004\206d\019\170\002\142\rb\019(\018\190v\158\185\004\206d\000\000\000\000\000\000\174\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000w\140\000\000\205\016\020Xl(\019H\190\180\000\000\185\024\205\016\000\000\000\000\206\152\020Xl(\019L\018\232\166\164\206\202\000\244\019\150\000\000\000\000\184\134\186\142\020X\000\000\198|\023\228\000\000\000\000\185\024\206\152\000\000\000\000\000\000\193xl\156n>\000\244\019\162\000\000\000\000\000\000\186\142\020X\000\000\000\244\019\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015Xkr\019\170\002\142\rb\019\128\186\254\023\204\020X\130\172\134\164\020(\003\b\000\244\019\152\012d\000\000\000\000\019b\000\000\000\000\128r\000\000\011\156\014\222\000\000\015&\000\000\019\192\019r\177\148~F\020\022\r\\\000\000\000\000\019\222\000\000\000\000\020F\0032\016\218\000\000\0208\187\128\209\146\001\154\019\214\177\148\017\b\000\000\000\000\0204\000\000\000\000\000\000\128r\000\000\0068\017\168\000\000\015\232\000\000\020\138\020Htj\000\000\020\218\188\002\209\168\001\154\020\136\177\148\017Z\000\000\000\000\020\178\000\000\000\000\000\000\020X\000\000\128r\000\000\020z\020X\023\204\023\204\189Xn\030\020X\200\164\131\142\025p\000\000\012\020\005\200\000\000\016\244\023\204\177\148\014\192\b\004\000\000\020X\131\142\186\254\023\204\0162\023\204\000\000lFm,\000\000\170\182\000\000\000\000\171R\000\000\000\000\171\238\000\000\017\168\023\204\172\138\200\164\131\142\025p\000\000\000\"\000\000\000\000v\158\017\154\000\000\000\000\127\172\021\012\000\000\128r\000\000\023\204\127\172\128r\000\000\020X\177\148\128r\000\000\017x\000\000\000\000\128r\000\000\000\000\134\164\000\000\201\192v\158\020\186\023\204\202>\186\254\000\000\185\004\205\030\019\170\002\142\rb\021\020\186\254\185\004\205\030\000\000\000\000\000\000\207byp\000\000\000\000\000\000\000\000\000\000\000\000\203\166\185\004\000\000\205\016\000\000\000\000\000\000\000\000\185\004\207b\000\000\000\000\000\000\203\166\021T\000\000\021`\000\000\185\004\207b\000\000\000\000\017\206\000\000\000\000\178,\004\136\000\000\000\000jV\000\000\177\148\016\016\000\000\134\164\018\028\000\000\000\000\021\176\193\254\000\000h\142\021\180\000\000\000\000\021\168\028B$\002\023\228\189\224\024\220\020X\000\000\185\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\189\244\024\220\020X\000\000\012>\190\180\000\000\185\024\000\000\021\194\028B$\002\185\024\000\000\021\212\000\000\004\206\017N\020X\210,\000\000\000\000\028\190\210J\000\000\000\000\021^\000\000\021\186\177\148\000\000\0186\n\182\000b\000\000\000\000\177\148\0150\016\004\177\148\016(\000\244\021\234\000\000\000\000\199\022\000\000\000\000\166\164\000\000\185\024\000\000\021\222\028B$\250w\140\000\000\000\000\000\000\000\000\015\020\199\176\166\164\000\000\185\024\000\000\021\224\028B$\250w\140\000\000\018p\000\000\000\000\0148\000\000\185\004\000\000\021\254\000\000\000\000\021`\000\000\016\224\000\000\000\000\021\132\000\000\000\000sH\021\136\000\000\000\000$\190\164L\022*\000\000\000\000\000\000\016|\0114\166\236\0220\000\000\000\000\000\000\000\000\000\000\000\000\021\178\000\000\024\220\000\000\021\194\000\000\177\148\000\000\r\224\000\000\000\000\021\198\000\000\000\000\0008\000\000\004\202\000\000\000\000\000\000\006\168\000\000\023.\000\000\015n\000\000j6\000\000\0040\000\000\tD\000\000\021\202\000\000\131\142\026J\000\000\000\000\r$\021\218\000\000\000\000\021\212\014\028o\244\006&\200.\000\000\000\000\000\000\000\000\000\000\163\226\000\000\000\000\022z\000\000\190\238\000\000\017\244\022\130\000\000\022\132\000\000p\168p\168\209\214\209\214\000\000\000\000\184\254\209\214\000\000\000\000\000\000\184\254\209\214\022\022\000\000\022\028\000\000"), (16, "\003\197\003\197\000\006\001\002\001\190\003\197\002\194\002\198\003\197\002\242\002\146\003\197\004M\003\197\022\158\002\254\003\197\027\146\003\197\003\197\003\197\019\202\003\197\003\197\003\197\001\210\005\r\005\r\004V\003\002\003\197\003z\003~\011~\003\197\001\206\003\197\027\150\003\006\000\238\003\166\019\206\003\197\003\197\003\218\003\222\003\197\003\226\003\238\003\250\004\002\007V\007\154\003\197\003\197\002\186\001\206\007r\003\246\003\197\003\197\003\197\b\190\b\194\b\206\b\226\001*\005\174\003\197\003\197\003\197\003\197\003\197\003\197\003\197\003\197\003\197\tV\000\238\003\197\018\174\003\197\003\197\004M\tb\tz\n\030\005\186\005\190\003\197\003\197\003\197\007\213\003\197\003\197\003\197\003\197\002z\002\170\016\198\003\197\0072\003\197\003\197\003\233\003\197\003\197\003\197\003\197\003\197\003\197\005\194\b\214\003\197\003\197\003\197\b\238\004\130\n2\003\233\003\197\003\197\003\197\003\197\0149\0149\027\154\n\138\004\222\0149\n\150\0149\0149\004Q\0149\0149\0149\0149\t\138\0149\0149\007u\0149\0149\0149\004E\0149\0149\0149\0149\005\r\0149\019\014\0149\0149\0149\0149\0149\0149\0149\0149\007u\0149\018\182\0149\0052\0149\0149\0149\0149\0149\006\181\0149\0149\000\238\0149\003\254\0149\0149\0149\t\142\t\170\0149\0149\0149\0149\0149\0149\0149\000\238\0149\0149\0149\0149\0149\0149\0149\0149\0149\0149\0149\000\238\0149\0149\004Q\0149\0149\014\138\003\030\003\186\005\r\0149\0149\0149\0149\0149\005\r\0149\0149\0149\0149\0149\007A\0149\0149\006\213\0149\0149\003\"\0149\0149\0149\0149\0149\0149\0149\0149\0149\0149\0149\0149\0149\007A\005\r\0149\0149\0149\0149\001\153\001\153\001\153\001f\004%\001\153\006J\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001v\001\153\001j\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\007\026\001\153\003R\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\b\130\001\153\001\153\001\153\006\213\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\000\238\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\b\186\001\153\001\153\022\142\bb\007\166\001r\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\017\202\t\006\001\153\005\242\001\153\001\153\bf\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\182\001\153\001\153\001\153\001\153\001\153\011\165\011\165\022\250\b\"\014]\011\165\003V\011\165\011\165\004\201\011\165\011\165\011\165\011\165\001\186\011\165\011\165\014]\011\165\011\165\011\165\000\238\011\165\011\165\011\165\011\165\023\002\011\165\007\030\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\007\225\011\165\005\r\011\165\005\r\011\165\011\165\011\165\011\165\011\165\t=\011\165\011\165\000\238\011\165\001\130\011\165\011\165\011\165\007\225\005\r\011\165\011\165\011\165\011\165\011\165\011\165\011\165\005\r\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\000\238\011\165\011\165\004\201\011\165\011\165\005\"\b\158\007\166\005\r\011\165\011\165\011\165\011\165\011\165\001\146\011\165\011\165\011\165\011\165\nJ\000\238\n\206\011\165\001\198\011\165\011\165\b\162\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\011\165\007\225\011\165\011\165\011\165\011\165\011\165\004m\004m\002\001\b\"\b\202\004m\002^\004m\004m\019\178\004m\004m\004m\004m\001f\004m\004m\004%\004m\004m\004m\000\238\004m\004m\004m\004m\002b\004m\000\n\004m\004m\004m\004m\004m\004m\004m\004m\b\130\004m\004\242\004m\007\166\004m\004m\004m\004m\004m\t\233\004m\004m\000\238\004m\005&\004m\004m\004m\002\001\006\150\004m\004m\004m\004m\004m\004m\004m\018B\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\006\154\nB\n\198\000\238\004m\004m\b\"\028\214\007\166\000\238\004m\004m\004m\004m\004m\001\234\004m\004m\004m\004m\nJ\019\182\n\206\004m\000\238\004m\004m\028\218\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\000\238\004m\004m\004m\004m\004m\004]\004]\022\206\b\"\006\222\004]\t\233\004]\004]\031\135\004]\004]\004]\004]\005\r\004]\004]\007\129\004]\004]\004]\000\238\004]\004]\004]\004]\006\226\004]\001\238\004]\004]\004]\004]\004]\004]\004]\004]\007\129\004]\022\214\004]\004R\004]\004]\004]\004]\004]\006\189\004]\004]\005\138\004]\nI\004]\004]\004]\000\238\007\253\004]\004]\004]\004]\004]\004]\004]\b\005\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\005\r\nB\n\198\n\138\004]\004]\n\150\003*\011\022\031W\004]\004]\004]\004]\004]\004b\004]\004]\004]\004]\nJ\r\253\n\206\004]\b\198\004]\004]\003.\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\r\253\004]\004]\004]\004]\004]\011\r\011\r\005\r\005\r\007R\011\r\rn\011\r\011\r\nI\011\r\011\r\011\r\011\r\002\022\011\r\011\r\005\r\011\r\011\r\011\r\004\130\011\r\011\r\011\r\011\r\005\r\011\r\003^\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\001f\011\r\0176\011\r\004%\011\r\011\r\011\r\011\r\011\r\003b\011\r\011\r\001\218\011\r\014\234\011\r\011\r\011\r\026v\000\238\011\r\011\r\011\r\011\r\011\r\011\r\011\r\000\238\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\004R\011\r\011\r\026~\011\r\011\r\017>\0026\007\166\005\r\011\r\011\r\011\r\011\r\011\r\001\222\011\r\011\r\011\r\011\r\011\r\014\001\011\r\011\r\t5\011\r\011\r\bn\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\014\001\005\r\011\r\011\r\011\r\011\r\011\029\011\029\005B\b\"\004n\011\029\014n\011\029\011\029\000\238\011\029\011\029\011\029\011\029\001\206\011\029\011\029\000\238\011\029\011\029\011\029\000\238\011\029\011\029\011\029\011\029\n)\011\029\014r\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\005^\011\029\007\218\011\029\002v\011\029\011\029\011\029\011\029\011\029\tR\011\029\011\029\001\206\011\029\015\018\011\029\011\029\011\029\002\134\004\030\011\029\011\029\011\029\011\029\011\029\011\029\011\029\000\238\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\031g\011\029\011\029\004\"\011\029\011\029\b6\002B\007\166\n)\011\029\011\029\011\029\011\029\011\029\002\222\011\029\011\029\011\029\011\029\011\029\007I\011\029\011\029\004R\011\029\011\029\t6\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\007I\n)\011\029\011\029\011\029\011\029\011\021\011\021\002z\b\"\b\130\011\021\n%\011\021\011\021\bv\011\021\011\021\011\021\011\021\007r\011\021\011\021\000\238\011\021\011\021\011\021\000\238\011\021\011\021\011\021\011\021\001\134\011\021\004\166\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\015\198\011\021\003\186\011\021\002\198\011\021\011\021\011\021\011\021\011\021\t\229\011\021\011\021\003\190\011\021\015:\011\021\011\021\011\021\003F\003J\011\021\011\021\011\021\011\021\011\021\011\021\011\021\t*\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\004f\011\021\011\021\003\150\011\021\011\021\003\178\005\r\007\166\000\238\011\021\011\021\011\021\011\021\011\021\003\194\011\021\011\021\011\021\011\021\011\021\007Q\011\021\011\021\004R\011\021\011\021\019\194\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\007Q\004r\011\021\011\021\011\021\011\021\011\001\011\001\005\r\b\"\007r\011\001\t\229\011\001\011\001\000\238\011\001\011\001\011\001\011\001\000\238\011\001\011\001\017f\011\001\011\001\011\001\000\238\011\001\011\001\011\001\011\001\001\150\011\001\b\002\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\nE\011\001\r\150\011\001\007\182\011\001\011\001\011\001\011\001\011\001\018Z\011\001\011\001\000\238\011\001\015b\011\001\011\001\011\001\018\014\007\190\011\001\011\001\011\001\011\001\011\001\011\001\011\001\018b\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\002\014\011\001\011\001\r\178\011\001\011\001\003F\003J\007\166\007\209\011\001\011\001\011\001\011\001\011\001\007\170\011\001\011\001\011\001\011\001\011\001\020\166\011\001\011\001\b\198\011\001\011\001\020\n\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\011\001\nE\001\222\011\001\011\001\011\001\011\001\011\t\011\t\007\230\b\"\007r\011\t\017j\011\t\011\t\018\022\011\t\011\t\011\t\011\t\b\006\011\t\011\t\014\178\011\t\011\t\011\t\000\238\011\t\011\t\011\t\011\t\005~\011\t\t\222\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\005n\011\t\014\182\011\t\016\142\011\t\011\t\011\t\011\t\011\t\022.\011\t\011\t\000\238\011\t\015\134\011\t\011\t\011\t\001\222\005v\011\t\011\t\011\t\011\t\011\t\011\t\011\t\022>\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\003\190\011\t\011\t\r\242\011\t\011\t\003F\021\226\007\166\005\130\011\t\011\t\011\t\011\t\011\t\022\190\011\t\011\t\011\t\011\t\011\t\021\246\011\t\011\t\r\162\011\t\011\t\020&\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\021n\005&\011\t\011\t\011\t\011\t\011\005\011\005\016\146\b\"\007r\011\005\005&\011\005\011\005\000\238\011\005\011\005\011\005\011\005\001\206\011\005\011\005\n\218\011\005\011\005\011\005\000\238\011\005\011\005\011\005\011\005\005&\011\005\016\166\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\n\222\011\005\017\226\011\005\007\242\011\005\011\005\011\005\011\005\011\005\022R\011\005\011\005\r\170\011\005\015\170\011\005\011\005\011\005\002\170\b\026\011\005\011\005\011\005\011\005\011\005\011\005\011\005\022>\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\b\006\011\005\011\005\022\254\011\005\011\005\007*\007B\007\166\029\226\011\005\011\005\011\005\011\005\011\005\r\162\011\005\011\005\011\005\011\005\011\005\005\r\011\005\011\005\tE\011\005\011\005\020B\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\030\242\001\222\011\005\011\005\011\005\011\005\011\017\011\017\025\234\b\"\016\170\011\017\014\150\011\017\011\017\017\230\011\017\011\017\011\017\011\017\014~\011\017\011\017\017\138\011\017\011\017\011\017\000\238\011\017\011\017\011\017\011\017\014\154\011\017\000\238\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\014\130\011\017\025\242\011\017\018\202\011\017\011\017\011\017\011\017\011\017\006\181\011\017\011\017\002\158\011\017\015\214\011\017\011\017\011\017\007J\019r\011\017\011\017\011\017\011\017\011\017\011\017\011\017\005\r\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\004\182\011\017\011\017\023F\011\017\011\017\023.\018\030\007\166\001\206\011\017\011\017\011\017\011\017\011\017\005\002\011\017\011\017\011\017\011\017\011\017\017\142\011\017\011\017\005f\011\017\011\017\020^\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\014\194\000\238\011\017\011\017\011\017\011\017\011!\011!\021\234\b\"\029r\011!\014\226\011!\011!\001\206\011!\011!\011!\011!\018\158\011!\011!\014\198\011!\011!\011!\000\238\011!\011!\011!\011!\014\230\011!\r\162\011!\011!\011!\011!\011!\011!\011!\011!\006\174\011!\023N\011!\018\"\011!\011!\011!\011!\011!\005\r\011!\011!\027\n\011!\015\250\011!\011!\011!\002\198\007\234\011!\011!\011!\011!\011!\011!\011!\025\202\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\002\198\011!\011!\n\138\011!\011!\n\150\005\r\001\002\001\190\011!\011!\011!\011!\011!\005\r\011!\011!\011!\011!\011!\r\162\011!\011!\019\022\011!\011!\000\238\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\001\002\001\190\011!\011!\011!\011!\011\025\011\025\0222\003F\003J\011\025\015\n\011\025\011\025\002\198\011\025\011\025\011\025\011\025\0152\011\025\011\025\007v\011\025\011\025\011\025\n\218\011\025\011\025\011\025\011\025\002!\011\025\015\014\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\0156\011\025\022\150\011\025\015^\011\025\011\025\011\025\011\025\011\025\021*\011\025\011\025\002\158\011\025\016\030\011\025\011\025\011\025\n\130\n\178\011\025\011\025\011\025\011\025\011\025\011\025\011\025\026\018\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\003\190\011\025\011\025\n\138\011\025\011\025\n\150\022\210\007\166\006V\011\025\011\025\011\025\011\025\011\025\006\197\011\025\011\025\011\025\011\025\011\025\006n\011\025\011\025\000\238\011\025\011\025\030\138\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\001\002\001\190\011\025\011\025\011\025\011\025\011\145\011\145\022\218\b\"\014n\011\145\014\178\011\145\011\145\0317\011\145\011\145\011\145\011\145\006j\011\145\011\145\015\n\011\145\011\145\011\145\000\238\011\145\011\145\011\145\011\145\015\130\011\145\015\246\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\014.\011\145\016z\011\145\006\194\011\145\011\145\011\145\011\145\011\145\006\193\011\145\011\145\027\"\011\145\016:\011\145\011\145\011\145\023\006\014~\011\145\011\145\011\145\011\145\011\145\011\145\011\145\007.\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\001\206\011\145\011\145\015\166\011\145\011\145\025\246\025\238\001\002\001\190\011\145\011\145\011\145\011\145\011\145\014e\011\145\011\145\011\145\011\145\011\145\014\150\011\145\011\145\tA\011\145\011\145\t\253\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\011\145\015\210\030R\011\145\011\145\011\145\011\145\004Y\004Y\t\017\014\194\006\185\004Y\017z\004Y\004Y\023N\004Y\004Y\004Y\004Y\007>\004Y\004Y\014\226\004Y\004Y\004Y\000\238\004Y\004Y\004Y\004Y\016\026\004Y\017~\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\016n\004Y\b\130\004Y\000\238\004Y\004Y\004Y\004Y\004Y\000\238\004Y\004Y\019\150\004Y\000\238\004Y\004Y\004Y\026\130\0152\004Y\004Y\004Y\004Y\004Y\004Y\004Y\t\253\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\023\142\nB\n\198\016\134\004Y\004Y\007~\031w\007\138\004\242\004Y\004Y\004Y\004Y\004Y\028\238\004Y\004Y\004Y\004Y\nJ\017R\n\206\004Y\t9\004Y\004Y\n\001\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\017V\004Y\004Y\004Y\004Y\004Y\0021\0021\018\218\000\238\018*\0021\0049\002\198\0021\000\238\002\146\0021\n~\0021\017\190\002\254\0021\t\166\0021\0021\0021\000\238\0021\0021\0021\001\210\018.\n\182\t\190\003\002\0021\0021\0021\0021\0021\n\190\0021\017\194\003\006\019\154\003\166\027>\0021\0021\0021\0021\0021\029\250\003\238\001\190\004R\0021\030\174\0021\0021\002\186\023\162\017\238\003\246\0021\0021\0021\b\190\b\194\b\206\n\001\014\206\005\174\0021\0021\0021\0021\0021\0021\0021\0021\0021\0262\nB\n\198\017\242\0021\0021\t\234\n\134\n\174\rn\005\186\005\190\0021\0021\0021\n\186\0021\0021\0021\0021\014\214\t5\015R\0021\030\238\0021\0021\023:\0021\0021\0021\0021\0021\0021\005\194\b\214\0021\0021\0021\b\238\004\130\023r\n\202\0021\0021\0021\0021\011y\011y\029\166\b6\027\226\011y\r\142\002\198\011y\000\238\002\146\011y\011y\011y\027\022\002\254\011y\b6\011y\011y\011y\027\162\011y\011y\011y\001\210\023\166\011y\030\178\003\002\011y\011y\011y\011y\011y\011y\011y\b6\003\006\026R\003\166\027\166\011y\011y\011y\011y\011y\028\198\003\238\001\190\000\238\011y\r\190\011y\011y\002\186\026z\r\214\003\246\011y\011y\011y\b\190\b\194\b\206\005\161\011y\005\174\011y\011y\011y\011y\011y\011y\011y\011y\011y\014q\011y\011y\026\178\011y\011y\016\158\005%\016\186\028\250\005\186\005\190\011y\011y\011y\016\218\011y\011y\011y\011y\011y\027\230\011y\011y\018z\011y\011y\027v\011y\011y\011y\011y\011y\011y\005\194\b\214\011y\011y\011y\b\238\004\130\018\162\029\222\011y\011y\011y\011y\011u\011u\002\234\b6\030~\011u\004\014\002\198\011u\018\190\002\146\011u\011u\011u\018\194\002\254\011u\028\202\011u\011u\011u\018\234\011u\011u\011u\001\210\018\254\011u\019\030\003\002\011u\011u\011u\011u\011u\011u\011u\019.\003\006\019B\003\166\019n\011u\011u\011u\011u\011u\019\214\003\238\001\190\019\222\011u\021\"\011u\011u\002\186\028\254\0216\003\246\011u\011u\011u\b\190\b\194\b\206\021:\011u\005\174\011u\011u\011u\011u\011u\011u\011u\011u\011u\006\190\011u\011u\029\238\011u\011u\021\254\022\022\022\166\022\170\005\186\005\190\011u\011u\011u\022\226\011u\011u\011u\011u\011u\030\130\011u\011u\022\230\011u\011u\023\014\011u\011u\011u\011u\011u\011u\005\194\b\214\011u\011u\011u\b\238\004\130\023\018\023*\011u\011u\011u\011u\002\133\002\133\023\214\023\218\023\254\002\133\024\002\002\198\002\133\024\018\002\146\002\133\n~\002\133\024\"\002\254\002\133\024.\002\133\002\133\002\133\024b\002\133\002\133\002\133\001\210\002\001\n\182\024f\003\002\002\133\002\133\002\133\002\133\002\133\n\190\002\133\024\182\003\006\024\222\003\166\005\r\002\133\002\133\002\133\002\133\002\133\024\226\003\238\001\190\024\242\002\133\000\n\002\133\002\133\002\186\025B\025b\003\246\002\133\002\133\002\133\b\190\b\194\b\206\025\162\014\206\005\174\002\133\002\133\002\133\002\133\002\133\002\133\002\133\002\133\002\133\025\198\005y\002\133\002\001\002\133\002\133\005\r\007\002\002\198\005\r\005\186\005\190\002\133\002\133\002\133\025\214\002\133\002\133\002\133\002\133\025\254\000\238\005\r\002\133\005y\002\133\002\133\005\r\002\133\002\133\002\133\002\133\002\133\002\133\005\194\b\214\002\133\002\133\002\133\b\238\004\130\026\002\005\r\002\133\002\133\002\133\002\133\005\r\007\166\005\r\003\178\005\r\005\r\005\r\005\r\005\r\005\r\005\r\021\150\005\r\000\238\005\r\005\r\026\014\005\r\005\r\005\r\020\026\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\026\030\005\r\005\r\026:\026J\005\r\005\r\000\238\005\r\005\r\005\r\005\r\005\r\b\"\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\000\238\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\000\238\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\t\229\004^\005\r\026^\026\138\005\r\005\r\005\r\000\238\005\r\000\n\007\217\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\018n\025\186\005\r\005\r\002\001\002\001\b.\005\r\004R\007\217\026\142\005\r\005\r\007\217\b6\020\030\026*\002\001\000\238\005\r\005\r\005\r\b:\026\154\005\r\005\r\005\r\005\r\005\201\000\129\005\r\000\129\026\170\000\129\000\129\000\129\000\129\000\129\000\129\000\129\005\201\000\129\026\222\000\129\000\129\026\190\000\129\000\129\027\178\028\n\000\129\000\129\0282\000\129\000\129\000\129\000\129\028\166\000\129\004b\000\129\000\129\t\229\028\174\000\129\000\129\r\201\000\129\000\129\000\129\005\201\000\129\n)\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\007\217\029\006\000\129\000\129\r\201\r\201\000\129\000\129\r\201\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\004*\005\201\000\129\na\005\201\000\129\029\022\000\129\029\"\000\129\002\198\001b\014\005\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\029\134\029\154\029\202\000\129\001z\na\001\138\000\238\000\222\029\210\002\182\014\005\000\129\030\n\0302\030j\017\154\002R\000\129\000\129\000\129\000\129\030\154\030\166\000\129\000\129\000\129\000\129\002}\002}\002V\003\178\030\187\002}\030\203\002\198\002}\r\201\002\146\002}\nN\002}\030\222\002\254\002}\030\250\002}\002}\002}\019\246\002}\002}\002}\001\210\016r\031\023\016~\003\002\002}\002}\002}\002}\002}\031'\002}\031C\003\006\031\151\003\166\019\250\002}\002}\002}\002}\002}\031\179\003\238\b\210\031\190\002}\031\243\002}\002}\002\186 \007 \015\003\246\002}\002}\002}\b\190\b\194\b\206\nB\n\198\005\174\002}\002}\002}\002}\002}\002}\002}\002}\002} K\nB\n\198 S\002}\002}\000\000\nJ\000\000\n\206\005\186\005\190\002}\002}\002}\000\000\002}\002}\002}\002}\nJ\000\000\n\206\002}\000\000\002}\002}\000\000\002}\002}\002}\002}\002}\002}\005\194\b\214\002}\002}\002}\b\238\004\130\002\001\002\001\002}\002}\002}\002}\002\145\002\145\t\254\019\254\006e\002\145\020\014\002\198\002\145\000\000\000\000\002\145\n\018\002\145\003j\000\000\002\145\003\146\002\145\002\145\002\145\000\n\002\145\002\145\002\145\001\210\000\000\000\000\000\000\000\000\002\145\002\145\002\145\002\145\002\145\000\000\002\145\002\001\002\001\020~\000\000\000\000\002\145\002\145\002\145\002\145\002\145\006e\003\154\002\001\000\000\002\145\002\001\002\145\002\145\002\186\000\000\006\202\000\000\002\145\002\145\002\145\000\000\021\230\000\n\006e\000\000\000\000\002\145\002\145\002\145\002\145\002\145\002\145\002\145\002\145\002\145\006\206\nB\n\198\000\000\002\145\002\145\007j\000\000\000\000\002\198\000\000\000\000\002\145\002\145\002\145\002\001\002\145\002\145\002\145\002\145\nJ\018\150\n\206\002\145\002\146\002\145\002\145\001\210\002\145\002\145\002\145\002\145\002\145\002\145\t\209\000\000\002\145\002\145\002\145\002\001\025\170\000\238\000\000\002\145\002\145\002\145\002\145\002\141\002\141\000\000\026\230\003\178\002\141\026\234\000\000\002\141\000\000\002\186\002\141\000\000\002\141\000\000\018\154\002\141\027\026\002\141\002\141\002\141\000\n\002\141\002\141\002\141\000\000\t\209\000\000\000\000\018\166\002\141\002\141\002\141\002\141\002\141\000\000\002\141\002\001\006~\005u\027*\006\"\002\141\002\141\002\141\002\141\002\141\t\209\006\158\002\001\002\001\002\141\006\170\002\141\002\141\005\190\000\000\000\000\006\254\002\141\002\141\002\141\005u\000\000\000\000\000\000\000\000\000\000\002\141\002\141\002\141\002\141\002\141\002\141\002\141\002\141\002\141\000\000\nB\n\198\t\209\002\141\002\141\000\000\004\254\000\000\001\206\t\209\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\002\141\nJ\002\198\n\206\002\141\002\146\002\141\002\141\001\210\002\141\002\141\002\141\002\141\002\141\002\141\t\205\000\000\002\141\002\141\002\141\000\000\022\174\000\000\000\000\002\141\002\141\002\141\002\141\002\129\002\129\007\193\000\000\002\170\002\129\023&\003\190\002\129\000\000\002\186\002\129\000\000\002\129\000\000\021b\002\129\023>\002\129\002\129\002\129\007\006\002\129\002\129\002\129\007\193\t\205\000\000\000\000\018\166\002\129\002\129\002\129\002\129\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\002\129\002\129\002\129\t\205\t\n\001\190\001*\002\129\000\000\002\129\002\129\005\190\002\001\002\001\017Z\002\129\002\129\002\129\017n\017\130\017\146\000\000\000\000\000\000\002\129\002\129\002\129\002\129\002\129\002\129\002\129\002\129\002\129\000\000\nB\n\198\t\205\002\129\002\129\000\n\004\254\007\166\000\000\t\205\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\002\129\nJ\000\000\n\206\002\129\002\234\002\129\002\129\020R\002\129\002\129\002\129\002\129\002\129\002\129\002\001\014\142\002\129\002\129\002\129\000\000\005%\000\000\000\000\002\129\002\129\002\129\002\129\002)\002)\014\170\b\"\014\186\002)\r\193\003\190\002)\000\000\000\000\002)\000\000\002)\000\000\000\000\002)\b\142\002)\002)\002)\000\238\002)\002)\002)\r\193\r\193\000\000\000\000\r\193\002)\002)\002)\002)\002)\000\000\002)\b\146\005%\000\000\000\000\014\218\002)\002)\002)\002)\002)\000\000\t\n\017\206\000\000\002)\000\000\002)\002)\015\002\000\000\015*\017Z\002)\002)\002)\017n\017\130\017\146\b\130\020V\000\238\002)\002)\002)\002)\002)\002)\002)\002)\002)\000\000\000\238\002)\000\000\002)\002)\000\000\002\001\002\001\021\190\000\238\t)\002)\002)\002)\t)\002)\002)\002)\002)\r\193\000\000\002\001\002)\000\000\002)\002)\000\000\t\254\002)\002)\002)\002)\002)\000\n\n\162\002)\002)\n\018\000\000\n.\000\000\031\163\002)\002)\002)\002)\n\025\n\025\b\150\000\000\000\000\n\025\t)\006~\n\025\000\000\006\"\n\025\015\202\n\025\000\000\002\001\n\025\006\158\n\025\n\025\n\025\006\170\n\025\n\025\n\025\000\000\015\238\t)\016\018\020\238\n\025\n\025\n\025\n\025\n\025\000\000\n\025\000\000\000\000\n]\000\000\000\000\n\025\n\025\n\025\n\025\n\025\000\000\t\021\000\000\000\000\n\025\000\000\n\025\n\025\000\000\000\000\000\000\017\174\n\025\n\025\n\025\n]\000\000\004\254\000\000\000\000\002\254\n\025\n\025\n\025\n\025\n\025\n\025\n\025\n\025\n\025\000\000\000\000\n\025\000\000\n\025\n\025\000\000\003\026\000\000\000\000\000\238\000\000\n\025\n\025\n\025\000\000\n\025\n\025\n\025\n\025\003&\000\000\000\000\n\025\000\000\n\025\n\025\000\000\t\254\n\025\n\025\n\025\n\025\n\025\000\000\000\000\n\025\n\025\n\018\000\000\000\000\000\000\005\174\n\025\n\025\n\025\n\025\002\137\002\137\000\000\000\000\000\000\002\137\r\197\006~\002\137\000\000\006\"\002\137\000\000\002\137\000\000\005\186\002\137\006\158\002\137\002\137\002\137\006\170\002\137\002\137\002\137\r\197\r\197\000\000\000\000\r\197\002\137\002\137\002\137\002\137\002\137\000\000\002\137\t5\000\000\005\194\t5\000\000\002\137\002\137\002\137\002\137\002\137\000\000\000\000\000\000\000\000\002\137\000\000\002\137\002\137\000\000\000\000\000\000\0262\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\000\238\002\137\002\137\002\137\002\137\002\137\002\137\002\137\002\137\002\137\000\000\t5\002\137\000\000\002\137\002\137\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\002\137\t5\002\137\002\137\002\137\002\137\r\197\000\000\001\206\002\137\000\000\002\137\002\137\000\000\n\230\002\137\002\137\002\137\002\137\002\137\029\186\000\000\002\137\002\137\002\137\000\000\000\000\t5\000\000\002\137\002\137\002\137\002\137\n\t\n\t\000\000\000\000\000\000\n\t\007\221\004f\n\t\000\000\000\000\n\t\000\000\n\t\000\000\000\000\n\t\002\170\n\t\n\t\n\t\t5\n\t\n\t\n\t\007\221\000\000\000\000\000\000\007\221\n\t\n\t\n\t\n\t\n\t\000\000\n\t\000\000\000\000\000\000\000\000\000\000\n\t\n\t\n\t\n\t\n\t\004\222\004\170\004r\005\165\n\t\000\000\n\t\n\t\000\000\004.\004:\000\000\n\t\n\t\n\t\004F\000\000\000\000\000\000\000\000\000\238\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\000\000\000\000\n\t\000\000\n\t\n\t\000\000\000\000\000\000\000\000\000\238\t%\n\t\n\t\n\t\t%\n\t\n\t\n\t\n\t\007\221\000\000\000\000\n\t\000\000\n\t\n\t\000\000\t\254\n\t\n\t\n\t\n\t\n\t\000\000\000\000\n\t\n\t\n\018\000\000\r\254\000\000\000\000\n\t\n\t\n\t\n\t\003\193\003\193\000\000\000\000\000\000\003\193\t%\014\006\003\193\000\000\014\018\003\193\000\000\003\193\000\000\000\000\011&\014\030\003\193\011z\003\193\014*\003\193\003\193\003\193\000\000\000\000\t%\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003\193\000\000\000\000\007\245\000\000\000\000\003\193\003\193\012\030\0126\003\193\000\000\000\000\000\000\000\000\003\193\000\000\012N\003\193\000\000\000\000\000\000\007\245\003\193\003\193\000\238\007\245\000\000\004\254\000\000\000\000\000\000\003\193\003\193\011>\011\190\012f\012~\012\174\003\193\003\193\000\000\000\000\003\193\000\000\003\193\012\198\000\000\000\000\000\000\000\000\000\238\000\000\003\193\003\193\012\222\000\000\003\193\003\193\003\193\003\193\000\000\000\000\000\000\003\193\000\000\003\193\003\193\000\000\r>\003\193\rV\012\150\003\193\003\193\000\000\000\000\003\193\012\246\003\193\000\000\b\193\000\000\000\000\003\193\003\193\r\014\r&\002\233\002\233\000\000\000\000\000\000\002\233\005\158\b\193\002\233\000\000\006\"\002\233\000\000\002\233\000\000\000\000\002\233\b\193\002\233\002\233\002\233\b\193\002\233\002\233\002\233\000\000\000\000\000\000\000\000\000\000\002\233\002\233\002\233\002\233\002\233\000\000\002\233\000\000\000\000\007\225\000\000\000\000\002\233\002\233\002\233\002\233\002\233\000\000\000\000\000\000\000\000\002\233\000\000\002\233\002\233\000\000\000\000\000\000\007\225\002\233\002\233\002\233\007\225\000\000\000\000\000\000\000\000\000\000\002\233\002\233\002\233\002\233\002\233\002\233\002\233\002\233\002\233\000\000\000\000\002\233\000\000\002\233\002\233\000\000\000\000\000\000\000\000\b\221\000\000\002\233\002\233\002\233\000\000\002\233\002\233\002\233\002\233\000\000\000\000\000\000\002\233\000\000\002\233\002\233\000\000\t\254\002\233\002\233\002\233\002\233\002\233\000\000\000\000\002\233\002\233\n\018\000\000\b\221\000\000\000\000\002\233\002\233\002\233\002\233\002\229\002\229\000\000\000\000\000\000\002\229\b\202\b\221\002\229\000\000\006\"\002\229\000\000\002\229\000\000\000\000\002\229\b\221\002\229\002\229\002\229\b\221\002\229\002\229\002\229\000\000\000\000\000\000\000\000\000\000\002\229\002\229\002\229\002\229\002\229\000\000\002\229\000\000\000\000\000\000\000\000\000\000\002\229\002\229\002\229\002\229\002\229\000\000\000\000\000\000\000\000\002\229\000\000\002\229\002\229\000\000\000\000\000\000\000\000\002\229\002\229\002\229\000\000\000\000\000\000\000\000\000\000\000\000\002\229\002\229\011>\002\229\002\229\002\229\002\229\002\229\002\229\000\000\000\000\002\229\000\000\002\229\002\229\000\000\000\000\000\000\000\000\000\238\000\000\002\229\002\229\002\229\000\000\002\229\002\229\002\229\002\229\000\000\000\000\000\000\002\229\000\000\002\229\002\229\000\000\002\229\002\229\002\229\002\229\002\229\002\229\000\000\000\000\002\229\002\229\002\229\000\000\b\249\000\000\000\000\002\229\002\229\002\229\002\229\002\185\002\185\000\000\000\000\000\000\002\185\000\000\006~\002\185\000\000\006\"\002\185\000\000\002\185\000\000\000\000\002\185\b\249\002\185\002\185\002\185\b\249\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\185\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\185\000\000\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\185\002\185\002\185\002\185\002\185\000\000\000\000\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\b\241\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\002\185\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\t\254\002\185\002\185\002\185\002\185\002\185\000\000\000\000\002\185\002\185\n\018\000\000\b\241\000\000\000\000\002\185\002\185\002\185\002\185\002\181\002\181\000\000\000\000\000\000\002\181\000\000\014B\002\181\000\000\b\241\002\181\000\000\002\181\000\000\000\000\002\181\b\241\002\181\002\181\002\181\b\241\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\002\181\002\181\002\181\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\002\181\002\181\002\181\000\000\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\000\000\000\000\000\000\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\011>\002\181\002\181\002\181\002\181\002\181\002\181\000\000\000\000\002\181\000\000\002\181\002\181\000\000\000\000\000\000\000\000\000\238\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\002\181\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\002\181\002\181\002\181\002\181\002\181\002\181\000\000\000\000\002\181\002\181\002\181\000\000\b\189\000\000\000\000\002\181\002\181\002\181\002\181\002\209\002\209\000\000\000\000\000\000\002\209\000\000\b\189\002\209\000\000\006\"\002\209\000\000\002\209\000\000\000\000\002\209\b\189\002\209\002\209\002\209\b\189\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\000\000\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\000\000\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\000\000\000\000\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\000\000\002\209\002\209\000\000\000\000\000\000\000\000\000\238\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\002\209\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\t\254\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\002\209\n\018\000\000\017*\000\000\000\000\002\209\002\209\002\209\002\209\002\205\002\205\000\000\000\000\000\000\002\205\000\000\014\006\002\205\000\000\014\018\002\205\000\000\002\205\000\000\000\000\011&\014\030\002\205\002\205\002\205\014*\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\002\205\002\205\002\205\011\166\002\205\000\000\002\205\018\150\000\000\000\000\002\146\000\000\002\205\002\205\002\205\002\205\002\205\000\000\000\000\000\000\000\000\002\205\000\000\002\205\002\205\000\000\000\000\000\000\000\000\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\011>\011\190\002\205\002\205\002\205\002\205\002\205\000\000\018\154\002\205\000\000\002\205\002\205\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\002\205\018\166\002\205\002\205\002\205\002\205\000\000\000\000\000\000\002\205\000\000\002\205\002\205\000\000\002\205\002\205\002\205\002\205\002\205\002\205\000\000\000\000\002\205\002\205\002\205\000\000\000\000\005\190\000\000\002\205\002\205\002\205\002\205\002\241\002\241\000\000\000\000\000\000\002\241\000\000\002\014\002\241\000\000\002\146\002\241\000\000\002\241\000\000\000\000\002\241\000\000\002\241\002\241\002\241\029*\002\241\002\241\002\241\000\000\000\000\000\000\000\000\000\000\002\241\002\241\002\241\002\241\002\241\000\000\002\241\018\150\000\000\000\000\002\146\000\000\002\241\002\241\002\241\002\241\002\241\000\000\030\214\001\222\000\000\002\241\000\000\002\241\002\241\000\000\000\000\000\000\000\000\002\241\002\241\002\241\018\166\000\000\000\000\000\000\000\000\000\000\002\241\002\241\002\241\002\241\002\241\002\241\002\241\002\241\002\241\000\000\018\154\002\241\000\000\002\241\002\241\000\000\000\000\000\000\000\000\000\000\005\190\002\241\002\241\002\241\018\166\002\241\002\241\002\241\002\241\000\000\000\000\000\000\002\241\000\000\002\241\002\241\000\000\t\254\002\241\002\241\002\241\002\241\002\241\000\000\000\000\002\241\002\241\n\018\000\000\000\000\005\190\000\000\002\241\002\241\002\241\002\241\002\237\002\237\000\000\000\000\000\000\002\237\000\000\003\190\002\237\000\000\000\000\002\237\000\000\002\237\000\000\000\000\002\237\000\000\002\237\002\237\002\237\025\014\002\237\002\237\002\237\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\237\000\000\002\237\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\237\000\000\005\246\000\000\000\000\002\237\000\000\002\237\002\237\000\000\000\000\000\000\004\006\002\237\002\237\002\237\006\210\000\000\004\018\000\000\000\000\000\000\002\237\002\237\011>\002\237\002\237\002\237\002\237\002\237\002\237\000\000\000\000\002\237\000\000\002\237\002\237\000\000\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\000\000\002\237\002\237\002\237\002\237\000\000\000\000\000\000\002\237\000\000\002\237\002\237\000\000\002\237\002\237\002\237\002\237\002\237\002\237\000\000\000\000\002\237\002\237\002\237\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\177\002\177\000\000\000\000\000\000\002\177\000\000\002\198\002\177\000\000\000\000\002\177\000\000\002\177\000\000\000\000\002\177\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\002\177\002\177\002\177\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\002\177\002\177\002\177\000\000\n\210\003\178\000\000\002\177\000\000\002\177\002\177\000\000\000\000\000\000\000\000\002\177\002\177\002\177\014f\000\000\014v\000\000\000\000\000\000\002\177\002\177\002\177\002\177\002\177\002\177\002\177\002\177\002\177\000\000\000\000\002\177\000\000\002\177\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\002\177\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\t\254\002\177\002\177\002\177\002\177\002\177\000\000\000\000\002\177\002\177\n\018\000\000\000\000\000\000\000\000\002\177\002\177\002\177\002\177\002\173\002\173\000\000\000\000\000\000\002\173\000\000\002\198\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\002\173\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\173\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\173\000\000\015V\003\178\000\000\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\002\173\002\173\002\173\015z\000\000\015\158\000\000\000\000\000\000\002\173\002\173\011>\002\173\002\173\002\173\002\173\002\173\002\173\000\000\000\000\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\002\173\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\002\173\002\173\002\173\002\173\002\173\002\173\000\000\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\201\002\201\000\000\000\000\000\000\002\201\000\000\000\000\002\201\000\000\000\000\002\201\000\000\002\201\000\000\000\000\002\201\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\002\201\002\201\002\201\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\002\201\002\201\002\201\000\000\000\000\000\000\000\000\002\201\000\000\002\201\002\201\000\000\000\000\000\000\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\002\201\002\201\002\201\002\201\002\201\002\201\002\201\000\000\000\000\002\201\000\000\002\201\002\201\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\002\201\000\000\000\000\000\000\002\201\000\000\002\201\002\201\000\000\t\254\002\201\002\201\002\201\002\201\002\201\000\000\000\000\002\201\002\201\n\018\000\000\000\000\000\000\000\000\002\201\002\201\002\201\002\201\002\197\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\011&\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\011\166\002\197\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\197\000\000\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\011>\011\190\002\197\002\197\002\197\002\197\002\197\000\000\000\000\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\002\197\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\002\197\002\197\002\197\002\197\002\197\002\197\000\000\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\193\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\002\193\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\193\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\193\000\000\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\193\002\193\002\193\002\193\002\193\000\000\000\000\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\002\193\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\t\254\002\193\002\193\002\193\002\193\002\193\000\000\000\000\002\193\002\193\n\018\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\189\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\011&\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\011\166\002\189\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\002\189\000\000\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\011>\011\190\002\189\002\189\002\189\002\189\002\189\000\000\000\000\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\002\189\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\002\189\002\189\002\189\002\189\002\189\002\189\000\000\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\003\017\003\017\000\000\000\000\000\000\003\017\000\000\000\000\003\017\000\000\000\000\003\017\000\000\003\017\000\000\000\000\003\017\000\000\003\017\003\017\003\017\000\000\003\017\003\017\003\017\000\000\000\000\000\000\000\000\000\000\003\017\003\017\003\017\003\017\003\017\000\000\003\017\000\000\000\000\000\000\000\000\000\000\003\017\003\017\003\017\003\017\003\017\000\000\000\000\000\000\000\000\003\017\000\000\003\017\003\017\000\000\000\000\000\000\000\000\003\017\003\017\003\017\000\000\000\000\000\000\000\000\000\000\000\000\003\017\003\017\003\017\003\017\003\017\003\017\003\017\003\017\003\017\000\000\000\000\003\017\000\000\003\017\003\017\000\000\000\000\000\000\000\000\000\000\000\000\003\017\003\017\003\017\000\000\003\017\003\017\003\017\003\017\000\000\000\000\000\000\003\017\000\000\003\017\003\017\000\000\t\254\003\017\003\017\003\017\003\017\003\017\000\000\000\000\003\017\003\017\n\018\000\000\000\000\000\000\000\000\003\017\003\017\003\017\003\017\003\r\003\r\000\000\000\000\000\000\003\r\000\000\000\000\003\r\000\000\000\000\003\r\000\000\003\r\000\000\000\000\011&\000\000\003\r\003\r\003\r\000\000\003\r\003\r\003\r\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003\r\000\000\000\000\000\000\000\000\000\000\003\r\003\r\012\030\0126\003\r\000\000\000\000\000\000\000\000\003\r\000\000\012N\003\r\000\000\000\000\000\000\000\000\003\r\003\r\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\r\003\r\011>\011\190\012f\012~\012\174\003\r\003\r\000\000\000\000\003\r\000\000\003\r\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003\r\003\r\012\222\000\000\003\r\003\r\003\r\003\r\000\000\000\000\000\000\003\r\000\000\003\r\003\r\000\000\003\r\003\r\003\r\012\150\003\r\003\r\000\000\000\000\003\r\012\246\003\r\000\000\000\000\000\000\000\000\003\r\003\r\r\014\r&\002\225\002\225\000\000\000\000\000\000\002\225\000\000\000\000\002\225\000\000\000\000\002\225\000\000\002\225\000\000\000\000\002\225\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\225\000\000\000\000\000\000\000\000\002\225\000\000\002\225\002\225\000\000\000\000\000\000\000\000\002\225\002\225\002\225\000\000\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\225\002\225\002\225\002\225\002\225\000\000\000\000\002\225\000\000\002\225\002\225\000\000\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\002\225\000\000\000\000\000\000\002\225\000\000\002\225\002\225\000\000\t\254\002\225\002\225\002\225\002\225\002\225\000\000\000\000\002\225\002\225\n\018\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\221\002\221\000\000\000\000\000\000\002\221\000\000\000\000\002\221\000\000\000\000\002\221\000\000\002\221\000\000\000\000\011&\000\000\002\221\002\221\002\221\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\011\166\002\221\000\000\002\221\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\221\000\000\000\000\000\000\000\000\002\221\000\000\002\221\002\221\000\000\000\000\000\000\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\000\000\000\000\002\221\002\221\011>\011\190\002\221\002\221\002\221\002\221\002\221\000\000\000\000\002\221\000\000\002\221\002\221\000\000\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\000\000\002\221\002\221\002\221\002\221\000\000\000\000\000\000\002\221\000\000\002\221\002\221\000\000\002\221\002\221\002\221\002\221\002\221\002\221\000\000\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\217\002\217\000\000\000\000\000\000\002\217\000\000\000\000\002\217\000\000\000\000\002\217\000\000\002\217\000\000\000\000\002\217\000\000\002\217\002\217\002\217\000\000\002\217\002\217\002\217\000\000\000\000\000\000\000\000\000\000\002\217\002\217\002\217\002\217\002\217\000\000\002\217\000\000\000\000\000\000\000\000\000\000\002\217\002\217\002\217\002\217\002\217\000\000\000\000\000\000\000\000\002\217\000\000\002\217\002\217\000\000\000\000\000\000\000\000\002\217\002\217\002\217\000\000\000\000\000\000\000\000\000\000\000\000\002\217\002\217\002\217\002\217\002\217\002\217\002\217\002\217\002\217\000\000\000\000\002\217\000\000\002\217\002\217\000\000\000\000\000\000\000\000\000\000\000\000\002\217\002\217\002\217\000\000\002\217\002\217\002\217\002\217\000\000\000\000\000\000\002\217\000\000\002\217\002\217\000\000\t\254\002\217\002\217\002\217\002\217\002\217\000\000\000\000\002\217\002\217\n\018\000\000\000\000\000\000\000\000\002\217\002\217\002\217\002\217\002\213\002\213\000\000\000\000\000\000\002\213\000\000\000\000\002\213\000\000\000\000\002\213\000\000\002\213\000\000\000\000\011&\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\011\166\002\213\000\000\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\002\213\002\213\000\000\000\000\000\000\000\000\002\213\000\000\002\213\002\213\000\000\000\000\000\000\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\011>\011\190\002\213\002\213\002\213\002\213\002\213\000\000\000\000\002\213\000\000\002\213\002\213\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\002\213\000\000\000\000\000\000\002\213\000\000\002\213\002\213\000\000\002\213\002\213\002\213\002\213\002\213\002\213\000\000\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\002\213\002\213\002\213\002\213\003\001\003\001\000\000\000\000\000\000\003\001\000\000\000\000\003\001\000\000\000\000\003\001\000\000\003\001\000\000\000\000\003\001\000\000\003\001\003\001\003\001\000\000\003\001\003\001\003\001\000\000\000\000\000\000\000\000\000\000\003\001\003\001\003\001\003\001\003\001\000\000\003\001\000\000\000\000\000\000\000\000\000\000\003\001\003\001\003\001\003\001\003\001\000\000\000\000\000\000\000\000\003\001\000\000\003\001\003\001\000\000\000\000\000\000\000\000\003\001\003\001\003\001\000\000\000\000\000\000\000\000\000\000\000\000\003\001\003\001\003\001\003\001\003\001\003\001\003\001\003\001\003\001\000\000\000\000\003\001\000\000\003\001\003\001\000\000\000\000\000\000\000\000\000\000\000\000\003\001\003\001\003\001\000\000\003\001\003\001\003\001\003\001\000\000\000\000\000\000\003\001\000\000\003\001\003\001\000\000\t\254\003\001\003\001\003\001\003\001\003\001\000\000\000\000\003\001\003\001\n\018\000\000\000\000\000\000\000\000\003\001\003\001\003\001\003\001\002\253\002\253\000\000\000\000\000\000\002\253\000\000\000\000\002\253\000\000\000\000\002\253\000\000\002\253\000\000\000\000\011&\000\000\002\253\002\253\002\253\000\000\002\253\002\253\002\253\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\002\253\000\000\002\253\000\000\000\000\000\000\000\000\000\000\002\253\002\253\012\030\0126\002\253\000\000\000\000\000\000\000\000\002\253\000\000\002\253\002\253\000\000\000\000\000\000\000\000\002\253\002\253\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\253\002\253\011>\011\190\012f\012~\002\253\002\253\002\253\000\000\000\000\002\253\000\000\002\253\002\253\000\000\000\000\000\000\000\000\000\000\000\000\002\253\002\253\002\253\000\000\002\253\002\253\002\253\002\253\000\000\000\000\000\000\002\253\000\000\002\253\002\253\000\000\002\253\002\253\002\253\012\150\002\253\002\253\000\000\000\000\002\253\002\253\002\253\000\000\000\000\000\000\000\000\002\253\002\253\002\253\002\253\002\169\002\169\000\000\000\000\000\000\002\169\000\000\000\000\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\002\169\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\169\000\000\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\169\002\169\002\169\002\169\002\169\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\t\254\002\169\002\169\002\169\002\169\002\169\000\000\000\000\002\169\002\169\n\018\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\165\002\165\000\000\000\000\000\000\002\165\000\000\000\000\002\165\000\000\000\000\002\165\000\000\002\165\000\000\000\000\011&\000\000\002\165\002\165\002\165\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\011\166\002\165\000\000\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\165\000\000\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\011>\011\190\002\165\002\165\002\165\002\165\002\165\000\000\000\000\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\000\000\002\165\002\165\002\165\002\165\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\002\165\002\165\002\165\002\165\002\165\002\165\000\000\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\161\002\161\000\000\000\000\000\000\002\161\000\000\000\000\002\161\000\000\000\000\002\161\000\000\002\161\000\000\000\000\002\161\000\000\002\161\002\161\002\161\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\161\000\000\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\161\000\000\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\161\002\161\002\161\002\161\002\161\000\000\000\000\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\000\000\002\161\002\161\002\161\002\161\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\t\254\002\161\002\161\002\161\002\161\002\161\000\000\000\000\002\161\002\161\n\018\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\157\002\157\000\000\000\000\000\000\002\157\000\000\000\000\002\157\000\000\000\000\002\157\000\000\002\157\000\000\000\000\011&\000\000\002\157\002\157\002\157\000\000\002\157\002\157\002\157\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\002\157\000\000\002\157\000\000\000\000\000\000\000\000\000\000\002\157\002\157\012\030\0126\002\157\000\000\000\000\000\000\000\000\002\157\000\000\002\157\002\157\000\000\000\000\000\000\000\000\002\157\002\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\011>\011\190\012f\012~\002\157\002\157\002\157\000\000\000\000\002\157\000\000\002\157\002\157\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\002\157\000\000\002\157\002\157\002\157\002\157\000\000\000\000\000\000\002\157\000\000\002\157\002\157\000\000\002\157\002\157\002\157\012\150\002\157\002\157\000\000\000\000\002\157\002\157\002\157\000\000\000\000\000\000\000\000\002\157\002\157\002\157\002\157\003Q\003Q\000\000\000\000\000\000\003Q\000\000\000\000\003Q\000\000\000\000\003Q\000\000\003Q\000\000\000\000\003Q\000\000\003Q\003Q\003Q\000\000\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\003Q\003Q\003Q\003Q\003Q\000\000\003Q\000\000\000\000\000\000\000\000\000\000\003Q\003Q\003Q\003Q\003Q\000\000\000\000\000\000\000\000\003Q\000\000\003Q\003Q\000\000\000\000\000\000\000\000\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\000\000\003Q\003Q\003Q\003Q\003Q\003Q\003Q\003Q\003Q\000\000\000\000\003Q\000\000\003Q\003Q\000\000\000\000\000\000\000\000\000\000\000\000\003Q\003Q\003Q\000\000\003Q\003Q\003Q\003Q\000\000\000\000\000\000\003Q\000\000\003Q\003Q\000\000\t\254\003Q\003Q\003Q\003Q\003Q\000\000\000\000\003Q\003Q\n\018\000\000\000\000\000\000\000\000\003Q\003Q\003Q\003Q\003M\003M\000\000\000\000\000\000\003M\000\000\000\000\003M\000\000\000\000\003M\000\000\003M\000\000\000\000\011&\000\000\003M\003M\003M\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\003M\000\000\003M\000\000\000\000\000\000\000\000\000\000\003M\003M\012\030\0126\003M\000\000\000\000\000\000\000\000\003M\000\000\003M\003M\000\000\000\000\000\000\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\000\000\000\000\003M\003M\011>\011\190\012f\003M\003M\003M\003M\000\000\000\000\003M\000\000\003M\003M\000\000\000\000\000\000\000\000\000\000\000\000\003M\003M\003M\000\000\003M\003M\003M\003M\000\000\000\000\000\000\003M\000\000\003M\003M\000\000\003M\003M\003M\012\150\003M\003M\000\000\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\003M\003M\003M\003M\002\153\002\153\000\000\000\000\000\000\002\153\000\000\000\000\002\153\000\000\000\000\002\153\000\000\002\153\000\000\000\000\002\153\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\153\000\000\002\153\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\153\000\000\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\153\002\153\002\153\002\153\002\153\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\002\153\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\t\254\002\153\002\153\002\153\002\153\002\153\000\000\000\000\002\153\002\153\n\018\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\149\002\149\000\000\000\000\000\000\002\149\000\000\000\000\002\149\000\000\000\000\002\149\000\000\002\149\000\000\000\000\011&\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\002\149\000\000\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\012\030\0126\002\149\000\000\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\000\000\000\000\000\000\002\149\002\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\011>\011\190\012f\012~\002\149\002\149\002\149\000\000\000\000\002\149\000\000\002\149\002\149\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\002\149\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\002\149\002\149\002\149\012\150\002\149\002\149\000\000\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\002\149\002\149\002\149\002\149\003\t\003\t\000\000\000\000\000\000\003\t\000\000\000\000\003\t\000\000\000\000\003\t\000\000\003\t\000\000\000\000\003\t\000\000\003\t\003\t\003\t\000\000\003\t\003\t\003\t\000\000\000\000\000\000\000\000\000\000\003\t\003\t\003\t\003\t\003\t\000\000\003\t\000\000\000\000\000\000\000\000\000\000\003\t\003\t\003\t\003\t\003\t\000\000\000\000\000\000\000\000\003\t\000\000\003\t\003\t\000\000\000\000\000\000\000\000\003\t\003\t\003\t\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\003\t\003\t\003\t\003\t\003\t\003\t\003\t\000\000\000\000\003\t\000\000\003\t\003\t\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\003\t\000\000\003\t\003\t\003\t\003\t\000\000\000\000\000\000\003\t\000\000\003\t\003\t\000\000\t\254\003\t\003\t\003\t\003\t\003\t\000\000\000\000\003\t\003\t\n\018\000\000\000\000\000\000\000\000\003\t\003\t\003\t\003\t\003\005\003\005\000\000\000\000\000\000\003\005\000\000\000\000\003\005\000\000\000\000\003\005\000\000\003\005\000\000\000\000\011&\000\000\003\005\003\005\003\005\000\000\003\005\003\005\003\005\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\003\005\000\000\003\005\000\000\000\000\000\000\000\000\000\000\003\005\003\005\012\030\0126\003\005\000\000\000\000\000\000\000\000\003\005\000\000\003\005\003\005\000\000\000\000\000\000\000\000\003\005\003\005\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\005\003\005\011>\011\190\012f\012~\003\005\003\005\003\005\000\000\000\000\003\005\000\000\003\005\003\005\000\000\000\000\000\000\000\000\000\000\000\000\003\005\003\005\003\005\000\000\003\005\003\005\003\005\003\005\000\000\000\000\000\000\003\005\000\000\003\005\003\005\000\000\003\005\003\005\003\005\012\150\003\005\003\005\000\000\000\000\003\005\003\005\003\005\000\000\000\000\000\000\000\000\003\005\003\005\003\005\003\005\002\249\002\249\000\000\000\000\000\000\002\249\000\000\000\000\002\249\000\000\000\000\002\249\000\000\002\249\000\000\000\000\002\249\000\000\002\249\002\249\002\249\000\000\002\249\002\249\002\249\000\000\000\000\000\000\000\000\000\000\002\249\002\249\002\249\002\249\002\249\000\000\002\249\000\000\000\000\000\000\000\000\000\000\002\249\002\249\002\249\002\249\002\249\000\000\000\000\000\000\000\000\002\249\000\000\002\249\002\249\000\000\000\000\000\000\000\000\002\249\002\249\002\249\000\000\000\000\000\000\000\000\000\000\000\000\002\249\002\249\002\249\002\249\002\249\002\249\002\249\002\249\002\249\000\000\000\000\002\249\000\000\002\249\002\249\000\000\000\000\000\000\000\000\000\000\000\000\002\249\002\249\002\249\000\000\002\249\002\249\002\249\002\249\000\000\000\000\000\000\002\249\000\000\002\249\002\249\000\000\t\254\002\249\002\249\002\249\002\249\002\249\000\000\000\000\002\249\002\249\n\018\000\000\000\000\000\000\000\000\002\249\002\249\002\249\002\249\002\245\002\245\000\000\000\000\000\000\002\245\000\000\000\000\002\245\000\000\000\000\002\245\000\000\002\245\000\000\000\000\011&\000\000\002\245\002\245\002\245\000\000\002\245\002\245\002\245\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\002\245\000\000\002\245\000\000\000\000\000\000\000\000\000\000\002\245\002\245\012\030\0126\002\245\000\000\000\000\000\000\000\000\002\245\000\000\002\245\002\245\000\000\000\000\000\000\000\000\002\245\002\245\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\245\002\245\011>\011\190\012f\012~\002\245\002\245\002\245\000\000\000\000\002\245\000\000\002\245\002\245\000\000\000\000\000\000\000\000\000\000\000\000\002\245\002\245\002\245\000\000\002\245\002\245\002\245\002\245\000\000\000\000\000\000\002\245\000\000\002\245\002\245\000\000\002\245\002\245\002\245\012\150\002\245\002\245\000\000\000\000\002\245\002\245\002\245\000\000\000\000\000\000\000\000\002\245\002\245\002\245\002\245\003\025\003\025\000\000\000\000\000\000\003\025\000\000\000\000\003\025\000\000\000\000\003\025\000\000\003\025\000\000\000\000\003\025\000\000\003\025\003\025\003\025\000\000\003\025\003\025\003\025\000\000\000\000\000\000\000\000\000\000\003\025\003\025\003\025\003\025\003\025\000\000\003\025\000\000\000\000\000\000\000\000\000\000\003\025\003\025\003\025\003\025\003\025\000\000\000\000\000\000\000\000\003\025\000\000\003\025\003\025\000\000\000\000\000\000\000\000\003\025\003\025\003\025\000\000\000\000\000\000\000\000\000\000\000\000\003\025\003\025\003\025\003\025\003\025\003\025\003\025\003\025\003\025\000\000\000\000\003\025\000\000\003\025\003\025\000\000\000\000\000\000\000\000\000\000\000\000\003\025\003\025\003\025\000\000\003\025\003\025\003\025\003\025\000\000\000\000\000\000\003\025\000\000\003\025\003\025\000\000\t\254\003\025\003\025\003\025\003\025\003\025\000\000\000\000\003\025\003\025\n\018\000\000\000\000\000\000\000\000\003\025\003\025\003\025\003\025\003\021\003\021\000\000\000\000\000\000\003\021\000\000\000\000\003\021\000\000\000\000\003\021\000\000\003\021\000\000\000\000\011&\000\000\003\021\003\021\003\021\000\000\003\021\003\021\003\021\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003\021\000\000\000\000\000\000\000\000\000\000\003\021\003\021\012\030\0126\003\021\000\000\000\000\000\000\000\000\003\021\000\000\012N\003\021\000\000\000\000\000\000\000\000\003\021\003\021\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\021\003\021\011>\011\190\012f\012~\012\174\003\021\003\021\000\000\000\000\003\021\000\000\003\021\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003\021\003\021\012\222\000\000\003\021\003\021\003\021\003\021\000\000\000\000\000\000\003\021\000\000\003\021\003\021\000\000\003\021\003\021\003\021\012\150\003\021\003\021\000\000\000\000\003\021\012\246\003\021\000\000\000\000\000\000\000\000\003\021\003\021\r\014\r&\003!\003!\000\000\000\000\000\000\003!\000\000\000\000\003!\000\000\000\000\003!\000\000\003!\000\000\000\000\003!\000\000\003!\003!\003!\000\000\003!\003!\003!\000\000\000\000\000\000\000\000\000\000\003!\003!\003!\003!\003!\000\000\003!\000\000\000\000\000\000\000\000\000\000\003!\003!\003!\003!\003!\000\000\000\000\000\000\000\000\003!\000\000\003!\003!\000\000\000\000\000\000\000\000\003!\003!\003!\000\000\000\000\000\000\000\000\000\000\000\000\003!\003!\003!\003!\003!\003!\003!\003!\003!\000\000\000\000\003!\000\000\003!\003!\000\000\000\000\000\000\000\000\000\000\000\000\003!\003!\003!\000\000\003!\003!\003!\003!\000\000\000\000\000\000\003!\000\000\003!\003!\000\000\t\254\003!\003!\003!\003!\003!\000\000\000\000\003!\003!\n\018\000\000\000\000\000\000\000\000\003!\003!\003!\003!\003\029\003\029\000\000\000\000\000\000\003\029\000\000\000\000\003\029\000\000\000\000\003\029\000\000\003\029\000\000\000\000\011&\000\000\003\029\003\029\003\029\000\000\003\029\003\029\003\029\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\003\029\000\000\003\029\000\000\000\000\000\000\000\000\000\000\003\029\003\029\012\030\0126\003\029\000\000\000\000\000\000\000\000\003\029\000\000\012N\003\029\000\000\000\000\000\000\000\000\003\029\003\029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\029\003\029\011>\011\190\012f\012~\012\174\003\029\003\029\000\000\000\000\003\029\000\000\003\029\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003\029\003\029\012\222\000\000\003\029\003\029\003\029\003\029\000\000\000\000\000\000\003\029\000\000\003\029\003\029\000\000\003\029\003\029\003\029\012\150\003\029\003\029\000\000\000\000\003\029\003\029\003\029\000\000\000\000\000\000\000\000\003\029\003\029\r\014\r&\003)\003)\000\000\000\000\000\000\003)\000\000\000\000\003)\000\000\000\000\003)\000\000\003)\000\000\000\000\003)\000\000\003)\003)\003)\000\000\003)\003)\003)\000\000\000\000\000\000\000\000\000\000\003)\003)\003)\003)\003)\000\000\003)\000\000\000\000\000\000\000\000\000\000\003)\003)\003)\003)\003)\000\000\000\000\000\000\000\000\003)\000\000\003)\003)\000\000\000\000\000\000\000\000\003)\003)\003)\000\000\000\000\000\000\000\000\000\000\000\000\003)\003)\003)\003)\003)\003)\003)\003)\003)\000\000\000\000\003)\000\000\003)\003)\000\000\000\000\000\000\000\000\000\000\000\000\003)\003)\003)\000\000\003)\003)\003)\003)\000\000\000\000\000\000\003)\000\000\003)\003)\000\000\t\254\003)\003)\003)\003)\003)\000\000\000\000\003)\003)\n\018\000\000\000\000\000\000\000\000\003)\003)\003)\003)\003%\003%\000\000\000\000\000\000\003%\000\000\000\000\003%\000\000\000\000\003%\000\000\003%\000\000\000\000\011&\000\000\003%\003%\003%\000\000\003%\003%\003%\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\003%\000\000\003%\000\000\000\000\000\000\000\000\000\000\003%\003%\012\030\0126\003%\000\000\000\000\000\000\000\000\003%\000\000\012N\003%\000\000\000\000\000\000\000\000\003%\003%\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003%\003%\011>\011\190\012f\012~\012\174\003%\003%\000\000\000\000\003%\000\000\003%\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003%\003%\012\222\000\000\003%\003%\003%\003%\000\000\000\000\000\000\003%\000\000\003%\003%\000\000\003%\003%\003%\012\150\003%\003%\000\000\000\000\003%\003%\003%\000\000\000\000\000\000\000\000\003%\003%\r\014\r&\n\017\n\017\000\000\000\000\000\000\n\017\000\000\000\000\n\017\000\000\000\000\n\017\000\000\n\017\000\000\000\000\n\017\000\000\n\017\n\017\n\017\000\000\n\017\n\017\n\017\000\000\000\000\000\000\000\000\000\000\n\017\n\017\n\017\n\017\n\017\000\000\n\017\000\000\000\000\000\000\000\000\000\000\n\017\n\017\n\017\n\017\n\017\000\000\000\000\000\000\000\000\n\017\000\000\n\017\n\017\000\000\000\000\000\000\000\000\n\017\n\017\n\017\000\000\000\000\000\000\000\000\000\000\000\000\n\017\n\017\n\017\n\017\n\017\n\017\n\017\n\017\n\017\000\000\000\000\n\017\000\000\n\017\n\017\000\000\000\000\000\000\000\000\000\000\000\000\n\017\n\017\n\017\000\000\n\017\n\017\n\017\n\017\000\000\000\000\000\000\n\017\000\000\n\017\n\017\000\000\t\254\n\017\n\017\n\017\n\017\n\017\000\000\000\000\n\017\n\017\n\018\000\000\000\000\000\000\000\000\n\017\n\017\n\017\n\017\n\r\n\r\000\000\000\000\000\000\n\r\000\000\000\000\n\r\000\000\000\000\n\r\000\000\n\r\000\000\000\000\011&\000\000\n\r\n\r\n\r\000\000\n\r\n\r\n\r\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\n\r\000\000\000\000\000\000\000\000\000\000\n\r\n\r\012\030\0126\n\r\000\000\000\000\000\000\000\000\n\r\000\000\012N\n\r\000\000\000\000\000\000\000\000\n\r\n\r\000\238\000\000\000\000\000\000\000\000\000\000\000\000\n\r\n\r\011>\011\190\012f\012~\012\174\n\r\n\r\000\000\000\000\n\r\000\000\n\r\012\198\000\000\000\000\000\000\000\000\000\000\000\000\n\r\n\r\012\222\000\000\n\r\n\r\n\r\n\r\000\000\000\000\000\000\n\r\000\000\n\r\n\r\000\000\n\r\n\r\n\r\012\150\n\r\n\r\000\000\000\000\n\r\012\246\n\r\000\000\000\000\000\000\000\000\n\r\n\r\r\014\r&\0031\0031\000\000\000\000\000\000\0031\000\000\000\000\0031\000\000\000\000\0031\000\000\0031\000\000\000\000\0031\000\000\0031\0031\0031\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\0031\0031\0031\0031\0031\000\000\0031\000\000\000\000\000\000\000\000\000\000\0031\0031\0031\0031\0031\000\000\000\000\000\000\000\000\0031\000\000\0031\0031\000\000\000\000\000\000\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\000\000\0031\0031\0031\0031\0031\0031\0031\0031\0031\000\000\000\000\0031\000\000\0031\0031\000\000\000\000\000\000\000\000\000\000\000\000\0031\0031\0031\000\000\0031\0031\0031\0031\000\000\000\000\000\000\0031\000\000\0031\0031\000\000\t\254\0031\0031\0031\0031\0031\000\000\000\000\0031\0031\n\018\000\000\000\000\000\000\000\000\0031\0031\0031\0031\003-\003-\000\000\000\000\000\000\003-\000\000\000\000\003-\000\000\000\000\003-\000\000\003-\000\000\000\000\011&\000\000\003-\003-\003-\000\000\003-\003-\003-\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003-\000\000\000\000\000\000\000\000\000\000\003-\003-\012\030\0126\003-\000\000\000\000\000\000\000\000\003-\000\000\012N\003-\000\000\000\000\000\000\000\000\003-\003-\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003-\003-\011>\011\190\012f\012~\012\174\003-\003-\000\000\000\000\003-\000\000\003-\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003-\003-\012\222\000\000\003-\003-\003-\003-\000\000\000\000\000\000\003-\000\000\003-\003-\000\000\r>\003-\rV\012\150\003-\003-\000\000\000\000\003-\012\246\003-\000\000\000\000\000\000\000\000\003-\003-\r\014\r&\n\005\n\005\000\000\000\000\000\000\n\005\000\000\000\000\n\005\000\000\000\000\n\005\000\000\n\005\000\000\000\000\011&\000\000\n\005\n\005\n\005\000\000\n\005\n\005\n\005\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\n\005\000\000\000\000\000\000\000\000\000\000\n\005\n\005\012\030\0126\n\005\000\000\000\000\000\000\000\000\n\005\000\000\012N\n\005\000\000\000\000\000\000\000\000\n\005\n\005\000\238\000\000\000\000\000\000\000\000\000\000\000\000\n\005\n\005\011>\011\190\012f\012~\012\174\n\005\n\005\000\000\000\000\n\005\000\000\n\005\012\198\000\000\000\000\000\000\000\000\000\000\000\000\n\005\n\005\012\222\000\000\n\005\n\005\n\005\n\005\000\000\000\000\000\000\n\005\000\000\n\005\n\005\000\000\n\005\n\005\n\005\012\150\n\005\n\005\000\000\000\000\n\005\012\246\n\005\000\000\000\000\000\000\000\000\n\005\n\005\r\014\r&\003\129\003\129\000\000\000\000\000\000\003\129\000\000\000\000\003\129\000\000\000\000\003\129\000\000\003\129\000\000\000\000\003\129\000\000\003\129\003\129\003\129\000\000\003\129\003\129\003\129\000\000\000\000\000\000\000\000\000\000\003\129\003\129\003\129\003\129\003\129\000\000\003\129\000\000\000\000\000\000\000\000\000\000\003\129\003\129\003\129\003\129\003\129\000\000\000\000\000\000\000\000\003\129\000\000\003\129\003\129\000\000\000\000\000\000\000\000\003\129\003\129\003\129\000\000\000\000\000\000\000\000\000\000\000\000\003\129\003\129\003\129\003\129\003\129\003\129\003\129\003\129\003\129\000\000\000\000\003\129\000\000\003\129\003\129\000\000\000\000\000\000\000\000\000\000\000\000\003\129\003\129\003\129\000\000\003\129\003\129\003\129\003\129\000\000\000\000\000\000\003\129\000\000\003\129\003\129\000\000\t\254\003\129\003\129\003\129\003\129\003\129\000\000\000\000\003\129\003\129\n\018\000\000\000\000\000\000\000\000\003\129\003\129\003\129\003\129\003}\003}\000\000\000\000\000\000\003}\000\000\000\000\003}\000\000\000\000\003}\000\000\003}\000\000\000\000\011&\000\000\003}\003}\003}\000\000\003}\003}\003}\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003}\000\000\000\000\000\000\000\000\000\000\003}\003}\012\030\0126\003}\000\000\000\000\000\000\000\000\003}\000\000\012N\003}\000\000\000\000\000\000\000\000\003}\003}\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003}\003}\011>\011\190\012f\012~\012\174\003}\003}\000\000\000\000\003}\000\000\003}\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003}\003}\012\222\000\000\003}\003}\003}\003}\000\000\000\000\000\000\003}\000\000\003}\003}\000\000\r>\003}\rV\012\150\003}\003}\000\000\000\000\003}\012\246\003}\000\000\000\000\000\000\000\000\003}\003}\r\014\r&\003\161\003\161\000\000\000\000\000\000\003\161\000\000\000\000\003\161\000\000\000\000\003\161\000\000\003\161\000\000\000\000\003\161\000\000\003\161\003\161\003\161\000\000\003\161\003\161\003\161\000\000\000\000\000\000\000\000\000\000\003\161\003\161\003\161\003\161\003\161\000\000\003\161\000\000\000\000\000\000\000\000\000\000\003\161\003\161\003\161\003\161\003\161\000\000\000\000\000\000\000\000\003\161\000\000\003\161\003\161\000\000\000\000\000\000\000\000\003\161\003\161\003\161\000\000\000\000\000\000\000\000\000\000\000\000\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\000\000\000\000\003\161\000\000\003\161\003\161\000\000\000\000\000\000\000\000\000\000\000\000\003\161\003\161\003\161\000\000\003\161\003\161\003\161\003\161\000\000\000\000\000\000\003\161\000\000\003\161\003\161\000\000\t\254\003\161\003\161\003\161\003\161\003\161\000\000\000\000\003\161\003\161\n\018\000\000\000\000\000\000\000\000\003\161\003\161\003\161\003\161\003\157\003\157\000\000\000\000\000\000\003\157\000\000\000\000\003\157\000\000\000\000\003\157\000\000\003\157\000\000\000\000\011&\000\000\003\157\003\157\003\157\000\000\003\157\003\157\003\157\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003\157\000\000\000\000\000\000\000\000\000\000\003\157\003\157\012\030\0126\003\157\000\000\000\000\000\000\000\000\003\157\000\000\012N\003\157\000\000\000\000\000\000\000\000\003\157\003\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\157\003\157\011>\011\190\012f\012~\012\174\003\157\003\157\000\000\000\000\003\157\000\000\003\157\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003\157\003\157\012\222\000\000\003\157\003\157\003\157\003\157\000\000\000\000\000\000\003\157\000\000\003\157\003\157\000\000\r>\003\157\rV\012\150\003\157\003\157\000\000\000\000\003\157\012\246\003\157\000\000\000\000\000\000\000\000\003\157\003\157\r\014\r&\003\145\003\145\000\000\000\000\000\000\003\145\000\000\000\000\003\145\000\000\000\000\003\145\000\000\003\145\000\000\000\000\003\145\000\000\003\145\003\145\003\145\000\000\003\145\003\145\003\145\000\000\000\000\000\000\000\000\000\000\003\145\003\145\003\145\003\145\003\145\000\000\003\145\000\000\000\000\000\000\000\000\000\000\003\145\003\145\003\145\003\145\003\145\000\000\000\000\000\000\000\000\003\145\000\000\003\145\003\145\000\000\000\000\000\000\000\000\003\145\003\145\003\145\000\000\000\000\000\000\000\000\000\000\000\000\003\145\003\145\003\145\003\145\003\145\003\145\003\145\003\145\003\145\000\000\000\000\003\145\000\000\003\145\003\145\000\000\000\000\000\000\000\000\000\000\000\000\003\145\003\145\003\145\000\000\003\145\003\145\003\145\003\145\000\000\000\000\000\000\003\145\000\000\003\145\003\145\000\000\t\254\003\145\003\145\003\145\003\145\003\145\000\000\000\000\003\145\003\145\n\018\000\000\000\000\000\000\000\000\003\145\003\145\003\145\003\145\003\141\003\141\000\000\000\000\000\000\003\141\000\000\000\000\003\141\000\000\000\000\003\141\000\000\003\141\000\000\000\000\011&\000\000\003\141\003\141\003\141\000\000\003\141\003\141\003\141\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003\141\000\000\000\000\000\000\000\000\000\000\003\141\003\141\012\030\0126\003\141\000\000\000\000\000\000\000\000\003\141\000\000\012N\003\141\000\000\000\000\000\000\000\000\003\141\003\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\141\003\141\011>\011\190\012f\012~\012\174\003\141\003\141\000\000\000\000\003\141\000\000\003\141\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003\141\003\141\012\222\000\000\003\141\003\141\003\141\003\141\000\000\000\000\000\000\003\141\000\000\003\141\003\141\000\000\r>\003\141\rV\012\150\003\141\003\141\000\000\000\000\003\141\012\246\003\141\000\000\000\000\000\000\000\000\003\141\003\141\r\014\r&\003i\003i\000\000\000\000\000\000\003i\000\000\000\000\003i\000\000\000\000\003i\000\000\003i\000\000\000\000\003i\000\000\003i\003i\003i\000\000\003i\003i\003i\000\000\000\000\000\000\000\000\000\000\003i\003i\003i\003i\003i\000\000\003i\000\000\000\000\000\000\000\000\000\000\003i\003i\003i\003i\003i\000\000\000\000\000\000\000\000\003i\000\000\003i\003i\000\000\000\000\000\000\000\000\003i\003i\003i\000\000\000\000\000\000\000\000\000\000\000\000\003i\003i\003i\003i\003i\003i\003i\003i\003i\000\000\000\000\003i\000\000\003i\003i\000\000\000\000\000\000\000\000\000\000\000\000\003i\003i\003i\000\000\003i\003i\003i\003i\000\000\000\000\000\000\003i\000\000\003i\003i\000\000\t\254\003i\003i\003i\003i\003i\000\000\000\000\003i\003i\n\018\000\000\000\000\000\000\000\000\003i\003i\003i\003i\003e\003e\000\000\000\000\000\000\003e\000\000\000\000\003e\000\000\000\000\003e\000\000\003e\000\000\000\000\011&\000\000\003e\003e\003e\000\000\003e\003e\003e\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003e\000\000\000\000\000\000\000\000\000\000\003e\003e\012\030\0126\003e\000\000\000\000\000\000\000\000\003e\000\000\012N\003e\000\000\000\000\000\000\000\000\003e\003e\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003e\003e\011>\011\190\012f\012~\012\174\003e\003e\000\000\000\000\003e\000\000\003e\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003e\003e\012\222\000\000\003e\003e\003e\003e\000\000\000\000\000\000\003e\000\000\003e\003e\000\000\r>\003e\rV\012\150\003e\003e\000\000\000\000\003e\012\246\003e\000\000\000\000\000\000\000\000\003e\003e\r\014\r&\003y\003y\000\000\000\000\000\000\003y\000\000\000\000\003y\000\000\000\000\003y\000\000\003y\000\000\000\000\003y\000\000\003y\003y\003y\000\000\003y\003y\003y\000\000\000\000\000\000\000\000\000\000\003y\003y\003y\003y\003y\000\000\003y\000\000\000\000\000\000\000\000\000\000\003y\003y\003y\003y\003y\000\000\000\000\000\000\000\000\003y\000\000\003y\003y\000\000\000\000\000\000\000\000\003y\003y\003y\000\000\000\000\000\000\000\000\000\000\000\000\003y\003y\003y\003y\003y\003y\003y\003y\003y\000\000\000\000\003y\000\000\003y\003y\000\000\000\000\000\000\000\000\000\000\000\000\003y\003y\003y\000\000\003y\003y\003y\003y\000\000\000\000\000\000\003y\000\000\003y\003y\000\000\t\254\003y\003y\003y\003y\003y\000\000\000\000\003y\003y\n\018\000\000\000\000\000\000\000\000\003y\003y\003y\003y\003u\003u\000\000\000\000\000\000\003u\000\000\000\000\003u\000\000\000\000\003u\000\000\003u\000\000\000\000\011&\000\000\003u\003u\003u\000\000\003u\003u\003u\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003u\000\000\000\000\000\000\000\000\000\000\003u\003u\012\030\0126\003u\000\000\000\000\000\000\000\000\003u\000\000\012N\003u\000\000\000\000\000\000\000\000\003u\003u\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003u\003u\011>\011\190\012f\012~\012\174\003u\003u\000\000\000\000\003u\000\000\003u\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003u\003u\012\222\000\000\003u\003u\003u\003u\000\000\000\000\000\000\003u\000\000\003u\003u\000\000\r>\003u\rV\012\150\003u\003u\000\000\000\000\003u\012\246\003u\000\000\000\000\000\000\000\000\003u\003u\r\014\r&\003q\003q\000\000\000\000\000\000\003q\000\000\000\000\003q\000\000\000\000\003q\000\000\003q\000\000\000\000\003q\000\000\003q\003q\003q\000\000\003q\003q\003q\000\000\000\000\000\000\000\000\000\000\003q\003q\003q\003q\003q\000\000\003q\000\000\000\000\000\000\000\000\000\000\003q\003q\003q\003q\003q\000\000\000\000\000\000\000\000\003q\000\000\003q\003q\000\000\000\000\000\000\000\000\003q\003q\003q\000\000\000\000\000\000\000\000\000\000\000\000\003q\003q\003q\003q\003q\003q\003q\003q\003q\000\000\000\000\003q\000\000\003q\003q\000\000\000\000\000\000\000\000\000\000\000\000\003q\003q\003q\000\000\003q\003q\003q\003q\000\000\000\000\000\000\003q\000\000\003q\003q\000\000\t\254\003q\003q\003q\003q\003q\000\000\000\000\003q\003q\n\018\000\000\000\000\000\000\000\000\003q\003q\003q\003q\003m\003m\000\000\000\000\000\000\003m\000\000\000\000\003m\000\000\000\000\003m\000\000\003m\000\000\000\000\011&\000\000\003m\003m\003m\000\000\003m\003m\003m\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003m\000\000\000\000\000\000\000\000\000\000\003m\003m\012\030\0126\003m\000\000\000\000\000\000\000\000\003m\000\000\012N\003m\000\000\000\000\000\000\000\000\003m\003m\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003m\003m\011>\011\190\012f\012~\012\174\003m\003m\000\000\000\000\003m\000\000\003m\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003m\003m\012\222\000\000\003m\003m\003m\003m\000\000\000\000\000\000\003m\000\000\003m\003m\000\000\r>\003m\rV\012\150\003m\003m\000\000\000\000\003m\012\246\003m\000\000\000\000\000\000\000\000\003m\003m\r\014\r&\003\137\003\137\000\000\000\000\000\000\003\137\000\000\000\000\003\137\000\000\000\000\003\137\000\000\003\137\000\000\000\000\003\137\000\000\003\137\003\137\003\137\000\000\003\137\003\137\003\137\000\000\000\000\000\000\000\000\000\000\003\137\003\137\003\137\003\137\003\137\000\000\003\137\000\000\000\000\000\000\000\000\000\000\003\137\003\137\003\137\003\137\003\137\000\000\000\000\000\000\000\000\003\137\000\000\003\137\003\137\000\000\000\000\000\000\000\000\003\137\003\137\003\137\000\000\000\000\000\000\000\000\000\000\000\000\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\000\000\000\000\003\137\000\000\003\137\003\137\000\000\000\000\000\000\000\000\000\000\000\000\003\137\003\137\003\137\000\000\003\137\003\137\003\137\003\137\000\000\000\000\000\000\003\137\000\000\003\137\003\137\000\000\t\254\003\137\003\137\003\137\003\137\003\137\000\000\000\000\003\137\003\137\n\018\000\000\000\000\000\000\000\000\003\137\003\137\003\137\003\137\003\133\003\133\000\000\000\000\000\000\003\133\000\000\000\000\003\133\000\000\000\000\003\133\000\000\003\133\000\000\000\000\011&\000\000\003\133\003\133\003\133\000\000\003\133\003\133\003\133\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003\133\000\000\000\000\000\000\000\000\000\000\003\133\003\133\012\030\0126\003\133\000\000\000\000\000\000\000\000\003\133\000\000\012N\003\133\000\000\000\000\000\000\000\000\003\133\003\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\133\003\133\011>\011\190\012f\012~\012\174\003\133\003\133\000\000\000\000\003\133\000\000\003\133\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003\133\003\133\012\222\000\000\003\133\003\133\003\133\003\133\000\000\000\000\000\000\003\133\000\000\003\133\003\133\000\000\r>\003\133\rV\012\150\003\133\003\133\000\000\000\000\003\133\012\246\003\133\000\000\000\000\000\000\000\000\003\133\003\133\r\014\r&\003\169\003\169\000\000\000\000\000\000\003\169\000\000\000\000\003\169\000\000\000\000\003\169\000\000\003\169\000\000\000\000\003\169\000\000\003\169\003\169\003\169\000\000\003\169\003\169\003\169\000\000\000\000\000\000\000\000\000\000\003\169\003\169\003\169\003\169\003\169\000\000\003\169\000\000\000\000\000\000\000\000\000\000\003\169\003\169\003\169\003\169\003\169\000\000\000\000\000\000\000\000\003\169\000\000\003\169\003\169\000\000\000\000\000\000\000\000\003\169\003\169\003\169\000\000\000\000\000\000\000\000\000\000\000\000\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\000\000\000\000\003\169\000\000\003\169\003\169\000\000\000\000\000\000\000\000\000\000\000\000\003\169\003\169\003\169\000\000\003\169\003\169\003\169\003\169\000\000\000\000\000\000\003\169\000\000\003\169\003\169\000\000\t\254\003\169\003\169\003\169\003\169\003\169\000\000\000\000\003\169\003\169\n\018\000\000\000\000\000\000\000\000\003\169\003\169\003\169\003\169\003\165\003\165\000\000\000\000\000\000\003\165\000\000\000\000\003\165\000\000\000\000\003\165\000\000\003\165\000\000\000\000\011&\000\000\003\165\003\165\003\165\000\000\003\165\003\165\003\165\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003\165\000\000\000\000\000\000\000\000\000\000\003\165\003\165\012\030\0126\003\165\000\000\000\000\000\000\000\000\003\165\000\000\012N\003\165\000\000\000\000\000\000\000\000\003\165\003\165\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\165\003\165\011>\011\190\012f\012~\012\174\003\165\003\165\000\000\000\000\003\165\000\000\003\165\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003\165\003\165\012\222\000\000\003\165\003\165\003\165\003\165\000\000\000\000\000\000\003\165\000\000\003\165\003\165\000\000\r>\003\165\rV\012\150\003\165\003\165\000\000\000\000\003\165\012\246\003\165\000\000\000\000\000\000\000\000\003\165\003\165\r\014\r&\003\153\003\153\000\000\000\000\000\000\003\153\000\000\000\000\003\153\000\000\000\000\003\153\000\000\003\153\000\000\000\000\003\153\000\000\003\153\003\153\003\153\000\000\003\153\003\153\003\153\000\000\000\000\000\000\000\000\000\000\003\153\003\153\003\153\003\153\003\153\000\000\003\153\000\000\000\000\000\000\000\000\000\000\003\153\003\153\003\153\003\153\003\153\000\000\000\000\000\000\000\000\003\153\000\000\003\153\003\153\000\000\000\000\000\000\000\000\003\153\003\153\003\153\000\000\000\000\000\000\000\000\000\000\000\000\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\000\000\000\000\003\153\000\000\003\153\003\153\000\000\000\000\000\000\000\000\000\000\000\000\003\153\003\153\003\153\000\000\003\153\003\153\003\153\003\153\000\000\000\000\000\000\003\153\000\000\003\153\003\153\000\000\t\254\003\153\003\153\003\153\003\153\003\153\000\000\000\000\003\153\003\153\n\018\000\000\000\000\000\000\000\000\003\153\003\153\003\153\003\153\003\149\003\149\000\000\000\000\000\000\003\149\000\000\000\000\003\149\000\000\000\000\003\149\000\000\003\149\000\000\000\000\011&\000\000\003\149\003\149\003\149\000\000\003\149\003\149\003\149\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003\149\000\000\000\000\000\000\000\000\000\000\003\149\003\149\012\030\0126\003\149\000\000\000\000\000\000\000\000\003\149\000\000\012N\003\149\000\000\000\000\000\000\000\000\003\149\003\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\149\003\149\011>\011\190\012f\012~\012\174\003\149\003\149\000\000\000\000\003\149\000\000\003\149\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003\149\003\149\012\222\000\000\003\149\003\149\003\149\003\149\000\000\000\000\000\000\003\149\000\000\003\149\003\149\000\000\r>\003\149\rV\012\150\003\149\003\149\000\000\000\000\003\149\012\246\003\149\000\000\000\000\000\000\000\000\003\149\003\149\r\014\r&\003a\003a\000\000\000\000\000\000\003a\000\000\000\000\003a\000\000\000\000\003a\000\000\003a\000\000\000\000\003a\000\000\003a\003a\003a\000\000\003a\003a\003a\000\000\000\000\000\000\000\000\000\000\003a\003a\003a\003a\003a\000\000\003a\000\000\000\000\000\000\000\000\000\000\003a\003a\003a\003a\003a\000\000\000\000\000\000\000\000\003a\000\000\003a\003a\000\000\000\000\000\000\000\000\003a\003a\003a\000\000\000\000\000\000\000\000\000\000\000\000\003a\003a\003a\003a\003a\003a\003a\003a\003a\000\000\000\000\003a\000\000\003a\003a\000\000\000\000\000\000\000\000\000\000\000\000\003a\003a\003a\000\000\003a\003a\003a\003a\000\000\000\000\000\000\003a\000\000\003a\003a\000\000\t\254\003a\003a\003a\003a\003a\000\000\000\000\003a\003a\n\018\000\000\000\000\000\000\000\000\003a\003a\003a\003a\003]\003]\000\000\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\003]\000\000\003]\000\000\000\000\011&\000\000\003]\003]\003]\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003]\000\000\000\000\000\000\000\000\000\000\003]\003]\012\030\0126\003]\000\000\000\000\000\000\000\000\003]\000\000\012N\003]\000\000\000\000\000\000\000\000\003]\003]\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\011>\011\190\012f\012~\012\174\003]\003]\000\000\000\000\003]\000\000\003]\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\012\222\000\000\003]\003]\003]\003]\000\000\000\000\000\000\003]\000\000\003]\003]\000\000\r>\003]\rV\012\150\003]\003]\000\000\000\000\003]\012\246\003]\000\000\000\000\000\000\000\000\003]\003]\r\014\r&\n\021\n\021\000\000\000\000\000\000\n\021\000\000\000\000\n\021\000\000\000\000\n\021\000\000\n\021\000\000\000\000\011&\000\000\n\021\n\021\n\021\000\000\n\021\n\021\n\021\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\n\021\000\000\000\000\000\000\000\000\000\000\n\021\n\021\012\030\0126\n\021\000\000\000\000\000\000\000\000\n\021\000\000\012N\n\021\000\000\000\000\000\000\000\000\n\021\n\021\000\238\000\000\000\000\000\000\000\000\000\000\000\000\n\021\n\021\011>\011\190\012f\012~\012\174\n\021\n\021\000\000\000\000\n\021\000\000\n\021\012\198\000\000\000\000\000\000\000\000\000\000\000\000\n\021\n\021\012\222\000\000\n\021\n\021\n\021\n\021\000\000\000\000\000\000\n\021\000\000\n\021\n\021\000\000\n\021\n\021\n\021\012\150\n\021\n\021\000\000\000\000\n\021\012\246\n\021\000\000\000\000\000\000\000\000\n\021\n\021\r\014\r&\nm\nm\000\000\000\000\000\000\nm\000\000\000\000\nm\000\000\000\000\nm\000\000\nm\000\000\000\000\nm\000\000\nm\nm\nm\000\000\nm\nm\nm\000\000\000\000\000\000\000\000\000\000\nm\nm\nm\nm\nm\000\000\nm\000\000\000\000\000\000\000\000\000\000\nm\nm\nm\nm\nm\000\000\000\000\000\000\000\000\nm\000\000\nm\nm\000\000\000\000\000\000\000\000\nm\nm\nm\000\000\000\000\000\000\000\000\000\000\000\000\nm\nm\nm\nm\nm\nm\nm\nm\nm\000\000\000\000\nm\000\000\nm\nm\000\000\000\000\000\000\000\000\000\000\000\000\nm\nm\nm\000\000\nm\nm\nm\nm\000\000\000\000\000\000\nm\000\000\nm\nm\000\000\t\254\nm\nm\nm\nm\nm\000\000\000\000\nm\nm\n\018\000\000\000\000\000\000\000\000\nm\nm\nm\nm\002i\002i\000\000\000\000\000\000\002i\000\000\000\000\002i\000\000\000\000\002i\000\000\002i\000\000\000\000\002i\000\000\002i\002i\002i\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002i\000\000\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002i\000\000\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002i\002i\002i\002i\002i\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\002i\002i\016\238\002i\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\t\254\002i\002i\002i\002i\002i\000\000\000\000\002i\002i\n\018\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002a\002a\000\000\000\000\000\000\002a\000\000\000\000\002a\000\000\000\000\002a\000\000\002a\000\000\000\000\002a\000\000\002a\002a\002a\000\000\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\002a\002a\000\000\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\002a\002a\000\000\000\000\000\000\000\000\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\002a\002a\002a\002a\002a\002a\000\000\000\000\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\000\000\002a\002a\002a\002a\000\000\000\000\000\000\002a\000\000\002a\002a\000\000\t\254\002a\002a\002a\002a\002a\000\000\000\000\002a\002a\n\018\000\000\000\000\000\000\000\000\002a\002a\002a\002a\002]\002]\000\000\000\000\000\000\002]\000\000\000\000\002]\000\000\000\000\002]\000\000\002]\000\000\000\000\011&\000\000\002]\002]\002]\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\012\030\0126\002]\000\000\000\000\000\000\000\000\002]\000\000\012N\002]\000\000\000\000\000\000\000\000\002]\002]\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\011>\011\190\012f\012~\012\174\002]\002]\000\000\000\000\002]\000\000\002]\012\198\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\012\222\000\000\002]\002]\002]\002]\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\r>\002]\rV\012\150\002]\002]\000\000\000\000\002]\012\246\002]\000\000\000\000\000\000\000\000\002]\002]\r\014\r&\002e\002e\000\000\000\000\000\000\002e\000\000\000\000\002e\000\000\000\000\002e\000\000\002e\000\000\000\000\011&\000\000\002e\002e\002e\000\000\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\012\030\0126\002e\000\000\000\000\000\000\000\000\002e\000\000\012N\002e\000\000\000\000\000\000\000\000\002e\002e\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002e\002e\011>\011\190\012f\012~\012\174\002e\002e\000\000\000\000\002e\000\000\002e\012\198\000\000\000\000\000\000\000\000\000\000\000\000\002e\002e\012\222\000\000\002e\002e\017\n\002e\000\000\000\000\000\000\002e\000\000\002e\002e\000\000\r>\002e\rV\012\150\002e\002e\000\000\000\000\002e\012\246\002e\000\000\000\000\000\000\000\000\002e\002e\r\014\r&\002Y\002Y\000\000\000\000\000\000\002Y\000\000\000\000\002Y\000\000\000\000\002Y\000\000\002Y\000\000\000\000\002Y\000\000\002Y\002Y\002Y\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\002Y\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\t\254\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\002Y\n\018\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002U\002U\000\000\000\000\000\000\002U\000\000\000\000\002U\000\000\000\000\002U\000\000\002U\000\000\000\000\011&\000\000\002U\002U\002U\000\000\002U\002U\002U\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\002U\000\000\000\000\000\000\000\000\000\000\002U\002U\012\030\0126\002U\000\000\000\000\000\000\000\000\002U\000\000\012N\002U\000\000\000\000\000\000\000\000\002U\002U\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002U\002U\011>\011\190\012f\012~\012\174\002U\002U\000\000\000\000\002U\000\000\002U\012\198\000\000\000\000\000\000\000\000\000\000\000\000\002U\002U\012\222\000\000\002U\002U\002U\002U\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\r>\002U\rV\012\150\002U\002U\000\000\000\000\002U\012\246\002U\000\000\000\000\000\000\000\000\002U\002U\r\014\r&\003Y\003Y\000\000\000\000\000\000\003Y\000\000\000\000\003Y\000\000\000\000\003Y\000\000\003Y\000\000\000\000\003Y\000\000\003Y\003Y\003Y\000\000\003Y\003Y\003Y\000\000\000\000\000\000\000\000\000\000\003Y\003Y\003Y\003Y\003Y\000\000\003Y\000\000\000\000\000\000\000\000\000\000\003Y\003Y\003Y\003Y\003Y\000\000\000\000\000\000\000\000\003Y\000\000\003Y\003Y\000\000\000\000\000\000\000\000\003Y\003Y\003Y\000\000\000\000\000\000\000\000\000\000\000\000\003Y\003Y\003Y\003Y\003Y\003Y\003Y\003Y\003Y\000\000\000\000\003Y\000\000\003Y\003Y\000\000\000\000\000\000\000\000\000\000\000\000\003Y\003Y\003Y\000\000\003Y\003Y\003Y\003Y\000\000\000\000\000\000\003Y\000\000\003Y\003Y\000\000\t\254\003Y\003Y\003Y\003Y\003Y\000\000\000\000\003Y\003Y\n\018\000\000\000\000\000\000\000\000\003Y\003Y\003Y\003Y\003U\003U\000\000\000\000\000\000\003U\000\000\000\000\003U\000\000\000\000\003U\000\000\003U\000\000\000\000\011&\000\000\003U\003U\003U\000\000\003U\003U\003U\000\000\000\000\000\000\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\003U\000\000\000\000\000\000\000\000\000\000\003U\003U\012\030\0126\003U\000\000\000\000\000\000\000\000\003U\000\000\012N\003U\000\000\000\000\000\000\000\000\003U\003U\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003U\003U\011>\011\190\012f\012~\012\174\003U\003U\000\000\000\000\003U\000\000\003U\012\198\000\000\000\000\000\000\000\000\000\000\000\000\003U\003U\012\222\000\000\003U\003U\003U\003U\000\000\000\000\000\000\003U\000\000\003U\003U\000\000\r>\003U\rV\012\150\003U\003U\000\000\000\000\003U\012\246\003U\000\000\000\000\000\000\000\000\003U\003U\r\014\r&\002I\002I\000\000\000\000\000\000\002I\000\000\000\000\002I\000\000\000\000\002I\000\000\002I\000\000\000\000\002I\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002I\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002I\000\000\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002I\002I\002I\002I\002I\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\000\000\002I\002I\002I\002I\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\002I\002I\002I\002I\002I\002I\000\000\000\000\002I\002I\n\018\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002M\002M\000\000\000\000\000\000\002M\000\000\000\000\002M\000\000\000\000\002M\000\000\002M\000\000\000\000\002M\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\006v\000\000\000\000\002M\002M\002M\002M\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\006z\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\002M\002M\002M\002M\000\000\007\233\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\000\000\000\238\002M\002M\002M\000\000\002M\002M\002M\002M\007\233\000\000\000\000\002M\007\233\002M\002M\000\000\002M\002M\002M\002M\002M\002M\000\000\tv\002M\002M\n\018\000\000\000\000\000\000\000\000\002M\002M\002M\002M\001\006\000\000\000\006\000\000\000\000\004\197\002\194\002\198\006~\002\242\002\146\006\"\006\138\000\000\000\000\002\254\001\n\000\000\006\158\000\000\002\158\000\000\006\170\000\000\000\000\001\210\000\000\000\000\016\194\003\242\001\018\t\018\t\022\001\030\001\"\007\233\000\000\000\000\003\006\000\000\003\166\000\000\019\162\000\000\t:\t>\000\238\003\226\003\238\003\250\tB\007V\000\000\001:\000\000\002\186\000\000\000\000\003\246\t\254\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\n\018\001>\001B\001F\001J\001N\000\000\004\197\tV\001R\000\000\007\249\000\000\001V\000\000\tb\tz\n\030\005\186\005\190\000\000\006~\001Z\000\000\006\"\t\150\002\014\000\000\001^\000\000\007\249\006\158\000\000\002\018\007\249\006\170\002\026\000\000\001\154\006j\000\000\000\000\005\194\b\214\001\210\001\158\000\000\017J\004\130\n2\001\006\001\166\000\006\001\170\001\174\028\226\002\194\002\198\000\000\002\242\002\146\003Z\000\000\000\000\000\000\002\254\001\n\007\130\001\222\000\000\t\014\000\000\000\238\000\000\002\186\001\210\000\000\000\000\000\000\003\242\001\018\t\018\t\022\001\030\001\"\000\000\000\000\000\000\003\006\000\000\003\166\000\000\t\026\000\000\t:\t>\000\238\003\226\003\238\003\250\tB\007V\007\142\001:\000\000\002\186\b\005\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\006~\005\174\000\000\006\"\001>\001B\001F\001J\001N\b\005\006\158\tV\001R\b\005\006\170\000\000\001V\000\000\tb\tz\n\030\005\186\005\190\000\000\006~\001Z\000\000\006\"\028\230\000\000\000\000\001^\000\000\000\000\006\158\000\000\000\000\000\000\006\170\000\000\000\000\001\154\006\190\000\000\000\000\005\194\b\214\r\249\001\158\000\000\017J\004\130\n2\0059\001\166\000\006\001\170\001\174\000\246\002\194\002\198\002\202\002\242\002\146\000\000\002\001\000\000\r\249\002\254\022\130\002.\003r\000\000\0022\000\000\0059\000\000\003v\001\210\000\000\020\230\b\005\003\002\000\000\003z\003~\002>\000\000\000\000\003\130\000\000\003\006\000\000\003\166\000\n\020z\n\138\003\218\003\222\n\150\003\226\003\238\003\250\004\002\007V\000\000\000\000\020\222\002\186\000\000\002\001\003\246\020\246\002J\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\002\001\002\001\000\000\000\000\000\000\000\000\020\254\000\000\tV\000\000\nQ\000\000\000\000\000\000\000\000\tb\tz\n\030\005\186\005\190\021\018\021N\000\000\000\000\0059\0059\000\000\000\000\000\000\006\234\000\000\000\000\nQ\000\000\000\000\002N\r\249\r\229\000\000\000\000\021\138\025\142\005\194\b\214\000\000\000\145\000\000\b\238\004\130\n2\000\145\000\000\002\198\000\145\000\000\002\146\r\249\n~\000\000\002.\002\254\000\000\0022\000\145\000\000\000\145\000\000\000\145\000\000\000\145\001\210\000\238\n\182\000\000\003\002\002>\000\000\000\000\002F\r\229\n\190\000\145\000\000\003\006\000\000\003\166\000\000\000\145\000\000\000\000\000\000\000\145\000\000\003\238\001\190\018\150\000\145\000\000\002\146\000\145\002\186\000\000\002J\003\246\000\145\000\145\000\145\b\190\b\194\b\206\000\000\014\206\005\174\000\145\000\145\006~\0256\000\000\006\"\000\000\000\145\000\000\000\000\nQ\000\145\006\158\000\000\000\000\000\000\006\170\000\000\000\000\005\186\005\190\000\145\000\145\018\154\000\000\000\145\000\145\000\000\000\000\000\000\000\000\000\000\000\000\002N\000\000\000\145\000\000\018\166\000\000\025Z\000\000\000\145\000\145\005\194\b\214\000\000\000\000\000\169\b\238\004\130\000\000\000\145\000\169\000\145\002\198\000\169\000\000\002\146\000\000\n~\000\000\000\000\002\254\005\190\000\000\000\169\000\000\000\169\000\000\000\169\000\000\000\169\001\210\025f\n\182\000\000\003\002\000\000\000\000\000\000\000\000\000\000\n\190\000\169\000\000\003\006\000\000\003\166\000\000\000\169\024\250\000\000\000\000\000\169\000\000\003\238\001\190\000\000\000\169\000\000\000\000\000\169\002\186\000\000\000\000\003\246\000\169\000\169\000\169\b\190\b\194\b\206\000\000\014\206\005\174\000\169\000\169\000\000\000\000\000\000\000\000\000\000\000\169\000\000\000\000\n5\000\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\186\005\190\000\169\000\169\000\000\000\000\000\169\000\169\000\000\000\000\nb\n5\000\000\n5\n5\000\000\000\169\000\000\000\000\000\000\000\000\000\000\000\169\000\169\005\194\b\214\000\000\000\000\000\000\b\238\004\130\000\000\000\169\000\000\000\169\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\000\000\000>\t.\000\000\000\000\000B\000\000\018\150\000\000\002\014\002\146\000\000\000F\000\000\000\000\000\000\002\018\000\000\000J\002\026\000N\000R\000V\000Z\000^\000b\000f\001\210\000\000\000\000\000j\000n\000\000\000r\000\000\000v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\t\254\000\000\018\154\000z\007\130\001\222\000~\000\130\n5\000\000\n\018\002\186\000\000\000\134\000\138\000\142\018\166\002\001\025:\000\000\002\001\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\000\000\000\000\000\174\000\178\000\182\000\000\000\000\000\000\000\186\007\142\000\190\000\194\005\190\000\n\000\000\000\000\000\000\000\000\000\198\000\000\000\202\000\000\025F\000\000\000\000\004\149\000\206\000\210\002\001\000\214\004\149\003\022\002\198\004\149\000\000\002\146\000\000\007&\000\000\024\250\002\254\002\001\002\001\004\149\000\000\000\000\000\000\004\149\000\000\004\149\001\210\000\000\007F\000\000\000\000\002\001\002\001\003\026\000\000\000\000\t\134\004\149\000\000\000\000\000\000\000\000\000\000\004\149\002\001\000\000\003&\000\000\000\000\t\178\001\190\002\001\004\149\000\000\002\001\004\149\002\186\002\001\000\n\004\006\004\149\004\149\011\249\004\n\002\001\004\018\000\000\t\194\005\174\000\000\002\001\000\000\000\000\002\001\002\001\000\000\004\149\004\149\000\000\000\000\005\178\000\000\000\000\000\000\000\000\000\000\002\001\000\000\005\186\005\190\004\149\004\149\rz\000\000\004\149\004\149\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\249\n\138\000\000\011\249\r\130\004\149\005\194\000\000\000\000\000\000\011\249\000\000\004\130\000\000\011\249\000\006\004\149\000\000\000\246\002\194\002\198\002\202\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\005Y\000\000\000\000\000\000\002\001\000\000\003v\001\210\000\000\000\000\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\003\130\000\000\003\006\000\000\003\166\000\000\020z\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\020\222\002\186\000\000\000\000\003\246\020\246\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\254\000\000\tV\000\000\031\198\000\000\000\000\000\000\000\000\tb\tz\n\030\005\186\005\190\021\018\021N\000\000\000\006\031\231\017\218\000\246\002\194\002\198\002\202\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000 \022\000\000\025\142\005\194\b\214\000\000\003v\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\003\130\000\000\003\006\000\000\003\166\000\000\020z\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\020\222\002\186\000\000\000\000\003\246\020\246\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\254\000\000\tV\000\000\031\198\000\000\000\000\000\000\000\000\tb\tz\n\030\005\186\005\190\021\018\021N\000\000\000\000\005a\000\000\000\000\000\000\000\000\000\000\001\006\000\000\000\000\000\000\000\000\000\000\003\022\002\198\006F\000\000\002\146\025\142\005\194\b\214\000\000\002\254\001\n\b\238\004\130\n2\002\158\000\000\000\000\000\000\000\000\001\210\003\158\000\000\002\198\001\014\001\018\001\022\0036\001\030\001\"\003j\000\000\000\000\003\146\000\000\000\000\b\134\003:\000\000\001.\006f\001\210\000\000\0032\001\190\0016\b\201\000\000\001:\000\000\002\186\000\000\000\000\004\006\000\000\000\000\000\000\004\n\000\000\004\018\005\162\000\000\005\174\000\000\003\154\001>\001B\001F\001J\001N\000\000\002\186\000\000\001R\005\178\000\000\b\201\001V\011\253\000\000\000\000\000\000\005\186\005\190\000\000\006\002\001Z\000\000\000\000\000\000\b\201\000\000\001^\b\201\tJ\000\000\000\000\000\000\000\000\007j\b\201\000\000\001\154\006j\b\201\000\000\005\194\000\000\011\253\001\158\000\000\001\162\004\130\001\006\000\000\001\166\000\000\001\170\001\174\003\022\002\198\t\182\011\253\002\146\000\000\011\253\r\234\000\000\002\254\001\n\000\000\000\000\011\253\002\158\000\000\000\000\011\253\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\0036\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003:\000\000\001.\006f\000\000\000\000\0032\001\190\0016\000\000\000\000\001:\000\000\002\186\000\000\000\000\004\006\000\000\000\000\000\000\004\n\000\000\004\018\005\162\000\000\005\174\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005\178\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\186\005\190\000\000\006\002\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\006j\000\000\000\000\005\194\000\000\000\000\001\158\000\000\001\162\004\130\000\000\n9\001\166\000\006\001\170\001\174\000\246\002\194\002\198\002\"\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\021\142\000\000\n9\000\000\n9\n9\003v\001\210\000\000\000\000\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\021\146\000\000\003\006\000\000\003\166\000\000\021\186\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\020\222\002\186\000\000\000\000\003\246\020\246\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022Z\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\nR\tz\n\030\005\186\005\190\021\018\022n\000\000\000\000\005-\000\000\000\000\000\000\000\000\000\000\n1\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\022~\005\194\b\214\n9\002\254\000\000\b\238\004\130\n2\n1\000\000\n1\n1\000\000\001\210\000\000\000\000\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\001\169\003\006\000\000\003\166\000\000\001\169\000\000\003\218\003\222\n\154\003\226\003\238\003\250\004\002\007V\001\202\001\206\r\134\002\186\000\000\000\000\003\246\000\000\000\000\001\169\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\000\000\tV\000\000\000\000\000\000\001\242\000\000\001\169\nR\tz\n\030\005\186\005\190\000\000\000\000\001\169\000\000\000\000\001\246\002\162\001\169\001\169\000\238\002\174\000\000\002\186\004.\004:\000\000\001\169\001\169\000\000\004F\000\000\000\000\005\194\b\214\n1\005\201\005\201\b\238\004\130\n2\005\201\000\000\005\201\005\201\000\000\005\201\004J\005\201\005\201\000\000\000\000\005\201\001\169\005\201\005\201\005\201\005\201\005\201\005\201\005\201\005\201\001\169\005\201\000\000\005\201\000\000\000\000\000\000\000\000\000\000\000\000\005\201\000\000\000\000\000\000\000\000\005\201\005\201\005\201\000\000\000\000\005\201\005\201\005\201\005\201\000\000\005\201\000\000\000\000\005\201\000\000\000\000\000\000\000\000\005\201\005\201\005\201\000\000\000\000\005\201\005\201\005\201\000\000\005\201\005\201\000\000\000\000\000\000\000\000\000\000\005\201\000\000\000\000\000\000\005\201\005\201\000\000\005\201\000\000\005\201\000\000\000\000\000\000\000\000\005\201\005\201\005\201\000\000\005\201\005\201\005\201\005\201\000\000\005\201\005\201\000\000\000\000\000\000\005\201\000\000\005\201\005\201\000\000\000\000\002\166\005\201\000\000\000\000\000\000\024\n\005\201\000\000\012\021\000\000\005\201\012\021\005\201\005\201\012\021\012\021\000\000\005\201\012\021\000\000\012\021\000\000\000\000\012\021\000\000\001*\000\000\012\021\012\021\000\000\012\021\012\021\002\001\012\021\000\000\012\021\000\000\000\000\000\000\002\001\012\021\000\000\002\001\012\021\000\000\000\000\000\000\000\000\000\000\000\000\002\001\012\021\000\000\012\021\000\000\000\000\012\021\012\021\000\n\000\000\000\000\000\000\000\000\012\021\000\000\000\000\012\021\000\000\000\000\012\021\012\021\000\000\012\021\002\001\012\021\012\021\000\000\000\000\000\000\000\000\002\001\000\000\000\000\000\000\000\000\000\000\002\001\012\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\021\012\021\000\000\000\000\012\021\000\000\012\021\000\000\000\000\000\000\000\000\005\222\000\000\002\001\000\000\000\000\001\202\001\206\012\021\012\021\000\000\012\021\012\021\000\000\012\021\000\000\012\021\000\000\012\021\000\000\012\021\000\000\012\021\r\185\r\185\001\210\001\250\001\230\r\185\000\000\001\206\r\185\000\000\000\000\000\000\001\242\003\134\000\000\022\174\004\214\000\000\r\185\r\185\r\185\000\000\r\185\r\185\r\185\001\246\024\006\000\000\023&\000\000\002\174\000\000\002\186\004.\004:\000\000\r\185\000\000\000\000\024\022\000\000\000\000\r\185\r\185\000\000\000\000\r\185\000\000\000\000\002\170\000\000\r\185\000\000\000\000\r\185\000\000\004J\000\000\000\000\r\185\r\185\r\185\000\000\000\000\000\000\000\000\000\000\000\000\r\185\r\185\000\000\000\000\000\000\000\000\000\000\r\185\000\000\000\000\000\000\004\222\000\000\000\000\r\185\000\000\000\000\000\000\000\000\000\000\000\000\r\185\r\185\r\185\000\000\r\185\r\185\000\000\005%\000\000\000\000\000\000\000\000\005%\000\000\r\185\005%\r\185\r\185\000\000\000\000\000\000\r\185\000\000\000\000\000\000\005%\r\185\000\000\000\000\005%\r\185\005%\r\185\r\185\n!\n!\000\000\000\000\005%\n!\000\000\001\206\n!\005%\000\000\000\000\000\000\000\000\000\000\005%\n!\000\000\n!\n!\n!\004R\n!\n!\n!\000\000\000\000\005%\005%\000\000\000\000\000\000\005%\002\234\000\000\000\000\n!\000\000\000\000\000\000\000\000\000\000\n!\n!\000\000\000\000\n!\000\000\005%\002\170\005%\n!\000\000\000\000\n!\000\000\000\000\000\000\005%\n!\n!\n!\005%\005%\002\234\000\238\005%\005%\n!\n!\000\000\000\000\004b\005%\000\000\n!\000\000\000\000\000\000\004\222\000\000\000\000\n!\005%\000\000\000\000\000\000\000\000\025\014\n!\n!\n!\000\000\n!\n!\000\000\007\237\000\000\005%\000\000\000\000\007\237\000\000\n!\007\237\n!\n!\005%\000\000\000\000\n!\000\000\000\000\000\000\007\237\n!\000\000\000\000\007\237\n!\007\237\n!\n!\n\029\n\029\000\000\000\000\000\000\n\029\000\000\001\206\n\029\007\237\000\000\000\000\000\000\000\000\000\000\007\237\n\029\000\000\n\029\n\029\n\029\000\000\n\029\n\029\n\029\000\000\000\000\007\237\000\000\000\000\000\000\000\000\007\237\007\237\000\000\000\000\n\029\000\000\000\000\000\000\000\000\000\000\n\029\n\029\000\000\000\000\n\029\000\000\007\237\002\170\000\000\n\029\000\000\000\000\n\029\000\000\000\000\000\000\000\000\n\029\n\029\n\029\007\237\007\237\020\142\000\000\007\237\007\237\n\029\n\029\000\000\000\000\000\000\000\000\000\000\n\029\000\000\000\000\000\000\004\222\021\206\000\000\n\029\007\237\000\000\000\000\000\000\000\000\000\000\n\029\n\029\n\029\000\000\n\029\n\029\000\000\000\000\000\000\002\001\002\001\000\000\000\000\002\001\n\029\002\001\n\029\n\029\002\001\002\001\002\001\n\029\002\001\002\001\002\001\002\001\n\029\000\000\002\001\000\000\n\029\002\001\n\029\n\029\002\001\002\001\000\n\000\000\002\001\000\n\002\001\000\000\002\001\000\n\002\001\002\001\000\n\000\000\002\001\007Z\000\n\002\001\002\001\002\001\002\001\018J\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\000\000\002\001\002\001\002\001\002\001\002\001\002\001\002\001\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\018\138\002\001\000\000\000\000\002\001\000\000\000\000\000\000\000\000\000\000\002\001\002\001\000\000\000\000\000\000\002\001\000\000\002\001\000\000\007^\000\000\002\001\002\001\000\000\000y\000\000\002\001\002\001\002\001\000y\000\000\000y\000y\000\000\000\000\000\000\000\000\000\000\r\249\r\229\000y\000\000\000y\000y\000\000\000\000\000y\000y\000y\000\000\t\185\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\249\000\000\000y\002.\000\000\000\000\0022\000\000\000y\000y\000\000\000\000\000y\002:\000\000\000y\000\000\000y\000\000\002>\000y\000\000\002F\r\229\000\000\000y\000y\000y\000\000\000\000\000\000\000\000\000\000\000\000\000y\000y\000\000\000\000\000\000\000\000\000\000\000y\000y\000\000\000\000\000y\002J\000\000\000y\000\000\000\000\000\000\000\000\000\000\000\000\000y\000y\000y\000\000\000y\000y\000\000\000\000\000\000\007y\t\185\000A\000\000\000\000\000y\000A\000A\000y\000A\000A\000\000\000y\000\000\000\000\000A\000\000\000y\000\000\000\000\007y\000y\000\000\000y\000\000\000A\002N\000\000\000\000\000A\000\000\000A\000A\000\000\000\000\000\000\000\000\000\000\000A\000\000\000A\000\000\000\000\000\000\000A\000A\000\000\000A\000A\000A\000A\000A\000\000\000\000\000\000\000A\000\000\000\000\000A\000\000\000\000\000\000\000A\000A\000A\000A\000\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\r\249\r\229\000\000\000A\000A\000A\000A\000A\000\000\007u\000\000\000=\000\000\000\000\000\000\000=\000=\000\000\000=\000=\r\249\000\000\000\000\002.\000=\000\000\0022\000\000\000\000\007u\000A\000A\000\000\002\214\000=\000A\000A\000A\000=\002>\000=\000=\002F\r\229\000\000\000\000\000\000\000=\000\000\000=\000\000\000\000\000\000\000=\000=\000\000\000=\000=\000=\000=\000=\000\000\000\000\000\000\000=\000\000\002J\000=\000\000\000\000\000\000\000=\000=\000=\000=\000\000\000=\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000=\000\000\000\000\000\000\000\000\000\000\000\000\000=\000=\000=\000=\000=\000\000\007\133\000\000\r\129\000\000\000\000\000\000\r\129\r\129\000\000\r\129\r\129\002N\000\000\000\000\000\000\r\129\000\000\000\000\000\000\000\000\007\133\000=\000=\000\000\000\000\r\129\000=\000=\000=\r\129\000\000\r\129\r\129\000\000\000\000\000\000\000\000\000\000\r\129\000\000\r\129\000\000\000\000\000\000\r\129\r\129\000\000\r\129\r\129\r\129\r\129\r\129\000\000\000\000\000\000\r\129\000\000\000\000\r\129\000\000\000\000\000\000\r\129\r\129\r\129\r\129\000\000\r\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\129\000\000\000\000\000\000\000\000\000\000\000\000\r\129\r\129\r\129\r\129\r\129\000\000\007\129\000\000\r}\000\000\000\000\000\000\r}\r}\000\000\r}\r}\000\000\000\000\000\000\000\000\r}\000\000\000\000\000\000\000\000\007\129\r\129\r\129\000\000\000\000\r}\r\129\r\129\r\129\r}\000\000\r}\r}\000\000\000\000\000\000\000\000\000\000\r}\000\000\r}\000\000\000\000\000\000\r}\r}\000\000\r}\r}\r}\r}\r}\000\000\000\000\000\000\r}\000\000\000\000\r}\000\000\000\000\000\000\r}\r}\r}\r}\000\000\r}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r}\000\000\000\000\000\000\000\000\000\000\000\000\r}\r}\r}\r}\r}\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\r}\r}\000\000\000\000\001\210\r}\r}\r}\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\014E\003\006\000\000\003\166\000\000\014E\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\007\185\007\185\000\000\002\186\000\000\000\000\003\246\000\000\000\000\014E\b\190\b\194\b\206\b\226\000\000\005\174\004>\000\000\000\000\007\185\007\185\007\185\000\000\000\000\000\000\tV\000\000\000\000\000\000\007\185\000\000\014E\nR\tz\n\030\005\186\005\190\000\000\000\000\014E\000\000\000\000\007\185\007\185\014E\014E\000\238\007\185\000\000\007\185\007\185\007\185\000\000\014E\014E\000\000\007\185\000\000\000\000\005\194\b\214\019\142\r\189\r\189\b\238\004\130\n2\r\189\000\000\000\000\r\189\000\000\000\000\007\185\000\000\000\000\000\000\000\000\004\154\014E\r\189\r\189\r\189\000\000\r\189\r\189\r\189\000\000\014E\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\189\000\000\000\000\000\000\000\000\000\000\r\189\r\189\000\000\000\000\r\189\0042\000\000\007\185\000\000\r\189\000\000\000\000\r\189\000\000\000\000\000\000\000\000\r\189\r\189\r\189\000\000\000\000\000\000\000\000\000\000\000\000\r\189\r\189\000\000\000\000\000\000\000\000\000\000\r\189\000\000\000\000\000\000\r\189\000\000\000\000\r\189\000\000\000\000\000\000\000\000\000\000\000\000\r\189\r\189\r\189\000\000\r\189\r\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\201\r\189\000\006\r\189\r\189\007\201\002\194\002\198\r\189\002\242\002\146\000\000\000\000\r\189\000\000\002\254\000\000\r\189\000\000\r\189\r\189\000\000\004\014\000\000\007\201\001\210\000\000\000\000\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\007\201\003\226\003\238\003\250\004\002\007V\000\000\000\000\007\201\002\186\000\000\000\000\003\246\007\201\007\201\000\238\b\190\b\194\b\206\b\226\000\000\005\174\007\201\007\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\nR\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\000\000\000\007\201\000\000\000\000\000\000\000\000\005%\000\000\000\006\000\000\007\201\005%\002\194\002\198\000\000\002\242\002\146\000\000\005\194\b\214\017^\002\254\000\000\b\238\004\130\n2\027\174\000\000\017r\000\000\005%\001\210\000\000\000\000\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\005%\003\226\003\238\003\250\004\002\007V\000\000\000\000\005%\002\186\000\000\000\000\003\246\005%\002\234\000\000\b\190\b\194\b\206\b\226\000\000\005\174\005%\005%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\nR\tz\n\030\005\186\005\190\000\000\005-\000\000\000\006\000\000\005%\000\246\002\194\002\198\002\"\002\242\002\146\000\000\000\000\005%\000\000\002\254\000\000\000\000\021\142\000\000\000\000\005\194\b\214\000\000\003v\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\021\146\000\000\003\006\000\000\003\166\000\000\021\186\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\020\222\002\186\000\000\000\000\003\246\020\246\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022Z\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\019\230\tz\n\030\005\186\005\190\021\018\022n\000\000\000\006\000\000\005-\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\022~\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\019z\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\209\003\209\000\000\000\000\000\241\003\209\000\000\000\000\003\209\000\241\005\194\b\214\000\000\000\000\000\000\b\238\004\130\n2\003\209\003\209\003\209\000\000\003\209\003\209\003\209\000\000\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\209\000\000\000\000\000\000\000\000\000\000\003\209\004\146\000\000\000\000\003\209\000\000\000\000\000\000\000\241\003\209\003\018\000\000\003\209\000\000\000\000\000\000\000\241\003\209\003\209\003\209\000\000\000\241\000\000\000\000\000\000\000\000\003\209\003\209\000\000\000\000\000\241\000\241\000\000\003\209\000\000\000\000\000\000\003\209\000\000\000\000\003\209\000\000\000\000\000\000\000\000\000\000\000\000\003\209\003\209\003\209\000\000\003\209\003\209\000\000\000\000\000\000\000\241\000\000\000\000\000\000\000\000\003\209\000\000\003\209\003\209\000\241\000\000\000\000\003\209\000\000\005\249\0149\000\000\003\209\000\000\012!\000\000\003\209\012!\003\209\003\209\003\022\002\198\000\000\000\000\002\146\000\000\007&\000\000\005\249\002\254\000\000\000\000\005\249\012!\012!\000\000\012!\012!\000\000\001\210\000\000\007F\000\000\000\000\000\000\000\000\003\026\000\000\002\014\t\134\000\000\000\000\000\000\000\000\000\000\002\018\000\000\012!\002\026\003&\000\000\007\134\0032\001\190\000\000\000\000\001\210\000\000\000\000\002\186\000\000\000\000\004\006\000\000\000\000\012!\004\n\000\000\004\018\005\162\t\194\005\174\000\000\003Z\000\000\000\000\000\000\0149\0149\007\130\001\222\000\000\000\000\005\178\001\202\001\206\002\186\000\000\000\000\000\000\005\249\005\186\005\190\000\000\006\002\012!\0149\012!\0149\000\000\000\000\000\000\000\000\001\210\001\250\005\249\000\000\000\000\005\249\012!\000\000\000\000\012!\012!\007\142\005\194\000\000\012!\000\000\012!\000\000\004\130\012\029\012!\000\000\012\029\001\246\002\178\003\022\002\198\000\000\002\174\002\146\002\186\004.\004:\000\000\002\254\000\000\000\000\004F\012\029\012\029\000\000\012\029\012\029\000\000\001\210\000\000\001\202\001\206\000\000\000\000\000\000\003\026\000\000\000\000\004J\000\000\000\000\029\194\000\000\000\000\000\000\000\000\012\029\000\000\003&\001\210\001\250\006B\001\190\000\000\000\000\000\000\000\000\029\174\002\186\000\000\000\000\004\006\000\000\000\000\012\029\004\n\000\000\004\018\005\162\000\000\005\174\000\000\001\246\002\170\000\000\000\000\000\000\002\174\000\000\002\186\004.\004:\005\178\000\000\000\000\000\000\004F\000\000\018\178\000\000\005\186\005\190\000\000\006\002\012\029\000\000\012\029\000\000\000\000\000\000\000\000\000\000\000\006\004J\005\253\0149\002\194\002\198\012\029\002\242\002\146\012\029\012\029\000\000\005\194\002\254\012\029\000\000\012\029\000\000\004\130\000\000\012\029\005\253\000\000\001\210\000\000\005\253\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\0149\0149\017\246\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\005\253\002\194\002\198\000\000\002\242\002\146\0149\000\000\0149\000\000\002\254\000\000\000\000\000\000\000\000\005\253\005\194\b\214\005\253\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\t\238\tz\n\030\005\186\005\190\000\000\005Q\000\000\000\006\000\000\000\000\025\182\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\003v\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\026&\003\226\003\238\003\250\004\002\007V\000\000\000\000\020\222\002\186\000\000\000\000\003\246\020\246\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\026\202\026\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\n\002\tz\n\030\005\186\005\190\000\000\005I\000\000\000\006\000\000\005Q\022\198\002\194\002\198\000\000\002\242\002\146\000\000\000\000\027\206\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\003v\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\022\242\003\226\003\238\003\250\004\002\007V\000\000\000\000\020\222\002\186\000\000\000\000\003\246\020\246\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\023\030\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\nj\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\005I\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\023\130\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\n\234\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\011*\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\011B\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\011f\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\011\146\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\011\170\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\011\194\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\011\218\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\011\242\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012\n\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012\"\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012:\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012R\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012j\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012\130\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012\154\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012\178\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012\202\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012\226\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\012\250\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\r\018\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\r*\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\rB\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\rZ\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\014\238\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\015\022\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\015>\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\015f\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\015\138\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\015\174\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\015\218\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\015\254\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\016\"\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\016>\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\016\222\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\016\242\tz\n\030\005\186\005\190\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\238\003\250\004\002\007V\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\b\226\000\000\005\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tV\000\000\000\000\000\000\000\000\000\000\000\000\017\014\tz\n\030\005\186\005\190\000\000\018f\000\000\000\000\000\000\000\000\000\000\000\000\002\014\000\000\000\000\000\000\001\193\001\193\000\000\002\018\000\000\001\193\002\026\000\000\001\193\000\000\005\194\b\214\000\000\000\000\001\210\b\238\004\130\n2\001\193\001\193\001\193\000\000\001\193\001\193\001\193\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\000\000\001\193\007\130\001\222\000\000\000\000\000\000\001\193\001\193\002\186\000\000\001\193\000\000\000\000\000\000\000\000\001\193\000\000\000\000\001\193\000\000\000\000\000\000\000\000\001\193\001\193\001\193\000\000\000\000\000\000\000\000\000\000\000\000\001\193\001\193\000\000\000\000\007\142\000\000\000\000\001\193\000\249\000\000\000\000\001\193\000\000\000\249\001\193\000\000\000\000\000\000\000\000\000\000\000\000\001\193\001\193\001\193\000\000\001\193\001\193\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\001\193\000\000\001\193\001\193\003\022\002\198\000\000\001\193\002\146\000\000\007&\000\000\001\193\002\254\000\000\000\000\004\254\000\000\001\193\000\249\000\000\022\182\000\000\001\210\000\000\007F\000\000\000\249\000\000\000\000\003\026\000\000\000\249\t\134\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\249\003&\000\000\000\000\t\178\001\190\000\000\000\000\000\000\000\000\000\000\002\186\000\000\000\000\004\006\000\000\000\000\011\249\004\n\000\000\004\018\000\000\t\194\005\174\000\000\000\249\000\000\000\000\000\000\000\000\000\000\000\000\004\209\000\000\000\249\005\178\000\000\000\000\019\186\000\000\000\000\000\000\000\000\005\186\005\190\002\014\000\000\rz\006U\006U\000\000\000\000\002\018\006U\000\000\002\026\006U\000\000\000\000\000\000\000\000\011\249\000\000\001\210\011\249\011\249\006U\005\194\006U\000\000\006U\011\249\006U\004\130\000\000\011\249\004\209\000\000\000\000\000\000\003Z\000\000\r\157\000\000\006U\r\157\007\130\001\222\000\000\000\000\006U\006U\000\000\002\186\000\000\r\157\006U\000\000\000\000\006U\000\000\r\157\006U\000\000\000\000\000\000\000\000\006U\006U\006U\000\000\000\000\000\000\r\157\000\000\000\000\000\000\000\000\000\000\r\157\000\000\007\142\000\000\006U\006U\000\000\000\000\006U\r\157\000\000\001\006\r\157\000\000\000\000\000\000\000\000\r\157\006U\006U\006U\000\000\006U\006U\000\000\000\000\000\000\001\n\b6\000\000\000\000\002\158\000\000\r\157\000\000\006U\000\000\r\157\006U\006U\001\014\001\018\001\022\001\026\001\030\001\"\000\000\r\157\r\157\000\000\006U\r\157\000\000\001&\000\000\001.\0012\031\190\000\000\000\000\000\000\0016\000\000\000\000\001:\000\000\000\000\000\000\r\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\004\025\004\025\001R\000\000\000\000\004\025\001V\000\000\004\025\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\004\025\004\025\000\000\004\025\001^\004\025\000\000\004\025\004\025\000\000\000\000\000\000\000\000\000\000\001\154\030\218\000\000\000\000\004\025\004\025\004\025\001\158\004\025\001\162\004\025\004\025\004\025\001\166\000\000\001\170\001\174\005\209\000\000\000\000\004\025\000\000\004\025\004\025\000\000\000\000\000\000\000\000\004\025\004\025\004\025\000\000\000\000\000\000\005\213\000\000\000\000\004\025\000\000\000\000\004\025\000\000\000\000\000\000\004\025\004\025\004\025\004\025\004\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\025\004\025\004\025\004\025\004\025\004\025\000\000\004\025\000\000\000\000\005\209\000\000\000\000\000\000\000\000\000\000\000\000\004\025\004\025\004\025\000\000\004\025\004\025\006I\006I\000\000\000\000\005\213\006I\000\000\000\000\006I\004\025\000\000\004\025\004\025\000\000\000\000\004\025\020\002\000\000\006I\000\000\006I\000\000\006I\002\014\006I\000\000\004\025\000\000\000\000\000\000\002\018\000\000\000\000\002\026\000\000\000\000\006I\000\000\000\000\000\000\000\000\001\210\006I\006I\000\000\000\000\000\000\000\000\b\130\000\000\000\000\006I\000\000\000\000\006I\000\000\000\000\000\000\003Z\006I\006I\000\238\000\000\000\000\007\130\001\222\000\000\000\000\000\000\000\000\000\000\002\186\000\000\000\000\000\000\006I\006I\000\000\000\000\006I\000\000\n-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006I\006I\006I\000\000\006I\006I\000\000\000\000\011&\000\000\007\142\014\162\n-\000\000\n-\n-\000\000\006I\000\000\000\000\006I\006I\011\142\011\214\011\238\011\166\012\006\000\000\000\000\001\202\002\142\000\000\006I\002\146\000\000\000\000\012\030\0126\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012N\000\000\000\000\001\210\001\250\001\230\002\150\000\000\000\238\000\000\000\000\000\000\000\000\001\242\001\006\000\000\000\000\011>\011\190\012f\012~\012\174\000\000\000\000\000\000\000\000\002\154\002\162\000\000\012\198\001\n\002\174\000\000\002\186\004.\004:\000\000\000\000\012\222\000\000\024\230\000\000\024\234\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\r>\000\000\rV\012\150\001&\004J\001.\0012\n-\012\246\000\000\000\000\0016\000\000\005\190\001:\000\000\r\014\r&\000\000\000\000\000\000\000\000\000\000\024\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\t\145\t\145\001R\024\250\000\000\t\145\001V\000\000\t\145\000\000\000\000\000\000\000\000\000\000\000\000\001Z\020\018\000\000\t\145\000\000\t\145\001^\t\145\002\014\t\145\000\000\000\000\000\000\000\000\000\000\002\018\001\154\030\246\002\026\000\000\000\000\t\145\000\000\001\158\000\000\001\162\001\210\t\145\t\145\001\166\000\000\001\170\001\174\000\000\000\000\000\000\t\145\000\000\000\000\t\145\000\000\000\000\000\000\003Z\t\145\t\145\t\145\000\000\000\000\007\130\001\222\000\000\000\000\000\000\000\000\000\000\002\186\000\000\000\000\000\000\t\145\000\000\000\000\000\000\t\145\014\133\014\133\000\000\000\000\000\000\014\133\000\000\000\000\014\133\t\145\t\145\t\145\000\000\t\145\t\145\000\000\000\000\000\000\014\133\007\142\014\133\000\000\014\133\t\145\014\133\000\000\t\145\001\202\001\206\000\000\t\145\000\000\000\000\000\000\000\000\000\000\014\133\000\000\000\000\004\254\000\000\t\145\014\133\014\133\014\137\014\137\001\210\001\214\004R\014\137\000\000\014\133\014\137\000\000\014\133\000\000\000\000\000\000\000\000\014\133\014\133\014\133\014\137\000\000\014\137\000\000\014\137\000\000\014\137\001\246\002\170\000\000\000\000\000\000\002\174\014\133\002\186\004.\004:\014\133\014\137\000\000\000\000\004F\000\000\018\178\014\137\014\137\000\000\014\133\014\133\014\133\004R\014\133\014\133\014\137\000\000\000\000\014\137\004b\004J\000\000\000\000\014\137\014\137\014\137\014\133\000\000\000\000\000\000\014\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\137\000\000\014\133\000\000\014\137\001\177\000\000\000\000\000\000\000\000\001\177\000\000\001\206\001\177\014\137\014\137\014\137\000\000\014\137\014\137\000\000\t\249\000\000\001\177\004b\000\000\000\000\001\177\000\000\001\177\000\000\014\137\000\000\000\000\000\000\014\137\000\000\000\000\000\000\000\000\000\000\001\177\000\000\000\000\000\000\000\000\014\137\001\177\001\177\000\000\000\000\000\000\000\000\000\000\002\170\000\000\001\177\000\000\000\000\001\177\000\000\000\000\000\000\000\000\001\177\001\177\001\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\177\001\177\000\000\000\000\004\222\003\253\000\000\000\000\000\000\000\000\003\253\000\000\001\206\003\253\001\177\001\177\000\000\000\000\001\177\001\177\000\000\t\245\000\000\003\253\000\000\000\000\000\000\003\253\001\177\003\253\000\000\000\000\000\000\000\000\000\000\001\177\000\000\000\000\000\000\000\000\001\177\003\253\000\000\000\000\000\000\000\000\001\177\003\253\001\173\000\000\000\000\000\000\000\000\000\000\002\170\000\000\003\253\000\000\000\000\003\253\000\000\000\000\000\000\000\000\003\253\003\253\003\253\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\253\003\253\000\000\000\000\004\222\003\249\000\000\000\000\000\000\000\000\003\249\000\000\001\206\003\249\003\253\003\253\000\000\000\000\003\253\003\253\000\000\t\245\000\000\003\249\000\000\000\000\000\000\003\249\003\253\003\249\000\000\000\000\000\000\000\000\000\000\003\253\000\000\000\000\000\000\000\000\003\253\003\249\000\000\000\000\000\000\000\000\003\253\003\249\001\173\000\000\000\153\000\000\000\000\000\000\002\170\000\153\003\249\000\000\000\153\003\249\000\000\000\000\000\000\000\000\003\249\003\249\003\249\000\000\000\153\000\000\000\153\000\000\000\153\000\000\000\153\000\000\000\000\000\000\000\000\000\000\003\249\003\249\000\000\000\000\004\222\000\000\000\153\000\000\000\000\000\000\000\000\000\000\000\153\000\000\003\249\003\249\000\153\000\000\003\249\003\249\000\000\000\153\000\000\000\000\000\153\000\000\000\000\020:\003\249\000\153\000\153\000\238\000\000\000\000\002\014\003\249\000\000\000\000\000\153\000\153\003\249\002\018\000\000\000\000\002\026\000\153\003\249\000\000\000\221\000\153\000\000\000\000\001\210\000\221\000\000\000\000\000\221\000\000\000\000\000\153\000\153\000\000\000\000\000\153\000\153\000\000\000\221\000\000\000\221\003Z\000\221\000\000\000\221\000\153\000\000\007\130\001\222\000\000\000\000\000\153\000\153\000\000\002\186\000\000\000\221\000\000\000\000\000\000\000\000\000\153\000\221\000\153\000\000\000\000\000\221\000\000\000\000\000\000\000\000\000\221\000\000\000\000\000\221\000\000\000\000\020J\000\000\000\221\000\221\000\238\007\142\000\000\002\014\000\000\000\000\000\000\000\221\000\221\000\000\002\018\000\000\000\000\002\026\000\221\000\000\000\000\000\161\000\221\000\000\000\000\001\210\000\161\000\000\000\000\000\161\000\000\000\000\000\221\000\221\000\000\000\000\000\221\000\221\000\000\000\161\000\000\000\161\003Z\000\161\000\000\000\161\000\221\000\000\007\130\001\222\000\000\000\000\000\221\000\221\000\000\002\186\000\000\000\161\000\000\000\000\000\000\000\000\000\221\000\161\000\221\000\000\000\000\000\161\000\000\000\000\000\000\000\000\000\161\000\000\000\000\000\161\000\000\000\000\000\000\000\000\000\161\000\161\000\238\007\142\000\000\000\000\000\000\000\000\000\000\000\161\000\161\000\000\000\000\000\000\000\000\000\000\000\161\000\000\000\000\000\157\000\161\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\161\000\161\000\000\000\000\000\161\000\161\000\000\000\157\000\000\000\157\000\000\000\157\000\000\000\157\000\161\000\000\000\000\000\000\000\000\000\000\000\161\000\161\000\000\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\161\000\157\000\161\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\157\000\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\000\000\000\001\141\000\157\000\000\000\000\000\000\001\141\000\000\000\000\001\141\000\000\000\000\000\157\000\157\000\000\000\000\000\157\000\157\000\000\001\141\000\000\000\000\000\000\001\141\000\000\001\141\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\000\000\000\001\141\001\141\000\000\000\000\000\000\000\157\001\141\000\157\000\000\000\000\000\000\000\000\005\209\000\000\000\000\001\141\000\000\000\000\001\141\000\000\000\000\000\000\000\000\001\141\001\141\001\141\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\141\000\000\000\000\000\000\001\141\014\129\014\129\000\000\000\000\000\000\014\129\000\000\000\000\014\129\001\141\001\141\000\000\000\000\001\141\001\141\000\000\000\000\000\000\014\129\005\209\014\129\000\000\014\129\001\141\014\129\000\000\000\000\000\000\000\000\001\141\001\141\000\000\000\000\000\000\000\000\001\141\014\129\000\000\000\000\000\000\000\000\001\141\014\129\014\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\129\000\000\000\000\014\129\000\000\000\000\000\000\000\000\014\129\014\129\014\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\129\000\000\000\000\000\000\014\129\014}\014}\000\000\000\000\000\000\014}\000\000\000\000\014}\014\129\014\129\014\129\000\000\014\129\014\129\000\000\000\000\000\000\014}\000\000\014}\000\000\014}\000\000\014}\000\000\014\129\000\000\000\000\000\000\014\129\000\000\000\000\000\000\000\000\000\000\014}\000\000\000\000\004\254\000\000\014\129\014}\014}\000\000\000\000\000\000\000\000\000\000\000\000\005-\014}\000\000\000\000\014}\000\246\000\000\000\000\002\"\014}\014}\014}\000\000\000\000\000\000\000\000\000\000\000\000\021\142\000\000\000\000\000\000\005-\000\000\003v\014}\000\000\t\149\t\149\014}\000\000\000\000\t\149\000\000\000\000\t\149\021\146\000\000\000\000\014}\014}\014}\021\186\014}\014}\t\149\000\000\t\149\000\000\t\149\000\000\t\149\000\000\007\210\020\222\000\000\014}\000\000\000\000\020\246\014}\000\000\000\000\t\149\000\000\000\000\000\000\000\000\000\000\t\149\t\149\014}\000\000\000\000\000\000\022Z\000\000\000\000\t\149\000\000\000\000\t\149\000\000\000\000\000\000\000\000\t\149\t\149\000\238\021\018\022n\000\000\000\000\005-\005-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\149\003\022\002\198\000\000\t\149\002\146\000\000\007&\022~\000\000\002\254\000\000\000\000\000\000\t\149\t\149\t\149\000\000\t\149\t\149\001\210\000\000\007F\000\000\000\000\000\000\000\000\003\026\t\149\000\000\t\134\t\149\000\000\000\000\000\000\t\149\000\000\000\000\003\189\000\000\003&\000\000\000\000\t\178\001\190\000\000\t\149\007\229\000\000\000\000\002\186\000\000\000\000\004\006\000\000\000\000\000\000\004\n\000\000\004\018\000\000\t\194\005\174\011&\000\000\000\000\007\229\000\000\000\000\000\000\007\229\000\000\000\000\000\000\005\178\000\000\000\000\011\142\011\214\011\238\011\166\012\006\005\186\005\190\000\000\000\000\003\189\000\000\000\000\000\000\000\000\012\030\0126\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012N\003\189\000\000\000\000\003\189\000\000\005\194\000\000\000\238\000\000\000\000\000\000\004\130\000\000\000\000\000\000\000\000\011>\011\190\012f\012~\012\174\000\000\000\000\000\000\000\000\001\173\000\000\007\229\012\198\000\000\001\173\000\000\001\206\001\173\000\000\000\000\000\000\012\222\000\000\000\000\000\000\t\245\000\000\001\173\000\000\000\000\000\000\001\173\000\000\001\173\000\000\r>\000\000\rV\012\150\000\000\000\000\000\000\000\000\000\000\012\246\001\173\000\000\000\000\000\000\000\000\000\000\001\173\r\014\r&\000\000\000\000\000\000\000\000\002\170\000\000\001\173\020.\000\000\001\173\000\000\000\000\000\000\000\000\001\173\001\173\001\173\000\000\000\000\000\000\000\000\000\000\000\000\011&\000\000\000\000\000\000\0202\000\000\000\000\001\173\001\173\000\000\000\000\004\222\000\000\000\000\011\142\011\214\011\238\011\166\012\006\000\000\000\000\001\173\001\173\000\000\000\000\001\173\001\173\000\000\012\030\0126\000\000\000\000\000\000\000\000\000\000\001\173\000\000\012N\000\000\000\000\000\000\000\000\001\173\000\000\000\000\000\238\000\000\001\173\000\000\000\000\000\000\000\000\000\000\001\173\011>\011\190\012f\012~\012\174\000\000\000\000\006\142\000\000\000\000\000\000\000\000\012\198\001\202\001\206\000\000\000\000\000\000\000\000\000\000\000\000\012\222\000\000\n\142\000\000\000\000\000\000\000\000\000\246\001\202\001\206\002\"\001\210\001\250\001\230\r>\0206\rV\012\150\020F\000\000\021\142\001\242\000\000\012\246\005-\000\000\003v\001\210\001\250\001\230\000\000\r\014\r&\000\000\001\246\002\162\000\000\001\242\021\146\002\174\000\000\002\186\004.\004:\021\186\000\000\000\000\000\000\004F\000\000\001\246\002\162\000\000\000\000\000\000\002\174\020\222\002\186\004.\004:\000\000\020\246\006\133\006\133\004F\004J\000\000\006\133\000\000\000\000\006\133\000\000\000\000\000\000\000\000\000\000\000\000\022Z\000\000\000\000\006\133\004J\006\133\000\000\006\133\000\000\006\133\000\000\000\000\000\000\000\000\021\018\022n\000\000\000\000\000\000\000\000\000\000\006\133\000\000\000\000\004~\000\000\004\130\006\133\006\133\006\129\007\166\000\000\000\000\b\130\006\129\022~\006\133\006\129\000\000\006\133\000\000\000\000\000\000\000\000\006\133\006\133\000\238\006\129\000\000\006\129\000\000\006\129\000\000\006\129\000\000\000\000\000\000\000\000\000\000\000\000\006\133\000\000\000\000\000\000\006\133\006\129\000\000\000\000\000\000\000\000\000\000\006\129\b\"\000\000\006\133\006\133\006\133\000\000\006\133\006\133\006\129\000\000\000\000\006\129\000\000\000\000\000\000\000\000\006\129\006\129\000\238\006\133\000\000\000\000\000\000\006\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\129\000\000\006\133\000\000\006\129\014\141\014\141\000\000\000\000\000\000\014\141\000\000\000\000\014\141\006\129\006\129\006\129\000\000\006\129\006\129\000\000\000\000\000\000\014\141\000\000\014\141\n\154\014\141\000\000\014\141\000\000\006\129\001\202\001\206\000\000\006\129\000\000\000\000\000\000\000\000\000\000\014\141\000\000\000\000\000\000\000\000\006\129\014\141\014\141\014\145\014\145\001\210\001\250\001\230\014\145\000\000\014\141\014\145\000\000\014\141\000\000\001\242\000\000\000\000\014\141\014\141\000\238\014\145\002\002\014\145\000\000\014\145\000\000\014\145\001\246\002\162\000\000\000\000\000\000\002\174\014\141\002\186\004.\004:\014\141\014\145\000\000\000\000\004F\000\000\000\000\014\145\b\"\000\000\014\141\014\141\014\141\000\000\014\141\014\141\014\145\000\000\000\000\014\145\000\000\004J\000\000\000\000\014\145\014\145\000\238\014\141\000\000\000\000\000\000\014\141\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\145\000\000\014\141\000\000\014\145\006\157\007\166\000\000\000\000\000\000\006\157\000\000\000\000\006\157\014\145\014\145\014\145\000\000\014\145\014\145\000\000\000\000\000\000\006\157\000\000\006\157\000\000\006\157\000\000\006\157\000\000\014\145\007\181\007\181\000\000\014\145\000\000\000\000\000\000\000\000\000\000\006\157\000\000\000\000\000\000\000\000\014\145\006\157\b\"\006\161\006\161\007\181\007\181\007\181\006\161\000\000\006\157\006\161\000\000\006\157\000\000\007\181\000\000\000\000\006\157\006\157\000\238\006\161\000\000\006\161\000\000\006\161\000\000\006\161\007\181\007\181\000\000\000\000\000\000\007\181\006\157\007\181\007\181\007\181\006\157\006\161\000\000\000\000\007\181\000\000\000\000\006\161\006\161\000\000\006\157\006\157\006\157\000\000\006\157\006\157\006\161\000\000\000\000\006\161\000\000\007\181\000\000\000\000\006\161\006\161\006\161\006\157\000\000\000\000\000\000\006\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\161\000\000\006\157\000\000\006\161\006\153\006\153\000\000\000\000\000\000\006\153\000\000\000\000\006\153\006\161\006\161\006\161\000\000\006\161\006\161\000\000\000\000\000\000\006\153\0056\006\153\000\000\006\153\000\000\006\153\000\000\006\161\000\000\000\000\000\000\006\161\000\000\000\000\000\000\000\000\000\000\006\153\000\000\000\000\000\000\000\000\bJ\006\153\b\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\153\000\000\000\000\006\153\000\000\000\000\000\000\000\000\006\153\006\153\000\238\000\000\003\245\000\000\000\000\000\000\000\000\003\245\000\000\001\206\003\245\000\000\000\000\000\000\006\153\000\000\000\000\000\000\006\153\000\000\003\245\000\000\000\000\000\000\003\245\000\000\003\245\000\000\006\153\006\153\006\153\000\000\006\153\006\153\000\000\000\000\000\000\000\000\003\245\000\000\000\000\000\000\000\000\000\000\003\245\006\153\000\000\000\000\000\000\006\153\000\000\002\170\000\000\003\245\000\000\000\000\003\245\000\000\000\000\000\000\006\153\003\245\003\245\003\245\000\000\003\241\000\000\000\000\000\000\000\000\003\241\000\000\001\206\003\241\000\000\000\000\000\000\003\245\003\245\000\000\000\000\004\222\000\000\003\241\000\000\000\000\000\000\003\241\000\000\003\241\000\000\003\245\003\245\000\000\000\000\003\245\003\245\000\000\000\000\000\000\000\000\003\241\000\000\000\000\000\000\003\245\000\000\003\241\000\000\000\000\0011\000\000\003\245\000\000\002\170\0011\003\241\003\245\0011\003\241\000\000\000\000\000\000\003\245\003\241\003\241\003\241\000\000\0011\000\000\0011\000\000\0011\000\000\0011\000\000\000\000\000\000\000\000\000\000\003\241\003\241\000\000\000\000\004\222\000\000\0011\000\000\000\000\000\000\000\000\000\000\0011\000\000\003\241\003\241\0011\000\000\003\241\003\241\000\000\0011\000\000\000\000\0011\000\000\000\000\000\000\003\241\0011\0011\000\238\000\000\001-\000\000\003\241\000\000\000\000\001-\0011\003\241\001-\000\000\000\000\000\000\0011\003\241\000\000\000\000\0011\000\000\001-\000\000\001-\000\000\001-\000\000\001-\000\000\0011\0011\0011\000\000\0011\0011\000\000\000\000\000\000\000\000\001-\000\000\000\000\000\000\0011\000\000\001-\000\000\000\000\000\000\001-\0011\000\000\000\000\000\000\001-\000\000\000\000\001-\000\000\000\000\000\000\0011\001-\001-\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001-\000\000\000\000\000\000\000\000\000\000\001-\000\000\000\000\000\000\001-\001i\000\000\000\000\000\000\000\000\001i\000\000\r\221\001i\001-\001-\001-\000\000\001-\001-\000\000\r\221\000\000\001i\000\000\001i\000\000\001i\001-\001i\000\000\000\000\000\000\000\000\000\000\001-\000\000\000\000\000\000\000\000\000\000\001i\000\000\000\000\000\000\000\000\001-\001i\r\221\000\000\000\000\000\000\000\000\000\000\r\221\000\000\000\000\000\000\000\000\001i\000\000\000\000\000\000\000\000\001i\001i\001i\000\000\000\000\001\029\000\000\000\000\000\000\000\000\001\029\000\000\002\025\001\029\000\000\000\000\001i\000\000\000\000\000\000\r\221\002\025\000\000\001\029\000\000\001\029\000\000\001\029\000\000\001\029\001i\001i\001i\000\000\001i\001i\000\000\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\001\029\002\025\000\000\000\000\001i\000\000\000\000\002\025\000\000\000\000\000\000\000\000\001\029\000\000\000\000\001i\000\000\001\029\001\029\001\029\000\000\001\185\000\000\000\000\000\000\000\000\001\185\000\000\018\150\001\185\000\000\002\146\000\000\001\029\000\000\000\000\000\000\002\025\000\000\001\185\000\000\000\000\000\000\001\185\000\000\001\185\000\000\001\029\001\029\001\029\000\000\001\029\001\029\000\000\000\000\000\000\000\000\001\185\000\000\000\000\000\000\000\000\000\000\001\185\000\000\000\000\000\000\000\000\001\029\018\154\000\000\000\000\001\185\000\000\000\000\001\185\000\000\000\000\000\000\001\029\001\185\001\185\000\000\018\166\005%\000\000\005%\000\000\000\000\005%\000\000\000\000\005%\000\000\005%\007\166\001\185\000\000\000\000\005%\001\185\000\000\005%\000\000\000\000\005%\005%\000\000\005%\005\190\001\185\001\185\005%\000\000\001\185\001\185\005%\005%\005%\000\000\005%\000\000\000\000\005%\001\185\000\000\005%\000\000\000\000\000\000\005%\001\185\005%\000\000\000\000\005%\005%\b\"\005%\000\000\005%\002\234\001\185\005%\002\234\005%\000\000\000\000\005%\000\000\000\000\000\000\005%\005%\002\234\000\238\005%\t!\000\000\005%\005%\000\000\t!\005%\000\000\t!\000\000\000\000\000\000\005%\005%\005%\000\000\005%\005%\t!\000\000\005%\005%\t!\000\000\t!\000\000\005%\005%\000\000\000\000\005%\005%\000\000\000\000\005%\000\000\t!\005%\000\000\000\000\007\210\000\000\t!\000\000\000\000\000\000\t!\005%\005%\000\000\000\000\t!\029*\000\000\t!\000\000\000\000\000\000\005%\t!\t!\000\238\t\029\000\000\000\000\000\000\000\000\t\029\t!\t!\t\029\000\000\000\000\000\000\000\000\t!\000\000\000\000\000\000\t!\t\029\000\000\000\000\000\000\t\029\000\000\t\029\000\000\000\000\t!\t!\t!\000\000\t!\t!\000\000\000\000\000\000\t\029\000\000\000\000\000\000\000\000\t!\t\029\000\000\000\000\000\000\t\029\000\000\t!\000\000\000\000\t\029\000\000\000\000\t\029\000\000\000\000\000\000\000\000\t\029\t\029\000\238\003\233\000\000\000\000\000\000\000\000\003\233\t\029\t\029\003\233\000\000\000\000\000\000\000\000\t\029\000\000\000\000\000\000\t\029\003\233\000\000\000\000\000\000\003\233\000\000\003\233\000\000\000\000\t\029\t\029\t\029\000\000\t\029\t\029\000\000\000\000\000\000\003\233\018\174\000\000\000\000\000\000\t\029\003\233\000\000\000\000\000\000\000\000\000\000\t\029\000\000\000\000\003\233\000\000\000\000\003\233\000\000\000\000\000\000\000\000\003\233\003\233\003\233\003\022\002\198\000\000\000\000\002\146\000\000\007&\000\000\000\000\002\254\000\000\000\000\000\000\003\233\000\000\000\000\000\000\003\233\000\000\001\210\000\000\007F\000\000\000\000\000\000\000\000\003\026\003\233\003\233\t\134\000\000\003\233\003\233\000\000\000\000\000\000\000\000\0276\000\000\003&\000\000\003\233\0032\001\190\000\000\000\000\000\000\019\014\003\233\002\186\000\000\000\000\004\006\003\233\000\000\000\000\004\n\000\000\004\018\003\233\t\194\005\174\000\000\000\000\000\000\003\022\002\198\000\000\000\000\002\146\000\000\007&\000\000\005\178\002\254\000\000\000\000\000\000\000\000\000\000\000\000\005\186\005\190\000\000\001\210\025\166\007F\000\000\000\000\000\000\000\000\003\026\000\000\000\000\t\134\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\028\002\003&\005\194\000\000\t\178\001\190\000\000\000\000\004\130\000\000\000\000\002\186\000\000\000\000\004\006\000\000\000\000\000\000\004\n\000\000\004\018\000\000\t\194\005\174\000\000\000\000\000\000\003\022\002\198\000\000\000\000\002\146\000\000\007&\000\000\005\178\002\254\000\000\000\000\000\000\000\000\000\000\000\000\005\186\005\190\000\000\001\210\rz\007F\000\000\000\000\000\000\000\000\003\026\000\000\000\000\t\134\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\026>\003&\005\194\000\000\t\178\001\190\000\000\000\000\004\130\000\000\000\000\002\186\000\000\000\000\004\006\000\000\000\000\000\000\004\n\000\000\004\018\005\250\t\194\005\174\000\000\000\000\000\000\003\022\002\198\000\000\000\000\002\146\000\000\000\000\000\000\005\178\002\254\000\000\000\000\000\000\000\000\005\254\000\000\005\186\005\190\000\000\001\210\rz\000\000\000\000\000\000\000\000\000\000\003\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\026\158\003&\005\194\000\000\0032\001\190\000\000\000\000\004\130\000\000\000\000\002\186\000\000\000\000\004\006\000\000\000\000\000\000\004\n\000\000\004\018\005\162\000\000\005\174\000\000\000\000\nU\000\000\000\000\000\000\000\000\000\000\003\022\002\198\000\000\005\178\002\146\000\000\000\000\000\000\000\000\002\254\000\000\005\186\005\190\000\000\006\002\000\000\nU\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\026\000\000\000\000\000\000\000\000\000\000\006\190\000\000\000\000\005\194\005\r\005\r\000\000\003&\005\r\004\130\0032\001\190\000\000\005\r\000\000\000\000\000\000\002\186\000\000\005\r\004\006\000\000\000\000\005\r\004\n\000\000\004\018\005\162\000\000\005\174\005\r\026\238\000\000\000\000\027\006\000\000\000\000\000\000\000\000\000\000\000\000\005\178\000\000\005\r\000\000\000\000\005\r\005\r\000\000\005\186\005\190\000\000\006\002\005\r\000\000\000\000\005\r\000\000\000\000\000\238\005\r\000\000\005\r\005\r\000\000\005\r\003\233\000\000\000\000\000\000\000\000\003\233\000\000\005\194\003\233\nU\003\233\005\r\000\000\004\130\000\000\003\233\000\000\000\000\003\233\005\r\005\r\000\000\003\233\000\000\003\233\000\000\000\000\000\000\003\233\000\000\000\000\000\000\003\233\000\000\003\233\000\000\003\233\018\174\000\000\000\000\000\000\000\000\003\233\005\r\000\000\000\000\003\233\018\174\000\000\005\r\000\000\003\233\003\233\000\000\003\233\000\000\000\000\000\000\000\000\003\233\003\233\003\233\000\000\000\000\003\233\000\000\000\000\000\000\000\000\003\233\003\233\003\233\000\000\000\000\000\000\003\233\000\000\000\000\000\000\003\233\000\000\000\000\000\000\000\000\000\000\003\233\000\000\000\000\000\000\003\233\003\233\0292\000\000\003\233\003\233\000\000\000\000\000\000\000\000\003\233\003\233\029b\000\000\003\233\003\233\000\000\r\213\000\000\000\000\019\014\003\233\r\213\000\000\000\000\r\213\003\233\000\000\000\000\000\000\019\014\003\233\000\000\000\000\000\000\r\213\003\233\000\000\000\000\r\213\000\000\r\213\000\000\000\000\000\000\000\000\000\000\005\201\000\000\000\000\000\000\000\246\000\000\r\213\002\202\000\000\000\000\000\000\000\000\r\213\000\000\000\000\000\000\000\000\005Y\000\000\000\000\000\000\r\213\000\000\003v\r\213\000\000\000\000\000\000\000\000\r\213\r\213\000\000\000\000\000\000\000\000\003\130\000\000\0075\000\000\000\000\000\000\020z\000\000\000\000\002\198\r\213\000\000\002\146\000\000\r\213\028N\000\000\002\254\020\222\000\000\000\000\000\000\0075\020\246\r\213\r\213\002\138\001\210\r\213\r\213\000\000\003\002\000\000\000\000\000\000\000\000\000\000\000\000\r\213\020\254\003\006\000\000\003\166\000\000\000\000\r\213\000\000\000\000\007]\000\000\003\238\001\190\000\000\021\018\021N\002\198\r\213\002\186\002\146\000\000\003\246\000\000\000\000\002\254\b\190\b\194\b\206\000\000\007]\005\174\000\000\000\000\000\000\001\210\025\142\000\000\000\000\003\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\005\186\005\190\000\000\000\000\000\000\000\000\000\000\003\238\001\190\000\000\000\000\000\000\000\000\000\000\002\186\000\000\000\000\003\246\000\000\000\000\000\000\b\190\b\194\b\206\005\194\b\214\005\174\000\000\000\000\b\238\004\130\006!\000\000\000\000\000\000\000\000\006!\000\000\000\000\006!\000\000\000\000\000\000\000\000\000\000\000\000\005\186\005\190\000\000\006!\000\000\000\000\000\000\006!\000\000\006!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006!\000\000\000\000\005\194\b\214\000\000\006!\000\000\b\238\004\130\000\000\000\000\b\130\000\000\000\000\006!\000\000\000\000\006!\000\000\000\000\000\000\000\000\006!\006!\000\238\000\000\006)\000\000\000\000\000\000\000\000\006)\000\000\000\000\006)\000\000\000\000\000\000\006!\006!\000\000\000\000\006!\000\000\006)\000\000\000\000\000\000\006)\000\000\006)\000\000\006!\006!\000\000\000\000\006!\006!\000\000\000\000\000\000\000\000\006)\000\000\000\000\000\000\000\000\000\000\006)\000\000\003\233\000\000\000\000\006!\b\130\003\233\000\000\006)\003\233\000\000\006)\000\000\000\000\000\000\006!\006)\006)\000\238\003\233\000\000\000\000\000\000\003\233\000\000\003\233\000\000\000\000\000\000\000\000\000\000\000\000\006)\006)\000\000\000\000\006)\003\233\018\174\000\000\000\000\000\000\000\000\003\233\000\000\000\000\006)\006)\000\000\000\000\006)\006)\003\233\000\000\000\000\003\233\000\000\000\000\000\000\000\000\003\233\003\233\003\233\006\229\000\000\000\000\000\000\006)\006\229\000\000\000\000\006\229\000\000\000\000\000\000\000\000\003\233\000\000\006)\000\000\003\233\006\229\000\000\000\000\000\000\006\229\000\000\006\229\000\000\000\000\003\233\003\233\021^\000\000\003\233\003\233\000\000\000\000\000\000\006\229\000\000\000\000\000\000\000\000\000\000\006\229\000\000\000\000\000\000\000\000\019\014\003\233\000\000\000\000\006\229\000\000\000\000\006\229\000\000\000\000\000\000\000\000\006\229\006\229\000\238\000\000\000\000\000\000\000\000\000\000\029\n\000\000\000\000\000\000\000\000\000\000\003\022\002\198\006\229\000\000\002\146\000\000\006\229\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\000\000\006\229\006\229\0252\001\210\006\229\006\229\000\000\000\000\000\000\000\000\003\026\000\000\000\000\000\000\006\229\000\000\000\000\r\213\000\000\000\000\000\000\006\229\r\213\003&\000\000\r\213\0032\001\190\000\000\000\000\000\000\000\000\006\229\002\186\000\000\r\213\004\006\000\000\000\000\r\213\004\n\r\213\004\018\005\162\000\000\005\174\000\000\005\201\000\000\000\000\000\000\000\000\000\000\r\213\000\000\000\000\000\000\005\178\000\000\r\213\000\000\000\000\000\000\000\000\000\000\005\186\005\190\000\000\006\002\000\000\000\000\r\213\000\000\000\000\000\000\000\000\r\213\r\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\194\000\000\007\018\r\213\tn\006&\004\130\000\000\000\000\000\000\000\000\003\022\002\198\000\000\000\000\002\146\000\000\r\213\r\213\002\138\002\254\r\213\r\213\000\000\000\000\000\000\000\000\004\014\000\000\000\000\001\210\r\213\000\000\000\000\000\000\030\030\000\000\003\026\r\213\000\000\000\000\006\130\000\000\000\000\000\000\000\000\000\000\003\022\002\198\r\213\003&\002\146\000\000\0032\001\190\000\000\002\254\000\000\000\000\000\000\002\186\000\000\000\000\004\006\000\000\000\000\001\210\004\n\000\000\004\018\005\162\000\000\005\174\003\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\178\000\000\003&\000\000\000\000\0032\001\190\000\000\005\186\005\190\000\000\006\002\002\186\000\000\000\000\004\006\000\000\000\000\000\000\004\n\000\000\004\018\005\162\000\000\005\174\000\000\000\000\006\162\000\000\000\000\000\000\000\000\005\194\003\022\002\198\000\000\005\178\002\146\004\130\000\000\000\000\000\000\002\254\000\000\005\186\005\190\000\000\006\002\000\000\006\214\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\026\000\000\000\000\000\000\0079\000\000\000\000\000\000\000\000\005\194\003\022\002\198\000\000\003&\002\146\004\130\0032\001\190\000\000\002\254\000\000\000\000\000\000\002\186\0079\000\000\004\006\000\000\000\000\001\210\004\n\000\000\004\018\005\162\000\000\005\174\003\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\178\000\000\003&\000\000\000\000\0032\001\190\000\000\005\186\005\190\000\000\006\002\002\186\000\000\000\000\004\006\000\000\000\000\000\000\004\n\000\000\004\018\005\162\000\000\005\174\000\000\000\000\014\n\000\000\000\000\000\000\000\000\005\194\003\022\002\198\000\000\005\178\002\146\004\130\000\000\000\000\000\000\002\254\000\000\005\186\005\190\000\000\000\000\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\026\000\000\000\000\000\000\014\022\000\000\000\000\000\000\000\000\005\194\003\022\002\198\000\000\003&\002\146\004\130\0032\001\190\000\000\002\254\000\000\000\000\000\000\002\186\000\000\000\000\004\006\000\000\000\000\001\210\004\n\000\000\004\018\005\162\000\000\005\174\003\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\178\000\000\003&\000\000\000\000\0032\001\190\000\000\005\186\005\190\000\000\006\002\002\186\000\000\000\000\004\006\000\000\000\000\000\000\004\n\000\000\004\018\005\162\000\000\005\174\000\000\000\000\014\"\000\000\000\000\000\000\000\000\005\194\003\022\002\198\000\000\005\178\002\146\004\130\000\000\000\000\000\000\002\254\000\000\005\186\005\190\000\000\006\002\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\026\000\000\000\000\007\241\007\166\000\000\000\000\000\000\007\241\005\194\000\000\007\241\000\000\003&\000\000\004\130\0032\001\190\000\000\000\000\000\000\007\241\000\000\002\186\000\000\007\241\004\006\007\241\000\000\000\000\004\n\000\000\004\018\005\162\000\000\005\174\000\000\000\000\000\000\007\241\000\000\000\000\000\000\000\000\000\000\007\241\b\"\005\178\000\000\000\000\000\000\000\000\000\000\000\000\007\241\005\186\005\190\007\241\006\002\000\000\000\000\000\000\007\241\007\241\000\238\001\153\000\000\000\000\000\000\000\000\001\153\000\000\000\000\001\153\000\000\000\000\000\000\000\000\007\241\005\194\000\000\000\000\007\241\001\153\000\000\004\130\000\000\001\153\000\000\001\153\000\000\000\000\007\241\007\241\000\000\000\000\007\241\007\241\000\000\000\000\000\000\001\153\000\000\000\000\000\000\000\000\000\000\001\153\000\000\001\189\000\000\000\000\000\000\007\241\001\189\000\000\001\153\001\189\000\000\001\153\000\000\000\000\000\000\000\000\001\153\001\153\001\153\001\189\000\000\000\000\000\000\001\189\000\000\001\189\000\000\000\000\000\000\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\153\001\189\000\000\000\000\000\000\000\000\000\000\001\189\000\000\000\000\001\153\001\153\000\000\000\000\001\153\001\153\001\189\000\000\000\000\001\189\021j\000\000\000\000\000\000\001\189\001\189\000\000\000\000\000\000\000\000\000\000\001\153\000\000\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\189\000\000\006\233\000\000\001\189\000\000\000\000\006\233\000\000\000\000\006\233\000\000\000\000\000\000\001\189\001\189\000\000\000\000\001\189\001\189\006\233\000\000\000\000\000\000\006\233\000\000\006\233\000\000\001\189\000\000\000\000\000\000\000\000\000\000\000\000\001\189\000\000\000\000\006\233\000\000\025\014\000\000\000\000\000\000\006\233\000\000\001\189\000\000\000\000\000\000\000\000\000\000\000\000\006\233\000\000\000\000\006\233\000\000\000\000\000\000\000\000\006\233\006\233\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\233\000\000\r\213\000\000\006\233\000\000\000\000\r\213\000\000\000\000\r\213\000\000\000\000\000\000\006\233\006\233\000\000\000\000\006\233\006\233\r\213\000\000\000\000\000\000\r\213\000\000\r\213\000\000\006\233\000\000\000\000\000\000\005\201\000\000\000\000\006\233\000\000\000\000\r\213\000\000\000\000\000\000\000\000\000\000\r\213\000\000\006\233\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\213\000\000\000\000\000\000\000\000\r\213\r\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\141\000\000\002\198\r\141\000\000\031\206\000\000\r\213\000\000\000\000\031\210\000\000\000\000\r\141\000\000\000\000\000\000\000\000\000\000\r\141\000\000\r\213\r\213\002\138\000\000\r\213\r\213\000\000\000\000\000\000\000\000\r\141\000\000\000\000\000\000\r\213\000\000\r\141\000\000\030V\000\000\000\000\r\213\001\002\001\190\000\000\r\141\000\000\000\000\r\141\000\000\000\000\000\000\r\213\r\141\000\000\000\000\000\000\000\000\000\000\tQ\tQ\031\214\000\000\tQ\000\000\000\000\000\000\000\000\tQ\r\141\000\000\000\000\000\000\r\141\019V\000\000\000\000\000\000\tQ\000\000\000\000\000\000\031\218\r\141\r\141\tQ\000\000\r\141\005%\000\000\000\000\000\000\000\000\005%\000\000\000\000\005%\000\000\tQ\000\000\000\000\tQ\tQ\000\000\r\141\000\000\005%\000\000\tQ\000\000\005%\tQ\005%\000\000\000\000\tQ\000\000\tQ\tQ\000\000\tQ\000\000\000\000\000\000\005%\000\000\000\000\000\000\000\000\000\000\005%\000\000\tQ\000\000\000\000\000\000\b\130\000\000\000\000\005%\tQ\tQ\005%\000\000\000\000\000\000\000\000\005%\002\234\000\238\000\000\001U\000\000\000\000\000\000\000\000\001U\000\000\000\000\001U\000\000\000\000\000\000\005%\tQ\000\000\000\000\005%\000\000\001U\tQ\001U\000\000\001U\000\000\001U\000\000\005%\005%\000\000\000\000\005%\005%\000\000\000\000\000\000\000\000\001U\000\000\000\000\000\000\000\000\000\000\001U\000\000\000\209\000\000\000\000\005%\000\000\000\209\000\000\000\000\000\209\000\000\001U\000\000\000\000\000\000\000\000\001U\001U\000\238\000\209\000\000\000\000\000\000\000\209\000\000\000\209\000\000\000\000\000\000\000\000\000\000\000\000\001U\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\000\000\000\000\000\000\209\000\000\000\000\001U\001U\001U\000\000\001U\001U\000\209\000\000\000\000\000\209\000\000\000\000\000\000\000\000\000\209\000\209\000\238\000\000\000\213\000\000\000\000\001U\000\000\000\213\000\000\000\000\000\213\000\000\000\000\000\000\000\209\000\000\001U\000\000\000\209\000\000\000\213\000\000\000\000\000\000\000\213\000\000\000\213\000\000\000\209\000\209\000\000\000\000\000\209\000\209\000\000\000\000\000\000\000\000\000\213\000\000\000\000\000\000\000\000\000\000\000\213\000\000\007\237\000\000\000\000\000\209\000\000\007\237\000\000\000\213\007\237\000\000\000\213\000\000\000\000\000\000\000\209\000\213\000\213\000\238\007\237\000\000\000\000\000\000\007\237\000\000\007\237\000\000\000\000\000\000\000\000\000\000\000\000\000\213\000\000\000\000\000\000\000\213\007\237\000\000\000\000\000\000\000\000\000\000\007\237\000\000\000\000\000\213\000\213\000\000\000\000\000\213\000\213\007\237\000\000\000\000\007\237\000\000\000\000\000\000\000\000\007\237\007\237\000\000\000\000\006\221\000\000\000\000\000\213\000\000\006\221\000\000\000\000\006\221\000\000\000\000\000\000\007\237\000\000\000\213\021:\007\237\000\000\006\221\000\000\000\000\000\000\006\221\000\000\006\221\000\000\007\237\007\237\020\142\000\000\007\237\007\237\000\000\000\000\000\000\000\000\006\221\000\000\000\000\000\000\000\000\000\000\006\221\000\000\0061\007\166\000\000\007\237\000\000\0061\000\000\006\221\0061\000\000\006\221\000\000\000\000\000\000\000\000\006\221\006\221\000\000\0061\000\000\000\000\000\000\0061\000\000\0061\000\000\000\000\000\000\000\000\r=\000\000\006\221\000\000\000\000\r=\006\221\0061\r=\000\000\000\000\000\000\000\000\0061\b\"\000\000\006\221\006\221\r=\000\000\006\221\006\221\r=\000\000\r=\0061\000\000\000\000\000\000\000\000\0061\0061\000\238\000\000\000\000\000\000\r=\006\221\000\000\000\000\000\000\000\000\r=\000\000\000\000\000\000\0061\000\000\000\000\001\202\002\142\r=\000\000\002\146\r=\000\000\000\000\000\000\000\000\r=\0061\0061\000\000\000\000\0061\0061\000\000\000\000\001\210\001\250\001\230\000\000\000\000\000\000\000\000\r=\011\022\000\000\001\242\r=\000\000\0061\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r=\r=\002\154\002\162\r=\r=\000\000\002\174\000\000\002\186\004.\004:\004\253\000\000\000\000\000\000\024\230\004\253\030\002\004\245\004\253\r=\000\000\000\000\004\245\000\000\000\000\004\245\000\000\000\000\004\253\000\000\rn\004J\004\253\000\000\004\253\004\245\000\000\000\000\000\000\004\245\005\190\004\245\000\000\000\000\000\000\000\000\004\253\000\000\000\000\000\000\030\014\000\000\004\253\004\245\000\000\000\000\000\000\000\000\000\000\004\245\000\000\004\253\000\000\000\000\004\253\000\000\000\000\024\250\004\245\004\253\000\000\004\245\000\000\000\000\000\000\000\000\004\245\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\253\000\000\000\000\000\000\004\253\005\021\000\000\004\245\000\000\000\000\005\021\004\245\004\229\005\021\004\253\004\253\000\000\004\229\004\253\004\253\004\229\004\245\004\245\005\021\000\000\004\245\004\245\005\021\000\000\005\021\004\229\000\000\000\000\000\000\004\229\004\253\004\229\000\000\000\000\000\000\000\000\005\021\004\245\000\000\000\000\000\000\020\182\005\021\004\229\000\000\005%\000\000\000\000\023\198\004\229\005%\005\021\000\000\005%\005\021\000\000\000\000\000\000\004\229\005\021\000\000\004\229\000\000\005%\000\000\000\000\004\229\005%\000\000\005%\000\000\000\000\000\000\000\000\000\000\005\021\000\000\000\000\000\000\005\021\000\000\005%\004\229\000\000\000\000\000\000\004\229\005%\000\000\005\021\005\021\000\000\000\000\005\021\005\021\000\000\004\229\004\229\000\000\005%\004\229\004\229\000\000\000\000\005%\002\234\000\000\000\000\000\000\000\000\005\021\001\202\001\206\000\000\000\000\000\000\000\000\004\229\000\000\000\000\005%\024\170\000\000\000\000\000\000\002\158\000\000\000\000\028\"\000\000\001\210\001\250\001\230\000\000\005%\005%\000\000\000\000\005%\005%\001\242\005\005\000\000\000\000\b6\000\000\005\005\002\002\000\000\005\005\000\000\000\000\000\000\001\246\002\162\005%\000\000\000\000\002\174\005\005\002\186\004.\004:\005\005\000\000\005\005\000\000\004F\000\000\000\000\004\237\000\000\000\000\000\000\000\000\004\237\000\000\005\005\004\237\000\000\000\000\000\000\000\000\005\005\004J\000\000\000\000\000\000\004\237\000\000\000\000\000\000\004\237\000\000\004\237\005\005\005\029\000\000\000\000\000\000\005\005\005\029\000\000\000\000\005\029\000\000\004\237\000\000\000\000\000\000\000\000\000\000\004\237\018\158\005\029\000\000\005\005\000\000\005\029\000\000\005\029\000\000\000\000\000\000\004\237\000\000\000\000\001\202\001\206\004\237\005\005\005\005\005\029\000\000\005\005\005\005\000\000\000\000\005\029\000\000\000\000\000\000\000\000\004\014\000\000\004\237\001\210\001\250\001\230\000\000\005\029\005\005\000\000\000\000\000\000\005\029\001\242\000\000\000\000\004\237\004\237\000\000\022\n\004\237\004\237\000\000\000\000\000\000\000\000\001\246\002\162\005\029\000\000\000\000\002\174\000\000\002\186\004.\004:\000\000\004\237\000\000\000\000\004F\000\000\005\029\005\029\000\000\000\000\005\029\005\029\024R\000\000\000\000\000\000\000\000\000\000\0059\000\000\000\000\004J\000\000\000\246\000\000\b\157\002\202\005\029\b\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003r\000\000\024\210\000\000\0059\000\000\003v\000\000\b\157\b\157\000\000\b\157\b\157\000\000\000\000\000\000\000\000\000\000\003\130\000\000\000\000\004~\000\000\004\130\020z\b\177\000\000\000\000\b\177\000\000\000\000\000\000\b\157\028N\000\000\000\000\020\222\000\000\000\000\000\000\000\000\020\246\000\000\000\000\b\177\b\177\000\000\b\177\b\177\000\000\b\157\000\000\000\000\000\000\000\000\000\000\000\000\020\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\177\000\000\000\000\021\018\021N\000\000\000\000\0059\0059\000\000\000\000\000\000\b\157\000\000\b\157\000\000\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\025\142\000\000\006\026\000\000\000\000\b\157\b\157\000\000\b\137\000\000\b\157\b\137\b\157\000\000\000\000\000\000\b\157\b\181\000\000\000\000\b\181\000\000\000\000\000\000\b\177\000\000\b\177\b\137\b\137\000\000\b\137\b\137\000\000\000\000\000\000\000\000\b\181\b\181\b\177\b\181\b\181\006\"\b\177\000\000\b\165\000\000\b\177\b\165\b\177\000\000\000\000\b\137\b\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\181\000\000\000\000\b\165\b\165\000\000\b\165\b\165\000\000\b\137\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\165\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\137\000\000\b\137\000\000\000\000\000\000\000\238\000\000\000\000\b\181\000\000\b\181\000\000\000\000\b\137\000\000\000\000\006\"\b\137\000\000\014\149\014\149\b\137\b\181\b\137\000\000\006\"\b\181\b\137\000\000\000\000\b\181\000\000\b\181\000\000\000\000\b\165\b\181\b\165\014\149\014\149\014\149\007\186\000\000\000\000\000\000\000\000\000\000\000\000\014\149\006~\000\000\000\000\006\"\b\165\000\000\000\000\000\000\b\165\000\000\b\165\000\000\014\149\014\149\b\165\000\000\000\000\014\149\000\000\014\149\014\149\014\149\000\000\000\000\000\000\000\000\014\149\001\202\001\206\026B\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\202\001\206\026\162\000\000\000\000\014\149\000\000\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\242\001\210\001\214\001\230\000\246\000\000\000\000\002\202\000\000\000\000\000\000\001\242\000\000\001\246\002\162\000\000\000\000 \022\002\174\000\000\002\186\004.\004:\003v\001\246\002\162\000\000\004F\000\000\002\174\000\000\002\186\004.\004:\000\000\003\130\000\000\000\000\004F\000\000\000\000\020z\000\000\000\000\004J\000\000\000\000\000\000\001\202\001\206\028N\000\000\000\000\020\222\000\000\004J\000\000\000\000\020\246\000\000\000\000\000\000\000\000\001\202\001\206\000\000\000\000\001\210\001\250\000\000\000\000\000\000\000\000\000\000\020\254\000\000\000\000\000\000\031\198\000\000\000\000\000\000\001\210\001\250\000\000\000\000\000\000\000\000\021\018\021N\001\246\002\178\005a\000\000\000\000\002\174\000\000\002\186\004.\004:\000\000\000\000\000\000\000\000\004F\001\246\002\178\000\000\000\000\025\142\002\174\000\000\002\186\004.\004:\000\000\000\000\000\000\000\000\004F\000\000\004J\000\000\000\000\005\153\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004J\000\000\000\000\005\157\029\174\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\029\174"))
+    ((16, "n\218x\156sZ\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\248sZ\000\000\000\000\021\000sZn\218\003F\005F\001H\169t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000x\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000O\006P\000P\000\000\001\150\b\136\000\000\000\172\001\166\t\136\000\000\003$\002@\n\136\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\204\000\000\000\000\000\000\002V~\184\000\000\000\000\000\000\002\164\000\000\000\000\131\204\003V\003\"\000\000\000\000\210\208\002\164\000\000t\166\021\000}\136\1702\004n\000\000\021\000\133Tx\028\021\000z\216\000\000\001\022\000\000z\216\001\192\000\000lZ\000\000\001l\000\000\000\000\004B\000\000\002\164\000\000\000\000\000\000\005P\000\000lZ\000\000\006\230\203\134\208p\179~\000\000\209\224\210\208\000\000y\136\194\224\000\000\208\208\026\184~\184sZn\218\000\000\000\000x\028\021\000{Bz\216\007\014\198\242\000\000\2066sZn\218x\156\021\000\000\000\000\000\017\000t\132\021\000\165N\165<\000\000\004\158\000\000\000\000\005h\000\000\000\000t8\022\140\021\188\002\248\000\007\000\000\000\000\002&\000\000}\136\004\150\004t\021\000\023\238\021\000n\218n\218\000\000\000\000\000\000w\206s\178\021\000\023\238\005\190\000\000uV\021\000\132\152\023\228\020\160\007D\000\000\005\226\007V\000\000\000\000\000\000\000\000\000\000\021\000\000\000\000\000\000\000\017\000\000\000x\156\021\000\000\000l\238\191\154~V\001\000\133T\165<\192*\192*\000\000\007D\000\000\000\028\000\000\000\000\022\150\184\004\196\190\000\000\184\004\196\190\000\000\184\004\184\004\003\014\007\004\004\028\000\000\004\228\000\000\006\176\000\000\000\000\007\230\000\000\000\000\000\000\184\004\002\164\000\000\000\000\166\216\184\004\164J\194\224\000\000\t\004\027\214\210\208\194\224\006\188\184\004\000\000\000\000\000\000\000\000\000\000\000\000\127B\194\224\128@\003\014\000\000\000\000\000\000\000F\000\000\000\000\167\156\bD\002\164\000\000\000\000\129>\000\000\000\000\000\000\bJ\000\000\184\004\000\000\001\b\197\216\000\000\184\004\006\b\184\004nv\000\000o\216\000\000\007\b\nJ\000\000\b\192\184\004\n\216\000\000\011\030\000\000\002\128\000\000\000\000\005\224\000\000\000\000\000\000&\212\031(\165<x\156\021\000\165<\000\000\003\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000zz\028\198\000\000\000\000\000\000\002\004\031\210\192*\000\000\000\000x\156\021\000\165<\165<\000\000\tB\165<\000\000\000\000\000\000\000\000\165<\000\000\171T\165<\212p\199h\000\000\212\190\000\000\1660t8\003\170\003\170\000\000\n\244\165<\000\000\024R\011\170\000\000l$\000\000\000\000\199\246\000\000\213\012\199\028\000\000\011\136\000\000\000\000\200X\000\000\213h\003\160\000\000\000\000\000\000\000\000\000\000\012\012\000\000m\210\000\000\000\000\198\006\000\000\000\202\000\000\000\000pl\192\188\000\000\000\000m\148\020\160\022\146\026v\000\000\000\000\000\000\000\000\b8\000\000\000\000\168n\011\016\012F\001\228\184\004\000\234\012\138\000\000\000\000\011F\012F\005\234\000\000x\240x~s\178\021\000\023\238\000F\004\188\000\007\000\000\012\"}\136qll:\000F\004\188\004\188}\136\007\188}\136\000\000\185\n\004\160z\216\007D\007L\214B\000\000\184\004\179\222\184\004\173:\180\162\184\004\007\234\184\004\181&\000\000\011\246\b\230\bV}\136\185\140\000\000\n\004\006\160\1706\000\000\000\000\000\000\000\000\000\000}\136\186\014}\136\186\144\021\002\003\014\173\254\007V\003\014\174\128\000\000\187\018\004\160\000\000\000\000\187\148\029:\000\000\000\000\023\140\000\000\t\188\023\238\000\000\171\030uV\000\000\025z\000\000\000\000}\136\029\226\000\000\000\000\000\000\000\000\169\004\000\000\011X\000\000\130\018\t\208\022J\134\016\022\238{\212x\156\021\000q\168x\138\021\000\017\000\017\000\000\000\000\000\000\000\000\000\002\000\024\210m\228\000\000{f|\"s\178\021\000\023\238\002\206}\136\000\000\030\140\000\000|\222}\154\203\242\024F\184\004\nL\000\000x\156\021\000\000\000\193J\021\000\192*\165<\025^\000\000x\240\021\000v\"\004F\000\000\165<n\142\184\004\002\234\005\234\r\234\000\000\000\000\000\000u,\003\170\014N\000\000\165<\000\000\000\000\181\226\000\000\000\000\007\"\194\224\003\014\014\176\134\204\193J\021\000\192*\026\238\135\136\193J\021\000\192*\027\238\165<\000\000\000\000x\156\021\000\165<\028\"\000\000x\138\021\000\017\000\022\238\017\000\003\000\004\232w\018\193J\021\000\192*rJw\018\136D\193J\021\000\192*\000\000\017\000\012\016\015V\000*\210\208\000\000\029\212\211\240\000\000o\130\184\004\030\212\015\204\000\000\000\000\015\142\000\000\017\000\004\000\015\170\000\000\023\214\000\000\t*\000\000\000\000\028\238\137\000\193J\021\000\192*\029\238\018\000\023\238\000\000\000\000\000\000\000\000\t:\000\000\000\000\000\000\030\238\137\188\193J\021\000\192*\031\238 \238\138x\193J\021\000\192*!\238\"\238\000\000\019\000\024\238\1394\193J\021\000\192*\000\000\000\000\000\000sZ\000\000\000\000\000\000\139\240\193J\021\000\192*#\238$\238\140\172\193J\021\000\192*%\238&\238\141h\193J\021\000\192*'\238(\238\142$\193J\021\000\192*)\238*\238\142\224\193J\021\000\192*+\238,\238\143\156\193J\021\000\192*-\238.\238\144X\193J\021\000\192*/\2380\238\145\020\193J\021\000\192*1\2382\238\145\208\193J\021\000\192*3\2384\238\146\140\193J\021\000\192*5\2386\238\147H\193J\021\000\192*7\2388\238\148\004\193J\021\000\192*9\238:\238\148\192\193J\021\000\192*;\238<\238\149|\193J\021\000\192*=\238>\238\1508\193J\021\000\192*?\238@\238\150\244\193J\021\000\192*A\238B\238\151\176\193J\021\000\192*C\238D\238\152l\193J\021\000\192*E\238F\238\153(\193J\021\000\192*G\238H\238\153\228\193J\021\000\192*I\238J\238\021\000\165<v\"\000\000\000\000~\184\003\170\015j\184\004\n\228\000\000\000\000\005\004\002\164\000\000\184\004\n\234\000\000\000\000\016\016\000\000\000\000\000\000\003\246\000\000\0168\134\204\000\000\000\000\000\000\025F\184\004\011\146\000\000\000\000\031\"\000\000\000\000\200\186\000\000 \"\201\028\000\000!\"\201~\000\000\"\"\004\160\000\000\000\000\000\000\000\000#\"\165<$\"\000\000\193\144\193\144\000\000\000\000\000\000K\238\000\000\b\216\000\000\000\000\000\000\tJ\000\000\000\000\005\226\015\232w\018\011\012\000\000\000\000\171\200w\224\000\000w\018\0128\000\000\000\000w\018\011\244\000\000\000\000\000\000\017\000\005\000\016\232w\018\011*\000\000\006\000\154\160\193J\021\000\192*L\238M\238w\018\012\160\000\000\007\000\155\\\193J\021\000\192*N\238O\238w\018\012\028\000\000\b\000\156\024\193J\021\000\192*P\238Q\238\030\214\000\000\012*\t\000\156\212\193J\021\000\192*R\238S\238\000\000\012\166\n\000\157\144\193J\021\000\192*T\238U\238\000\000\012\198\011\000\158L\193J\021\000\192*V\238W\238\t\228\017\232w\018\012\136\012\000\159\b\193J\021\000\192*X\238Y\238w\018\r\b\r\000\159\196\193J\021\000\192*Z\238[\238w\018\r\028\014\000\160\128\193J\021\000\192*\\\238]\238\015\000\161<\193J\021\000\192*^\238_\238\016\000\020\000\000\000\000\000\000\000\000\000\r*\000\000w\018\r\012\000\000w\018\rx\000\000\rT\000\000\000\000\000\000\0160\000\000\n\b\000\000\000\000`\238\000\000\016\198\000\000\000\000\000\000\000\000\000\000\000\000a\238\017\b\161\248\193J\021\000\192*b\238\162\180\193J\021\000\192*c\238d\238e\238\163p\193J\021\000\192*f\238g\238\000\000%\"\000\000\000\000\012\014\000\000\000\000\165<\000\000\000\000\194@\rN\000\000\000\000\130\018\000\000\r\"\000\000\000\000\130\224\000\000\r\172\000\000\000\000\006d\012j\000\000\000\000\022\238\0242\007D\000\000nZ (\028v\027\142\000\000\000\000\r\198\000\000\000\000\002&\026\210{\254\000\000\025\238\000\000\r\136\000\000\000\000\014\006\000\000\000\000\193J\021\000\192*\030L\182P\005\166\006d\000\000\000\000\014\004\000\000\000\000\r\246\000\000\000\000\000\000\021\000\023\238\012X\000\000\000\000\021\188\002\248\000\007\005\228\023\238\201\202\134\186\000\000\000L\023\238\202N\016\140\000\000\000\000\005\228\000\000\023\230\020\196\021\192\000\000\r\138\017\012\000\000\017\012\003\234\194\224\000\252\000\000\016\234\016\148~\184\014\004\184\004m\018\020\226\014\128\020\226\000\000r\018\017J\000\000\000\252\000\000\000\000\017\128\194\224\175\002\000\000\182\242\214\232\014D\194\224\017P\194\224\188\022\175\190\017V\194\224\188v\176z\007\b\017\016\000\000\000\000\000\000\021\000\206\212\000\000\165<\193\144\000\000\000\000\017\136\000\000\000\000\000\000\193J\021\000\192*h\238i\238\000\000\014N\000\000\000\000\000\000s\178\021\000\023\238\003\228\000\000\135v\000\000\031\140\000\000\000*\000\000\000\000\017\138\000\000\017\188\192*j\238\017d\000\000\000\000\193J\021\000\192*\021\246\000\000\000\000\1362\000\000 \140\000\000\136\238\000\000\021\000\000\000}\136 \210\000\000\183b\000\000\000\000\137\170\000\000!$\000\000\138f\000\000\024\140\000\000}\136!:\000\000\2066\000\000\021\000\023\238\2066\000\000\029\230\023\228\020\160\002\164\208\234}\136\204\136\193\144\000\000\002\248\005\248\000\007\005\228\193\144\128\n\002\248\000\007\005\228\193\144\128\n\000\000\000\000\005\228\193\144\000\000sZn\218\165<\027\"\000\000\000\000sZn\218s\178\021\000\023\238\2066\000\000\003F\005F\001H\016\234~\184\014T\184\004\194\206\017\022\017\186\209`\000\000\193\144\000\000\195n\023\230\020\196\021\192\202\184\026T\014<\002\n\r\162\017\020\021\000\193\144\000\000\021\000\193\144\000\000\184\004\184\004\025b\000\246\002\248\003\014\172\218\000\000\002\248\003\014\172\218\000\000\030\020\023\228\020\160\002\164\189R}\136\206\212\000\000\002\248\007\162\024\188\r\160\000\000\172\218\000\000\000\007\017\020}\136\206\212\211\030\002\248\000\007\017\"}\136\206\212\211\030\000\000\000\000\006\228\014\176\000\000\206~\000\000}\136\209\182\172\218\000\000\007\228\014\176\000\000t\166\021\000}\136\206\212\000\000\023\230\020\196\021\192\195\156p\012\027\184\020J\005\208\000\000\011JlZ\006\254\000\000\017\158\017LsH\021\000oH\184\004\n\234\000\000z\000\020\196\003\208\014\164\000\000\bJ\000\000\017\164\0170\184\004\134\016\000\000\000>\001\208\001\252\000\000\014J\000\000\017\180\017@~\184p\154\000\000\020\196sH\017\226\021^\002\248\000\000\014:sH\184\004\014t\003\014\000\000\184\004\tt\nt\000\000\000\000\188\252\000\000\000\000\014fsH\189\128\134\016\000\000\021\000\184\004\014\228\184\004\130\018p\154\000\000\014\198\000\000\000\000p\154\000\000\000\000z\000\000\000\2066\129\b\020J\005\208\011J\017\204\017|sH\2066\129\b\000\000\000\000\020J\005\208\011J\017\226\017p\213\250y\146\194\224\018\014\213\250\184\004\024t\018 \213\250\194\224\018\"\213\250\190>\190\192\000\000\207t\000\000\000\000\172\218\211L\020J\005\208\011J\018 \017\190\213\250\172\218\211L\000\000\000\000\000\000\184\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\172\218\000\000\175\136\021\000r:\018>\198\242\000\000\2066\175\136\000\000\000\000\211z\021\000r:\018D\017\208\208p\211\240\000\252\018\130\000\000\000\000\191 \195\156\021\000\000\000\204\182\021\192\000\000\000\000\172\218\211z\000\000\000\000\000\000\202\230u\148v4\000\252\018\132\000\000\000\000\000\000\195\156\021\000\000\000\000\252\018\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\np\012\020J\005\208\011J\018^\192*\127p\021\000\165N{\174\021(\007\180\000\252\018d\007\240\000\000\000\000\018\022\000\000\000\000|j\000\000\006\208\015^\000\000\015J\000\000\018p\018\018\184\004\130\224\018\142\b\234\000\000\000\000\018H\000\000\000\000\021D\000>\015>\000\000\018\158\196\\\214\138\003\170\018:\184\004\015L\000\000\000\000\018P\000\000\000\000\000\000|j\000\000\004\252\015\204\000\000\015p\000\000\018\170\018:~\184\000\000\018\186\196\234\214\210\003\170\018\\\184\004\015\228\000\000\000\000\018x\000\000\000\000\000\000\021\000\000\000|j\000\000\021\"\020\196\127p\127p\197xsZ\021\000\206\212\165<\t\172\000\000\021j\002\248\000\000\015\132\127p\184\004\015\254\007D\000\000\021\000\165<\192\188\127p\015~\127p\000\000o\198p\180\000\000\176\254\000\000\000\000\177\158\000\000\000\000\178>\000\000\015\216\127p\178\222\206\212\165<\t\172\000\000\005\136\000\000\000\000\213\250\014\204\000\000\000\000v4\018\208\000\000|j\000\000\127pv4|j\000\000\021\000\184\004|j\000\000\015J\000\000\000\000|j\000\000\000\000{\174\000\000\207\166\213\250\018\142\127p\207\212\192*\000\000\193\144\210Z\020J\005\208\011J\018\230\192*\193\144\210Z\000\000\000\000\000\000\212>x\240\000\000\000\000\000\000\000\000\000\000\000\000\131\186\193\144\000\000\175\136\000\000\000\000\000\000\000\000\193\144\212>\000\000\000\000\000\000\131\186\019&\000\000\0198\000\000\193\144\212>\000\000\000\000\016J\000\000\000\000\184\136 :\000\000\000\000pl\000\000\184\004\r\170\000\000{\174\016\136\000\000\000\000\019h\198\006\000\000k\238\019B\000\000\000\000\019:\027\166\028\166\021\192\195\156\026T\021\000\000\000\193\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\198R\026T\021\000\000\000\015\158\198\242\000\000\2066\000\000\019<\027\166\028\166\193\144\000\000\019\\\000\000\004\246\015\004\021\000\210@\000\000\000\000\030\208\213h\000\000\000\000\018\246\000\000\019P\184\004\000\000\016\138\t\014\003\014\000\000\000\000\184\004\007\228\b\228\184\004\t\228\000\252\019~\000\000\000\000\205N\000\000\000\000\208p\000\000\172\218\000\000\019r\027\166\029\178\172\218\000\000\000\000\000\000\000\000\016\158\205 \208p\000\000\172\218\000\000\019t\027\166\029\178\172\218\000\000\016\198\000\000\000\000!\140\000\000\193\144\000\000\019\134\000\000\000\000\018\234\000\000\nR\000\000\000\000\019\006\000\000\000\000\184\004\019\012\000\000\000\000\028\230\169t\019\170\000\000\000\000\000\000\015\004\006\160\172|\019\176\000\000\000\000\000\000\000\000\000\000\000\000\0194\000\000\026T\000\000\0196\000\000\184\004\000\000\016R\000\000\000\000\019D\000\000\000\000\003\014\000\000\012\254\000\000\000\000\000\000\015\240\000\000\023\238\000\000\nF\000\000}\136\000\000\025d\000\000\b\230\000\000\019F\000\000\165<\026\"\000\000\000\000\b\160\019H\000\000\000\000\019>\t\158q\168\002\164\206\b\000\000\000\000\000\000\000\000\000\000\180\208\000\000\000\000\019\238\000\000\179\172\000\000\016\138\019\248\000\000\019\254\000\000r\154r\154\1648\1648\000\000\000\000\193\144\1648\000\000\000\000\000\000\193\144\1648\019j\000\000\019t\000\000"), (16, "\003\197\003\197\000\006\003F\003J\003\197\002\194\002\198\003\197\002\242\002\146\003\197\001b\003\197\004&\002\254\003\197\007\142\003\197\003\197\003\197\019\230\003\197\003\197\003\197\001\210\001z\t\021\001\138\003\002\003\197\003z\003~\011\154\003\197\005\r\003\197\004*\003\006\007\194\003\166\019\234\003\197\003\197\003\218\003\222\003\197\003\226\003\230\003\197\003\234\003\246\004\002\004\n\007n\004\250\003\197\003\197\002\186\005\r\001*\003\254\003\197\003\197\003\197\b\218\b\222\b\234\b\254\000\238\005\182\003\197\003\197\003\197\003\197\003\197\003\197\003\197\003\197\003\197\tr\bB\003\197\005\r\003\197\003\197\005\r\t~\t\150\n:\005\194\005\198\003\197\003\197\003\197\000\238\003\197\003\197\003\197\000\238\003\197\006\246\000\238\016\226\003\197\001f\003\197\003\197\004%\003\197\003\197\003\197\003\197\003\197\003\197\005\202\b\242\003\197\003\197\003\197\t\n\004\138\nN\006\250\003\197\003\197\003\197\003\197\014E\014E\002\001\n\166\018\138\014E\n\178\014E\014E\004Q\014E\014E\014E\014E\001j\014E\014E\014\t\014E\014E\014E\004E\014E\014E\014E\014E\005\r\014E\000\n\014E\014E\014E\014E\014E\014E\014E\014E\014\t\014E\018\210\014E\005:\014E\014E\014E\014E\014E\014E\014E\014E\006\181\014E\014E\000\238\014E\004\006\014E\014E\014E\002\001\014\017\014E\014E\014E\014E\014E\014E\014E\000\238\014E\014E\014E\014E\014E\014E\014E\014E\014E\014E\014E\014\017\014E\014E\004Q\014E\014E\002R\001\002\001\190\005\r\014E\014E\014E\014E\014E\001r\014E\014E\014E\002V\014E\014E\014\r\014E\014E\001\130\014E\014E\023\"\014E\014E\014E\014E\014E\014E\014E\014E\014E\014E\014E\014E\014E\014\r\005\r\014E\014E\014E\014E\001\153\001\153\001\153\0026\023*\001\153\004M\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\023&\001\153\tA\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\003R\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\tI\001\153\001\153\001\153\001\153\001\146\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\004M\001\153\001\153\001\153\001\153\001\153\005\134\001\153\002B\001\218\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\007J\001\153\001\153\001\153\t\"\001\153\005\250\001\153\001\153\021\146\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\001\153\017\230\001\153\001\153\001\153\001\153\001\153\011\177\011\177\005\r\005\r\003V\011\177\001\222\011\177\011\177\004\201\011\177\011\177\011\177\011\177\001\206\011\177\011\177\005\r\011\177\011\177\011\177\005\138\011\177\011\177\011\177\011\177\b\158\011\177\001\198\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\001f\011\177\000\238\011\177\004%\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\007\213\011\177\011\177\000\238\011\177\005.\011\177\011\177\011\177\002\170\000\238\011\177\011\177\011\177\011\177\011\177\011\177\011\177\000\n\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\006\194\011\177\011\177\004\201\011\177\011\177\002\001\002\001\tF\004\230\011\177\011\177\011\177\011\177\011\177\001\234\011\177\011\177\011\177\002\001\011\177\nf\001\182\n\234\011\177\006\213\011\177\011\177\022\246\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\011\177\001\186\011\177\011\177\011\177\011\177\011\177\004m\004m\001\238\001\002\001\190\004m\019\206\004m\004m\006f\004m\004m\004m\004m\004^\004m\004m\022\254\004m\004m\004m\001\206\004m\004m\004m\004m\018\202\004m\006\189\004m\004m\004m\004m\004m\004m\004m\004m\b\158\004m\002^\004m\t\166\004m\004m\004m\004m\004m\004m\004m\004m\000\238\004m\004m\003\233\004m\002\022\004m\004m\004m\002b\006\213\004m\004m\004m\004m\004m\004m\004m\003\233\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\014J\n^\n\226\003^\004m\004m\t\170\t\198\007\198\b\005\004m\004m\004m\004m\004m\003b\004m\004m\004m\019\210\004m\nf\019*\n\234\004m\n\166\004m\004m\n\178\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\004m\b\002\004m\004m\004m\004m\004m\004]\004]\026\158\001\002\001\190\004]\004f\004]\004]\007\174\004]\004]\004]\004]\005\r\004]\004]\007\138\004]\004]\004]\003\030\004]\004]\004]\004]\026\166\004]\r\190\004]\004]\004]\004]\004]\004]\004]\004]\004Z\004]\nj\004]\003\"\004]\004]\004]\004]\004]\004]\004]\004]\t9\004]\004]\016\142\004]\016\154\004]\004]\004]\000\238\002v\004]\004]\004]\004]\004]\004]\004]\027\186\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\005\r\n^\n\226\nI\004]\004]\005\r\005\r\027\190\004j\004]\004]\004]\004]\004]\003\150\004]\004]\004]\000\238\004]\nf\018*\n\234\004]\r\198\004]\004]\022\182\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\004]\003*\004]\004]\004]\004]\004]\011\017\011\017\003F\003J\000\238\011\017\005\146\011\017\011\017\007\253\011\017\011\017\011\017\011\017\003.\011\017\011\017\020\206\011\017\011\017\011\017\002z\011\017\011\017\011\017\011\017\005\r\011\017\014i\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\007\138\011\017\nI\011\017\014i\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\nM\011\017\011\017\027\194\011\017\015\006\011\017\011\017\011\017\001f\004%\011\017\011\017\011\017\011\017\011\017\011\017\011\017\000\238\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\018v\011\017\011\017\007j\011\017\011\017\014\166\b\"\003\186\005\r\011\017\011\017\011\017\011\017\011\017\004n\011\017\011\017\011\017\018~\011\017\011\017\b\226\011\017\011\017\004\138\011\017\011\017\026\018\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\011\017\001\206\005\r\011\017\011\017\011\017\011\017\011!\011!\005J\031\026\001\222\011!\nM\011!\011!\004\190\011!\011!\011!\011!\001\206\011!\011!\026\026\011!\011!\011!\022\198\011!\011!\011!\011!\n-\011!\006\181\011!\011!\011!\011!\011!\011!\011!\011!\007\138\011!\002\134\011!\002\198\011!\011!\011!\011!\011!\011!\011!\011!\003\190\011!\011!\004Z\011!\015.\011!\011!\011!\002\222\007\209\011!\011!\011!\011!\011!\011!\011!\000\238\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\022V\011!\011!\005\r\011!\011!\003\178\003F\022\n\n-\011!\011!\011!\011!\011!\003\194\011!\011!\011!\022f\011!\011!\022\030\011!\011!\004v\011!\011!\002z\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\011!\004n\n-\011!\011!\011!\011!\011\025\011\025\t\250\005\r\007\210\011\025\n\001\011\025\011\025\007\182\011\025\011\025\011\025\011\025\005\r\011\025\011\025\007\138\011\025\011\025\011\025\007\218\011\025\011\025\011\025\011\025\000\238\011\025\0072\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\007\138\011\025\004z\011\025\023\002\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\000\238\011\025\011\025\000\238\011\025\015V\011\025\011\025\011\025\005*\005\n\011\025\011\025\011\025\011\025\011\025\011\025\011\025\007A\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\022z\011\025\011\025\007\246\011\025\011\025\025\242\002\198\007A\006\193\011\025\011\025\011\025\011\025\011\025\n\001\011\025\011\025\011\025\022f\011\025\011\025\n\166\011\025\011\025\n\178\011\025\011\025\014\138\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\011\025\002\014\001v\011\025\011\025\011\025\011\025\011\005\011\005\014\142\001\002\001\190\011\005\004\250\011\005\011\005\b\014\011\005\011\005\011\005\011\005\001\206\011\005\011\005\0076\011\005\011\005\011\005\n\246\011\005\011\005\011\005\011\005\b:\011\005\005.\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\014\154\011\005\001\222\011\005\n\250\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\000\238\011\005\011\005\004Z\011\005\015~\011\005\011\005\011\005\002\170\014\158\011\005\011\005\011\005\011\005\011\005\011\005\011\005\007I\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\t\237\011\005\011\005\026:\011\005\011\005\003\190\005n\007I\030\n\011\005\011\005\011\005\011\005\011\005\030\"\011\005\011\005\011\005\n\166\011\005\011\005\n\178\011\005\011\005\004\174\011\005\011\005\0112\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\011\005\000\238\001\134\011\005\011\005\011\005\011\005\011\r\011\r\001\002\001\190\016\194\011\r\n\005\011\r\011\r\b\146\011\r\011\r\011\r\011\r\006\"\011\r\011\r\007\138\011\r\011\r\011\r\002\234\011\r\011\r\011\r\011\r\r\138\011\r\b\226\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\005%\011\r\t\237\011\r\030\214\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\000\238\011\r\011\r\004Z\011\r\015\162\011\r\011\r\011\r\005f\0182\011\r\011\r\011\r\011\r\011\r\011\r\011\r\007Q\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\t\233\011\r\011\r\005%\011\r\011\r\b\158\015\226\007Q\003\186\011\r\011\r\011\r\011\r\011\r\n\005\011\r\011\r\011\r\000\238\011\r\011\r\000\238\011\r\011\r\b\030\011\r\011\r\016\198\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\011\r\000\238\001\150\011\r\011\r\011\r\011\r\011\t\011\t\005v\031\159\tn\011\t\014\178\011\t\011\t\022\230\011\t\011\t\011\t\011\t\006r\011\t\011\t\030\218\011\t\011\t\011\t\014\254\011\t\011\t\011\t\011\t\014\182\011\t\n)\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\005~\011\t\t\233\011\t\015\002\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\000\238\011\t\011\t\000\238\011\t\015\198\011\t\011\t\011\t\007B\007Z\011\t\011\t\011\t\011\t\011\t\011\t\011\t\006\170\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\r\178\011\t\011\t\r\206\011\t\011\t\007b\019\142\006\174\002!\011\t\011\t\011\t\011\t\011\t\b\158\011\t\011\t\011\t\005.\011\t\011\t\022\190\011\t\011\t\006\130\011\t\011\t\000\238\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\011\t\014\222\b\214\011\t\011\t\011\t\011\t\011\021\011\021\002\198\b\006\000\238\011\021\005.\011\021\011\021\000\238\011\021\011\021\011\021\011\021\015N\011\021\011\021\014\226\011\021\011\021\011\021\n\246\011\021\011\021\011\021\011\021\006\218\011\021\014\206\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\015R\011\021\014\014\011\021\015z\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\014\210\011\021\011\021\017\166\011\021\015\242\011\021\011\021\011\021\n\158\n\206\011\021\011\021\011\021\011\021\011\021\011\021\011\021\014\178\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\015&\011\021\011\021\014\138\011\021\011\021\017R\007F\015\238\007V\011\021\011\021\011\021\011\021\011\021\b\158\011\021\011\021\011\021\014\154\011\021\011\021\015*\011\021\011\021\015\158\011\021\011\021\000\238\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\011\021\015\194\018^\011\021\011\021\011\021\011\021\011%\011%\007\150\017Z\014\206\011%\015&\011%\011%\017\170\011%\011%\011%\011%\014\222\011%\011%\017\130\011%\011%\011%\014\254\011%\011%\011%\011%\016\018\011%\016\150\011%\011%\011%\011%\011%\011%\011%\011%\0166\011%\017n\011%\016\138\011%\011%\011%\011%\011%\011%\011%\011%\004Z\011%\011%\016\170\011%\016\022\011%\011%\011%\017r\015N\011%\011%\011%\011%\011%\011%\011%\017\254\011%\011%\011%\011%\011%\011%\011%\011%\011%\011%\011%\022\018\011%\011%\016\162\011%\011%\017\150\001\206\003\190\002\158\011%\011%\011%\011%\011%\031\127\011%\011%\011%\017\218\011%\011%\004j\011%\011%\029\022\011%\011%\017\154\011%\011%\011%\011%\011%\011%\011%\011%\011%\011%\011%\011%\011%\017\222\018F\011%\011%\011%\011%\011\029\011\029\018:\018\n\021\150\011\029\017\134\011\029\011\029\t\194\011\029\011\029\011\029\011\029\016\174\011\029\011\029\018J\011\029\011\029\011\029\000\238\011\029\011\029\011\029\011\029\018\014\011\029\r\190\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\018\002\011\029\019\178\011\029\023.\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\002\158\011\029\011\029\018\186\011\029\016:\011\029\011\029\011\029\t\218\r\190\011\029\011\029\011\029\011\029\011\029\011\029\011\029\r\190\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\023n\011\029\011\029\018\246\011\029\011\029\018>\0049\022Z\tE\011\029\011\029\011\029\011\029\011\029\002\198\011\029\011\029\011\029\023\202\011\029\011\029\027\202\011\029\011\029\018\230\011\029\011\029\023b\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\011\029\027\206\022\250\011\029\011\029\011\029\011\029\011\157\011\157\023\154\n\006\bV\011\157\006\197\011\157\011\157\0192\011\157\011\157\011\157\011\157\006~\011\157\011\157\021R\011\157\011\157\011\157\029\206\011\157\011\157\011\157\011\157\bV\011\157\019\182\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\028\n\011\157\023v\011\157\026\030\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\000\238\011\157\011\157\004Z\011\157\016V\011\157\011\157\011\157\026Z\026\170\011\157\011\157\011\157\011\157\011\157\011\157\011\157\023\206\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\023\182\011\157\011\157\t9\011\157\011\157\001\206\005\161\026\022\006\185\011\157\011\157\011\157\011\157\011\157\n\162\011\157\011\157\011\157\014q\011\157\011\157\000\238\011\157\011\157\031\022\011\157\011\157\t=\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\011\157\n\202\n\214\011\157\011\157\011\157\011\157\004Y\004Y\026\162\029\154\026z\004Y\028\014\004Y\004Y\n\230\004Y\004Y\004Y\004Y\027f\004Y\004Y\027>\004Y\004Y\004Y\027J\004Y\004Y\004Y\004Y\014}\004Y\r\170\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\028\238\004Y\014\170\004Y\bV\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\000\238\004Y\004Y\014\198\004Y\014\214\004Y\004Y\004Y\027\158\r\138\004Y\004Y\004Y\004Y\004Y\004Y\004Y\029\"\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\026\218\n^\n\226\bV\004Y\004Y\001\206\005%\031\143\030\006\004Y\004Y\004Y\004Y\004Y\bV\004Y\004Y\004Y\030\166\004Y\nf\r\218\n\234\004Y\000\238\004Y\004Y\023v\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\004Y\r\242\004Y\004Y\004Y\004Y\004Y\0021\0021\016\186\030z\002\234\0021\028\242\002\198\0021\031_\002\146\0021\n\154\0021\016\214\002\254\0021\016\246\0021\0021\0021\018\150\0021\0021\0021\001\210\018\190\n\210\004\022\003\002\0021\0021\0021\0021\0021\n\218\0021\029&\003\006\014\246\003\166\018\218\0021\0021\0021\0021\0021\003\226\003\230\0021\030\022\003\246\001\190\015\030\0021\015F\0021\0021\002\186\018\222\019\006\003\254\0021\0021\0021\b\218\b\222\b\234\030\170\014\234\005\182\0021\0021\0021\0021\0021\0021\0021\0021\0021\019\026\n^\n\226\019:\0021\0021\019J\019^\019\138\019\242\005\194\005\198\0021\0021\0021\019\250\0021\0021\0021\020\006\0021\014\242\021J\015n\0021\021^\0021\0021\021b\0021\0021\0021\0021\0021\0021\005\202\b\242\0021\0021\0021\t\n\004\138\006\214\022&\0021\0021\0021\0021\011\133\011\133\022>\022\206\022\210\011\133\023\n\002\198\011\133\023\014\002\146\011\133\011\133\011\133\0236\002\254\011\133\023:\011\133\011\133\011\133\023R\011\133\011\133\011\133\001\210\023\254\011\133\024\002\003\002\011\133\011\133\011\133\011\133\011\133\011\133\011\133\024&\003\006\015\230\003\166\024*\011\133\011\133\011\133\011\133\011\133\003\226\003\230\011\133\024:\003\246\001\190\016\n\011\133\016.\011\133\011\133\002\186\024J\024V\003\254\011\133\011\133\011\133\b\218\b\222\b\234\024\138\011\133\005\182\011\133\011\133\011\133\011\133\011\133\011\133\011\133\011\133\011\133\024\142\011\133\011\133\024\222\011\133\011\133\025\006\025\n\025\026\025j\005\194\005\198\011\133\011\133\011\133\025\138\011\133\011\133\011\133\025\202\011\133\011\133\025\238\011\133\011\133\025\254\011\133\011\133\026&\011\133\011\133\011\133\011\133\011\133\011\133\005\202\b\242\011\133\011\133\011\133\t\n\004\138\026*\0266\011\133\011\133\011\133\011\133\011\129\011\129\026F\026b\026r\011\129\026\134\002\198\011\129\026\178\002\146\011\129\011\129\011\129\026\182\002\254\011\129\026\194\011\129\011\129\011\129\026\210\011\129\011\129\011\129\001\210\026\230\011\129\027\218\003\002\011\129\011\129\011\129\011\129\011\129\011\129\011\129\0282\003\006\028Z\003\166\028\206\011\129\011\129\011\129\011\129\011\129\003\226\003\230\011\129\028\214\003\246\001\190\029.\011\129\029>\011\129\011\129\002\186\029J\029\174\003\254\011\129\011\129\011\129\b\218\b\222\b\234\029\194\011\129\005\182\011\129\011\129\011\129\011\129\011\129\011\129\011\129\011\129\011\129\029\242\011\129\011\129\029\250\011\129\011\129\0302\030Z\030\146\030\194\005\194\005\198\011\129\011\129\011\129\030\206\011\129\011\129\011\129\030\227\011\129\011\129\030\243\011\129\011\129\031\006\011\129\011\129\031\"\011\129\011\129\011\129\011\129\011\129\011\129\005\202\b\242\011\129\011\129\011\129\t\n\004\138\031?\031O\011\129\011\129\011\129\011\129\002\133\002\133\031k\031\191\031\219\002\133\031\230\002\198\002\133 \027\002\146\002\133\n\154\002\133 /\002\254\002\133 7\002\133\002\133\002\133 s\002\133\002\133\002\133\001\210 {\n\210\000\000\003\002\002\133\002\133\002\133\002\133\002\133\n\218\002\133\000\000\003\006\000\000\003\166\005\r\002\133\002\133\002\133\002\133\002\133\003\226\003\230\002\133\000\000\003\246\001\190\000\000\002\133\000\000\002\133\002\133\002\186\000\000\000\000\003\254\002\133\002\133\002\133\b\218\b\222\b\234\000\000\014\234\005\182\002\133\002\133\002\133\002\133\002\133\002\133\002\133\002\133\002\133\005u\000\000\002\133\000\000\002\133\002\133\000\000\005\r\000\000\005\r\005\194\005\198\002\133\002\133\002\133\000\000\002\133\002\133\002\133\007\022\002\133\000\238\005\r\005u\002\133\005\r\002\133\002\133\005\r\002\133\002\133\002\133\002\133\002\133\002\133\005\202\b\242\002\133\002\133\002\133\t\n\004\138\000\000\005\r\002\133\002\133\002\133\002\133\005\r\007\194\005\r\000\000\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\000\000\005\r\005\r\000\238\005\r\005\r\005\r\020B\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\000\000\005\r\005\r\000\000\000\238\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\bB\005\r\005\r\005\r\005\r\005\r\000\238\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\000\238\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\000\000\000\000\005\r\000\000\000\000\005\r\005\r\005\r\000\238\005\r\000\000\000\238\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\005\r\001*\bN\005\r\005\r\000\238\005\r\002\001\002\001\005\r\018\178\bV\005\r\002\146\005\r\000\000\000\000\020F\000\238\bZ\000\000\005\r\005\r\005\r\000\238\000\000\005\r\005\r\005\r\005\r\020\030\000\129\005\r\000\129\000\n\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\000\000\129\027\006\000\129\000\129\025\226\000\129\000\129\020\"\000\000\000\129\000\129\018\182\000\129\000\129\000\129\000\129\000\000\000\129\026R\000\129\000\129\000\000\002\001\000\129\000\129\018\194\000\129\000\129\000\129\007\225\000\129\023V\000\129\000\129\000\129\000\129\000\129\0272\000\129\000\129\000\129\000\129\000\129\000\000\000\000\000\129\000\129\000\000\007\225\000\129\000\129\005\198\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\000\007u\000\129\000\000\005y\000\129\007\217\000\129\000\000\000\129\007\026\002\198\000\000\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\007u\000\000\000\000\000\129\007\217\000\129\005y\000\000\007\217\000\222\000\000\000\000\000\000\000\129\n\026\020&\000\000\000\000\0206\000\129\000\129\000\129\000\129\000\000\n.\000\129\000\129\000\129\000\129\002}\002}\007\225\000\000\000\000\002}\003\178\002\198\002}\000\000\002\146\002}\b\230\002}\000\000\002\254\002}\000\000\002}\002}\002}\003\030\002}\002}\002}\001\210\000\000\000\000\000\000\003\002\002}\002}\002}\002}\002}\000\000\002}\000\000\003\006\000\000\003\166\003\"\002}\002}\002}\002}\002}\003\226\003\230\002}\007\217\003\246\b\238\000\000\002}\000\000\002}\002}\002\186\000\000\000\000\003\254\002}\002}\002}\b\218\b\222\b\234\000\000\0042\005\182\002}\002}\002}\002}\002}\002}\002}\002}\002}\007\194\n^\n\226\000\000\002}\002}\000\000\000\000\000\000\000\000\005\194\005\198\002}\002}\002}\000\000\002}\002}\002}\b\138\002}\nf\000\000\n\234\002}\000\000\002}\002}\000\000\002}\002}\002}\002}\002}\002}\005\202\b\242\002}\002}\002}\t\n\004\138\bB\002\198\002}\002}\002}\002}\002\145\002\145\002\001\002\001\000\000\002\145\002\001\002\198\002\145\000\000\000\000\002\145\000\000\002\145\003j\000\238\002\145\003\146\002\145\002\145\002\145\000\000\002\145\002\145\002\145\001\210\000\000\000\000\000\n\000\n\002\145\002\145\002\145\002\145\002\145\017\182\002\145\000\000\000\000\n\238\003\178\000\000\002\145\002\145\002\145\002\145\002\145\002\001\000\000\002\145\007\129\003\154\000\000\014\130\002\145\014\146\002\145\002\145\002\186\002\001\002\001\002\001\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\007\129\002\145\002\145\002\145\002\145\002\145\002\145\002\145\002\145\002\145\007\194\n^\n\226\000\000\002\145\002\145\007\130\002\001\000\000\t\233\000\000\000\000\002\145\002\145\002\145\000\000\002\145\002\145\002\145\020z\002\145\nf\000\000\n\234\002\145\000\000\002\145\002\145\b\205\002\145\002\145\002\145\002\145\002\145\002\145\n^\n\226\002\145\002\145\002\145\003*\003\190\bB\000\000\002\145\002\145\002\145\002\145\002\141\002\141\000\000\000\238\000\000\002\141\000\000\nf\002\141\n\234\b\205\002\141\003.\002\141\000\000\000\238\002\141\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\b\205\006e\000\000\b\205\tf\002\141\002\141\002\141\002\141\002\141\b\205\002\141\t&\001\190\b\205\000\000\000\000\002\141\002\141\002\141\002\141\002\141\017v\t\233\002\141\000\000\017\138\017\158\017\174\002\141\000\000\002\141\002\141\n-\t\146\007\194\020~\002\141\002\141\002\141\002\001\000\000\000\000\000\000\006e\b\170\002\141\002\141\002\141\002\141\002\141\002\141\002\141\002\141\002\141\000\000\n^\n\226\000\000\002\141\002\141\022\014\000\000\006e\000\000\b\174\000\n\002\141\002\141\002\141\000\000\002\141\002\141\002\141\016\222\002\141\nf\bB\n\234\002\141\000\000\002\141\002\141\012\t\002\141\002\141\002\141\002\141\002\141\002\141\000\000\000\000\002\141\002\141\002\141\000\238\b\158\002\001\000\238\002\141\002\141\002\141\002\141\002\129\002\129\000\000\000\000\000\000\002\129\000\238\000\000\002\129\000\000\012\t\002\129\000\000\002\129\000\000\000\000\002\129\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\012\t\000\000\031\175\012\t\014\006\002\129\002\129\002\129\002\129\002\129\012\t\002\129\006\146\000\000\012\t\006J\000\000\002\129\002\129\002\129\002\129\002\129\006\178\000\000\002\129\021\190\006\190\000\000\000\000\002\129\b\178\002\129\002\129\002\198\000\000\000\000\002\146\002\129\002\129\002\129\000\000\000\000\000\000\007\193\000\000\000\000\002\129\002\129\002\129\002\129\002\129\002\129\002\129\002\129\002\129\000\000\n^\n\226\000\000\002\129\002\129\000\000\007\030\000\000\000\000\000\238\007\193\002\129\002\129\002\129\000\000\002\129\002\129\002\129\000\000\002\129\nf\021\138\n\234\002\129\000\000\002\129\002\129\005\201\002\129\002\129\002\129\002\129\002\129\002\129\000\000\018\194\002\129\002\129\002\129\005\201\003\190\031\203\000\000\002\129\002\129\002\129\002\129\002)\002)\000\000\000\000\000\000\002)\000\000\006\146\002)\000\000\006J\002)\000\000\002)\005\198\000\000\002)\006\178\002)\002)\002)\006\190\002)\002)\002)\005\201\000\000\000\000\000\000\021\022\002)\002)\002)\002)\002)\000\000\002)\t&\017\234\000\000\000\000\000\000\002)\002)\002)\002)\002)\017v\t\025\002)\000\000\017\138\017\158\017\174\002)\005\201\002)\002)\005\201\000\000\000\000\000\000\002)\002)\002)\000\000\000\000\000\000\000\000\000\000\000\000\002)\002)\002)\002)\002)\002)\002)\002)\002)\ne\000\000\002)\000\000\002)\002)\002\182\002\198\000\000\000\000\000\238\000\000\002)\002)\002)\000\000\002)\002)\002)\t9\002)\000\000\t9\ne\002)\002\001\002)\002)\000\000\n\026\002)\002)\002)\002)\002)\000\000\000\000\002)\002)\n.\026Z\000\000\000\000\004n\002)\002)\002)\002)\n\029\n\029\000\000\000\000\003\178\n\029\000\n\006\146\n\029\000\000\006J\n\029\000\000\n\029\000\000\t9\n\029\006\178\n\029\n\029\n\029\006\190\n\029\n\029\n\029\002\001\000\000\000\000\000\000\t9\n\029\n\029\n\029\n\029\n\029\000\000\n\029\002\001\002\001\004\178\004z\000\000\n\029\n\029\n\029\n\029\n\029\0046\004B\n\029\000\000\000\000\000\000\004N\n\029\t9\n\029\n\029\000\000\000\000\000\000\000\000\n\029\n\029\n\029\000\000\000\000\000\000\na\000\000\000\000\n\029\n\029\n\029\n\029\n\029\n\029\n\029\n\029\n\029\000\000\000\000\n\029\t9\n\029\n\029\000\000\017\202\000\000\000\000\000\238\na\n\029\n\029\n\029\000\000\n\029\n\029\n\029\018\178\n\029\000\000\002\146\000\000\n\029\000\000\n\029\n\029\000\000\n\026\n\029\n\029\n\029\n\029\n\029\000\000\000\000\n\029\n\029\n.\nJ\000\000\000\000\002\254\n\029\n\029\n\029\n\029\002\137\002\137\000\000\002\014\000\000\002\137\002\146\006\146\002\137\000\000\006J\002\137\003\026\002\137\000\000\018\182\002\137\006\178\002\137\002\137\002\137\006\190\002\137\002\137\002\137\003&\000\000\000\000\000\000\018\194\002\137\002\137\002\137\002\137\002\137\000\000\002\137\000\000\b~\007\194\000\000\000\000\002\137\002\137\002\137\002\137\002\137\030\254\001\222\002\137\005\182\000\000\000\000\000\000\002\137\005\198\002\137\002\137\b\130\000\000\000\000\018\194\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\005\194\002\137\002\137\002\137\002\137\002\137\002\137\002\137\002\137\002\137\000\000\bB\002\137\029R\002\137\002\137\000\000\005\198\000\000\000\000\000\000\000\000\002\137\002\137\002\137\005\202\002\137\002\137\002\137\000\000\002\137\000\000\000\238\000\000\002\137\018\178\002\137\002\137\002\146\011\002\002\137\002\137\002\137\002\137\002\137\r\213\000\000\002\137\002\137\002\137\000\000\000\000\b\186\007\194\002\137\002\137\002\137\002\137\n\r\n\r\002\001\002\001\020\166\n\r\r\213\r\213\n\r\000\000\r\213\n\r\000\000\n\r\b\190\000\000\n\r\002\001\n\r\n\r\n\r\018\182\n\r\n\r\n\r\002\001\002\001\021\230\000\000\000\n\n\r\n\r\n\r\n\r\n\r\018\194\n\r\bB\000\000\000\000\002\001\000\000\n\r\n\r\n\r\n\r\n\r\007\233\000\000\n\r\000\000\000\238\000\n\000\000\n\r\000\000\n\r\n\r\000\238\000\000\002\001\005\198\n\r\n\r\n\r\000\000\007\233\000\000\000\000\000\000\007\233\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\n\r\007\194\r\213\n\r\002\001\n\r\n\r\000\000\000\000\000\000\0256\000\000\000\000\n\r\n\r\n\r\000\000\n\r\n\r\n\r\tR\n\r\000\000\000\000\000\000\n\r\000\000\n\r\n\r\000\000\n\026\n\r\n\r\n\r\n\r\n\r\r\209\000\000\n\r\n\r\n.\001\206\000\000\bB\002\198\n\r\n\r\n\r\n\r\003\193\003\193\000\000\007\233\029\226\003\193\r\209\r\209\003\193\000\000\r\209\003\193\000\000\003\193\000\000\000\238\011B\000\000\003\193\011\150\003\193\000\000\003\193\003\193\003\193\000\000\000\000\000\000\n\026\007\245\011\170\011\242\012\n\011\194\012\"\000\000\003\193\002\170\n.\015r\003\178\000\000\003\193\003\193\012:\012R\003\193\000\000\007\245\003\193\000\000\000\238\007\245\015\150\003\193\015\186\012j\003\193\000\000\000\000\000\000\000\000\003\193\003\193\000\238\000\000\000\000\004\230\000\000\000\000\005\165\003\193\003\193\011Z\011\218\012\130\012\154\012\202\003\193\003\193\007\194\r\209\003\193\000\000\003\193\012\226\000\000\000\000\000\000\000\000\000\238\000\000\003\193\003\193\012\250\000\000\003\193\003\193\003\193\019\222\003\193\000\000\000\000\000\000\003\193\000\000\003\193\003\193\000\000\rZ\003\193\rr\012\178\003\193\003\193\000\000\000\000\003\193\r\018\003\193\014\026\003\190\bB\005\166\003\193\003\193\r*\rB\002\233\002\233\000\000\000\000\000\000\002\233\000\000\014\"\002\233\000\000\014.\002\233\000\000\002\233\000\000\000\238\002\233\014:\002\233\002\233\002\233\014F\002\233\002\233\002\233\000\000\000\000\000\000\000\000\007\225\002\233\002\233\002\233\002\233\002\233\000\000\002\233\005\254\028\254\007\194\000\000\000\000\002\233\002\233\002\233\002\233\002\233\004\014\007\225\002\233\000\000\006\234\007\225\004\026\002\233\000\000\002\233\002\233\029\002\000\000\000\000\000\000\002\233\002\233\002\233\000\000\000\000\000\000\000\000\000\000\000\000\002\233\002\233\002\233\002\233\002\233\002\233\002\233\002\233\002\233\007\194\bB\002\233\000\000\002\233\002\233\000\000\000\000\000\000\000\000\000\238\000\000\002\233\002\233\002\233\000\000\002\233\002\233\002\233\0202\002\233\000\000\000\238\000\000\002\233\000\000\002\233\002\233\000\000\n\026\002\233\002\233\002\233\002\233\002\233\007\194\000\000\002\233\002\233\n.\b\197\000\000\bB\b\230\002\233\002\233\002\233\002\233\002\229\002\229\000\000\000\000\000\000\002\229\020N\b\197\002\229\000\000\006J\002\229\000\000\002\229\000\000\000\238\002\229\b\197\002\229\002\229\002\229\b\197\002\229\002\229\002\229\000\000\000\000\000\000\007\194\bB\002\229\002\229\002\229\002\229\002\229\000\000\002\229\000\000\000\000\007\194\000\000\000\000\002\229\002\229\002\229\002\229\002\229\020j\000\000\002\229\000\238\000\000\000\000\000\000\002\229\000\000\002\229\002\229\020\134\000\000\000\000\000\000\002\229\002\229\002\229\000\000\000\000\000\000\000\000\000\000\bB\002\229\002\229\011Z\002\229\002\229\002\229\002\229\002\229\002\229\007\194\bB\002\229\000\000\002\229\002\229\000\000\000\000\000\000\000\000\b\225\000\238\002\229\002\229\002\229\000\000\002\229\002\229\002\229\030\178\002\229\000\000\000\238\000\000\002\229\000\000\002\229\002\229\000\000\002\229\002\229\002\229\002\229\002\229\002\229\000\000\000\000\002\229\002\229\002\229\b\225\000\000\bB\000\000\002\229\002\229\002\229\002\229\002\185\002\185\000\000\000\000\000\000\002\185\000\000\b\225\002\185\000\000\006J\002\185\000\000\002\185\000\000\000\238\002\185\b\225\002\185\002\185\002\185\b\225\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\185\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\185\000\000\000\000\002\185\000\000\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\185\002\185\002\185\002\185\002\185\000\000\000\000\002\185\000\000\002\185\002\185\000\000\000\000\000\000\000\000\000\238\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\000\000\002\185\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\n\026\002\185\002\185\002\185\002\185\002\185\000\000\000\000\002\185\002\185\n.\b\253\000\000\000\000\000\000\002\185\002\185\002\185\002\185\002\181\002\181\000\000\000\000\000\000\002\181\000\000\006\146\002\181\000\000\006J\002\181\000\000\002\181\000\000\000\000\002\181\b\253\002\181\002\181\002\181\b\253\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\002\181\002\181\002\181\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\002\181\002\181\002\181\000\000\000\000\002\181\000\000\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\000\000\000\000\000\000\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\011Z\002\181\002\181\002\181\002\181\002\181\002\181\000\000\000\000\002\181\000\000\002\181\002\181\000\000\000\000\000\000\000\000\b\245\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\000\000\002\181\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\002\181\002\181\002\181\002\181\002\181\002\181\000\000\000\000\002\181\002\181\002\181\b\245\000\000\000\000\000\000\002\181\002\181\002\181\002\181\002\209\002\209\000\000\000\000\000\000\002\209\000\000\014^\002\209\000\000\b\245\002\209\000\000\002\209\000\000\000\000\002\209\b\245\002\209\002\209\002\209\b\245\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\000\000\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\000\000\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\000\000\000\000\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\000\000\002\209\002\209\000\000\000\000\000\000\000\000\000\238\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\000\000\002\209\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\n\026\002\209\002\209\002\209\002\209\002\209\000\000\000\000\002\209\002\209\n.\b\193\000\000\000\000\000\000\002\209\002\209\002\209\002\209\002\205\002\205\000\000\000\000\000\000\002\205\000\000\b\193\002\205\000\000\006J\002\205\000\000\002\205\000\000\000\000\011B\b\193\002\205\002\205\002\205\b\193\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\002\205\002\205\002\205\011\194\002\205\000\000\002\205\000\000\000\000\000\000\000\000\000\000\002\205\002\205\002\205\002\205\002\205\000\000\000\000\002\205\000\000\000\000\000\000\000\000\002\205\000\000\002\205\002\205\000\000\000\000\000\000\000\000\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\011Z\011\218\002\205\002\205\002\205\002\205\002\205\000\000\000\000\002\205\000\000\002\205\002\205\000\000\000\000\000\000\000\000\000\238\000\000\002\205\002\205\002\205\000\000\002\205\002\205\002\205\000\000\002\205\000\000\000\000\000\000\002\205\000\000\002\205\002\205\000\000\002\205\002\205\002\205\002\205\002\205\002\205\000\000\000\000\002\205\002\205\002\205\017F\000\000\000\000\000\000\002\205\002\205\002\205\002\205\002\241\002\241\000\000\000\000\000\000\002\241\000\000\014\"\002\241\000\000\014.\002\241\000\000\002\241\000\000\000\000\002\241\014:\002\241\002\241\002\241\014F\002\241\002\241\002\241\000\000\000\000\000\000\000\000\000\000\002\241\002\241\002\241\002\241\002\241\000\000\002\241\000\000\000\000\000\000\000\000\000\000\002\241\002\241\002\241\002\241\002\241\000\000\000\000\002\241\000\000\000\000\000\000\000\000\002\241\000\000\002\241\002\241\000\000\000\000\000\000\000\000\002\241\002\241\002\241\000\000\000\000\000\000\000\000\000\000\000\000\002\241\002\241\002\241\002\241\002\241\002\241\002\241\002\241\002\241\000\000\000\000\002\241\000\000\002\241\002\241\000\000\000\000\000\000\000\000\000\000\000\000\002\241\002\241\002\241\000\000\002\241\002\241\002\241\000\000\002\241\000\000\000\000\000\000\002\241\000\000\002\241\002\241\000\000\n\026\002\241\002\241\002\241\002\241\002\241\007\221\000\000\002\241\002\241\n.\000\000\000\000\000\000\000\000\002\241\002\241\002\241\002\241\002\237\002\237\000\000\000\000\000\000\002\237\007\221\000\000\002\237\000\000\007\221\002\237\000\000\002\237\000\000\000\000\002\237\000\000\002\237\002\237\002\237\000\000\002\237\002\237\002\237\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\237\000\000\002\237\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\237\000\000\000\000\002\237\000\000\000\238\000\000\000\000\002\237\000\000\002\237\002\237\000\000\000\000\000\000\000\000\002\237\002\237\002\237\000\000\000\000\000\000\000\000\000\000\000\000\002\237\002\237\011Z\002\237\002\237\002\237\002\237\002\237\002\237\000\000\007\221\002\237\000\000\002\237\002\237\000\000\000\000\000\000\000\000\000\000\000\000\002\237\002\237\002\237\000\000\002\237\002\237\002\237\000\000\002\237\000\000\000\000\000\000\002\237\000\000\002\237\002\237\000\000\002\237\002\237\002\237\002\237\002\237\002\237\000\000\000\000\002\237\002\237\002\237\000\000\000\000\000\000\000\000\002\237\002\237\002\237\002\237\002\177\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\000\000\000\000\002\177\000\000\002\177\000\000\000\000\002\177\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\002\177\002\177\002\177\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\002\177\002\177\002\177\000\000\000\000\002\177\000\000\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\000\000\000\000\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\002\177\002\177\002\177\002\177\002\177\002\177\002\177\000\000\000\000\002\177\000\000\002\177\002\177\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\000\000\002\177\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\n\026\002\177\002\177\002\177\002\177\002\177\000\000\000\000\002\177\002\177\n.\000\000\000\000\000\000\000\000\002\177\002\177\002\177\002\177\002\173\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\002\173\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\173\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\173\000\000\000\000\002\173\000\000\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\011Z\002\173\002\173\002\173\002\173\002\173\002\173\000\000\000\000\002\173\000\000\002\173\002\173\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\000\000\002\173\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\002\173\002\173\002\173\002\173\002\173\002\173\000\000\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\002\173\002\173\002\173\002\173\002\201\002\201\000\000\000\000\000\000\002\201\000\000\000\000\002\201\000\000\000\000\002\201\000\000\002\201\000\000\000\000\002\201\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\002\201\002\201\002\201\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\002\201\002\201\002\201\000\000\000\000\002\201\000\000\000\000\000\000\000\000\002\201\000\000\002\201\002\201\000\000\000\000\000\000\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\002\201\002\201\002\201\002\201\002\201\002\201\002\201\000\000\000\000\002\201\000\000\002\201\002\201\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\000\000\002\201\000\000\000\000\000\000\002\201\000\000\002\201\002\201\000\000\n\026\002\201\002\201\002\201\002\201\002\201\000\000\000\000\002\201\002\201\n.\000\000\000\000\000\000\000\000\002\201\002\201\002\201\002\201\002\197\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\011B\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\011\194\002\197\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\197\000\000\000\000\002\197\000\000\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\011Z\011\218\002\197\002\197\002\197\002\197\002\197\000\000\000\000\002\197\000\000\002\197\002\197\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\000\000\002\197\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\002\197\002\197\002\197\002\197\002\197\002\197\000\000\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\002\197\002\197\002\197\002\197\002\193\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\002\193\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\193\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\193\000\000\000\000\002\193\000\000\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\193\002\193\002\193\002\193\002\193\000\000\000\000\002\193\000\000\002\193\002\193\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\000\000\002\193\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\n\026\002\193\002\193\002\193\002\193\002\193\000\000\000\000\002\193\002\193\n.\000\000\000\000\000\000\000\000\002\193\002\193\002\193\002\193\002\189\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\011B\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\011\194\002\189\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\002\189\000\000\000\000\002\189\000\000\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\011Z\011\218\002\189\002\189\002\189\002\189\002\189\000\000\000\000\002\189\000\000\002\189\002\189\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\000\000\002\189\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\002\189\002\189\002\189\002\189\002\189\002\189\000\000\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\002\189\002\189\002\189\002\189\003\017\003\017\000\000\000\000\000\000\003\017\000\000\000\000\003\017\000\000\000\000\003\017\000\000\003\017\000\000\000\000\003\017\000\000\003\017\003\017\003\017\000\000\003\017\003\017\003\017\000\000\000\000\000\000\000\000\000\000\003\017\003\017\003\017\003\017\003\017\000\000\003\017\000\000\000\000\000\000\000\000\000\000\003\017\003\017\003\017\003\017\003\017\000\000\000\000\003\017\000\000\000\000\000\000\000\000\003\017\000\000\003\017\003\017\000\000\000\000\000\000\000\000\003\017\003\017\003\017\000\000\000\000\000\000\000\000\000\000\000\000\003\017\003\017\003\017\003\017\003\017\003\017\003\017\003\017\003\017\000\000\000\000\003\017\000\000\003\017\003\017\000\000\000\000\000\000\000\000\000\000\000\000\003\017\003\017\003\017\000\000\003\017\003\017\003\017\000\000\003\017\000\000\000\000\000\000\003\017\000\000\003\017\003\017\000\000\n\026\003\017\003\017\003\017\003\017\003\017\000\000\000\000\003\017\003\017\n.\000\000\000\000\000\000\000\000\003\017\003\017\003\017\003\017\003\r\003\r\000\000\000\000\000\000\003\r\000\000\000\000\003\r\000\000\000\000\003\r\000\000\003\r\000\000\000\000\011B\000\000\003\r\003\r\003\r\000\000\003\r\003\r\003\r\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003\r\000\000\000\000\000\000\000\000\000\000\003\r\003\r\012:\012R\003\r\000\000\000\000\003\r\000\000\000\000\000\000\000\000\003\r\000\000\012j\003\r\000\000\000\000\000\000\000\000\003\r\003\r\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\r\003\r\011Z\011\218\012\130\012\154\012\202\003\r\003\r\000\000\000\000\003\r\000\000\003\r\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003\r\003\r\012\250\000\000\003\r\003\r\003\r\000\000\003\r\000\000\000\000\000\000\003\r\000\000\003\r\003\r\000\000\003\r\003\r\003\r\012\178\003\r\003\r\000\000\000\000\003\r\r\018\003\r\000\000\000\000\000\000\000\000\003\r\003\r\r*\rB\002\225\002\225\000\000\000\000\000\000\002\225\000\000\000\000\002\225\000\000\000\000\002\225\000\000\002\225\000\000\000\000\002\225\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\225\000\000\000\000\002\225\000\000\000\000\000\000\000\000\002\225\000\000\002\225\002\225\000\000\000\000\000\000\000\000\002\225\002\225\002\225\000\000\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\225\002\225\002\225\002\225\002\225\000\000\000\000\002\225\000\000\002\225\002\225\000\000\000\000\000\000\000\000\000\000\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\000\000\002\225\000\000\000\000\000\000\002\225\000\000\002\225\002\225\000\000\n\026\002\225\002\225\002\225\002\225\002\225\000\000\000\000\002\225\002\225\n.\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\221\002\221\000\000\000\000\000\000\002\221\000\000\000\000\002\221\000\000\000\000\002\221\000\000\002\221\000\000\000\000\011B\000\000\002\221\002\221\002\221\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\011\194\002\221\000\000\002\221\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\221\000\000\000\000\002\221\000\000\000\000\000\000\000\000\002\221\000\000\002\221\002\221\000\000\000\000\000\000\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\000\000\000\000\002\221\002\221\011Z\011\218\002\221\002\221\002\221\002\221\002\221\000\000\000\000\002\221\000\000\002\221\002\221\000\000\000\000\000\000\000\000\000\000\000\000\002\221\002\221\002\221\000\000\002\221\002\221\002\221\000\000\002\221\000\000\000\000\000\000\002\221\000\000\002\221\002\221\000\000\002\221\002\221\002\221\002\221\002\221\002\221\000\000\000\000\002\221\002\221\002\221\000\000\000\000\000\000\000\000\002\221\002\221\002\221\002\221\002\217\002\217\000\000\000\000\000\000\002\217\000\000\000\000\002\217\000\000\000\000\002\217\000\000\002\217\000\000\000\000\002\217\000\000\002\217\002\217\002\217\000\000\002\217\002\217\002\217\000\000\000\000\000\000\000\000\000\000\002\217\002\217\002\217\002\217\002\217\000\000\002\217\000\000\000\000\000\000\000\000\000\000\002\217\002\217\002\217\002\217\002\217\000\000\000\000\002\217\000\000\000\000\000\000\000\000\002\217\000\000\002\217\002\217\000\000\000\000\000\000\000\000\002\217\002\217\002\217\000\000\000\000\000\000\000\000\000\000\000\000\002\217\002\217\002\217\002\217\002\217\002\217\002\217\002\217\002\217\000\000\000\000\002\217\000\000\002\217\002\217\000\000\000\000\000\000\000\000\000\000\000\000\002\217\002\217\002\217\000\000\002\217\002\217\002\217\000\000\002\217\000\000\000\000\000\000\002\217\000\000\002\217\002\217\000\000\n\026\002\217\002\217\002\217\002\217\002\217\000\000\000\000\002\217\002\217\n.\000\000\000\000\000\000\000\000\002\217\002\217\002\217\002\217\002\213\002\213\000\000\000\000\000\000\002\213\000\000\000\000\002\213\000\000\000\000\002\213\000\000\002\213\000\000\000\000\011B\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\011\194\002\213\000\000\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\002\213\002\213\000\000\000\000\002\213\000\000\000\000\000\000\000\000\002\213\000\000\002\213\002\213\000\000\000\000\000\000\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\011Z\011\218\002\213\002\213\002\213\002\213\002\213\000\000\000\000\002\213\000\000\002\213\002\213\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\000\000\002\213\000\000\000\000\000\000\002\213\000\000\002\213\002\213\000\000\002\213\002\213\002\213\002\213\002\213\002\213\000\000\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\002\213\002\213\002\213\002\213\003\001\003\001\000\000\000\000\000\000\003\001\000\000\000\000\003\001\000\000\000\000\003\001\000\000\003\001\000\000\000\000\003\001\000\000\003\001\003\001\003\001\000\000\003\001\003\001\003\001\000\000\000\000\000\000\000\000\000\000\003\001\003\001\003\001\003\001\003\001\000\000\003\001\000\000\000\000\000\000\000\000\000\000\003\001\003\001\003\001\003\001\003\001\000\000\000\000\003\001\000\000\000\000\000\000\000\000\003\001\000\000\003\001\003\001\000\000\000\000\000\000\000\000\003\001\003\001\003\001\000\000\000\000\000\000\000\000\000\000\000\000\003\001\003\001\003\001\003\001\003\001\003\001\003\001\003\001\003\001\000\000\000\000\003\001\000\000\003\001\003\001\000\000\000\000\000\000\000\000\000\000\000\000\003\001\003\001\003\001\000\000\003\001\003\001\003\001\000\000\003\001\000\000\000\000\000\000\003\001\000\000\003\001\003\001\000\000\n\026\003\001\003\001\003\001\003\001\003\001\000\000\000\000\003\001\003\001\n.\000\000\000\000\000\000\000\000\003\001\003\001\003\001\003\001\002\253\002\253\000\000\000\000\000\000\002\253\000\000\000\000\002\253\000\000\000\000\002\253\000\000\002\253\000\000\000\000\011B\000\000\002\253\002\253\002\253\000\000\002\253\002\253\002\253\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\002\253\000\000\002\253\000\000\000\000\000\000\000\000\000\000\002\253\002\253\012:\012R\002\253\000\000\000\000\002\253\000\000\000\000\000\000\000\000\002\253\000\000\002\253\002\253\000\000\000\000\000\000\000\000\002\253\002\253\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\253\002\253\011Z\011\218\012\130\012\154\002\253\002\253\002\253\000\000\000\000\002\253\000\000\002\253\002\253\000\000\000\000\000\000\000\000\000\000\000\000\002\253\002\253\002\253\000\000\002\253\002\253\002\253\000\000\002\253\000\000\000\000\000\000\002\253\000\000\002\253\002\253\000\000\002\253\002\253\002\253\012\178\002\253\002\253\000\000\000\000\002\253\002\253\002\253\000\000\000\000\000\000\000\000\002\253\002\253\002\253\002\253\002\169\002\169\000\000\000\000\000\000\002\169\000\000\000\000\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\002\169\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\169\000\000\000\000\002\169\000\000\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\169\002\169\002\169\002\169\002\169\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\000\000\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\n\026\002\169\002\169\002\169\002\169\002\169\000\000\000\000\002\169\002\169\n.\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002\165\002\165\000\000\000\000\000\000\002\165\000\000\000\000\002\165\000\000\000\000\002\165\000\000\002\165\000\000\000\000\011B\000\000\002\165\002\165\002\165\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\011\194\002\165\000\000\002\165\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\165\000\000\000\000\002\165\000\000\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\011Z\011\218\002\165\002\165\002\165\002\165\002\165\000\000\000\000\002\165\000\000\002\165\002\165\000\000\000\000\000\000\000\000\000\000\000\000\002\165\002\165\002\165\000\000\002\165\002\165\002\165\000\000\002\165\000\000\000\000\000\000\002\165\000\000\002\165\002\165\000\000\002\165\002\165\002\165\002\165\002\165\002\165\000\000\000\000\002\165\002\165\002\165\000\000\000\000\000\000\000\000\002\165\002\165\002\165\002\165\002\161\002\161\000\000\000\000\000\000\002\161\000\000\000\000\002\161\000\000\000\000\002\161\000\000\002\161\000\000\000\000\002\161\000\000\002\161\002\161\002\161\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\161\000\000\002\161\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\161\000\000\000\000\002\161\000\000\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\002\161\002\161\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\161\002\161\002\161\002\161\002\161\000\000\000\000\002\161\000\000\002\161\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\161\002\161\000\000\002\161\002\161\002\161\000\000\002\161\000\000\000\000\000\000\002\161\000\000\002\161\002\161\000\000\n\026\002\161\002\161\002\161\002\161\002\161\000\000\000\000\002\161\002\161\n.\000\000\000\000\000\000\000\000\002\161\002\161\002\161\002\161\002\157\002\157\000\000\000\000\000\000\002\157\000\000\000\000\002\157\000\000\000\000\002\157\000\000\002\157\000\000\000\000\011B\000\000\002\157\002\157\002\157\000\000\002\157\002\157\002\157\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\002\157\000\000\002\157\000\000\000\000\000\000\000\000\000\000\002\157\002\157\012:\012R\002\157\000\000\000\000\002\157\000\000\000\000\000\000\000\000\002\157\000\000\002\157\002\157\000\000\000\000\000\000\000\000\002\157\002\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\011Z\011\218\012\130\012\154\002\157\002\157\002\157\000\000\000\000\002\157\000\000\002\157\002\157\000\000\000\000\000\000\000\000\000\000\000\000\002\157\002\157\002\157\000\000\002\157\002\157\002\157\000\000\002\157\000\000\000\000\000\000\002\157\000\000\002\157\002\157\000\000\002\157\002\157\002\157\012\178\002\157\002\157\000\000\000\000\002\157\002\157\002\157\000\000\000\000\000\000\000\000\002\157\002\157\002\157\002\157\003Q\003Q\000\000\000\000\000\000\003Q\000\000\000\000\003Q\000\000\000\000\003Q\000\000\003Q\000\000\000\000\003Q\000\000\003Q\003Q\003Q\000\000\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\003Q\003Q\003Q\003Q\003Q\000\000\003Q\000\000\000\000\000\000\000\000\000\000\003Q\003Q\003Q\003Q\003Q\000\000\000\000\003Q\000\000\000\000\000\000\000\000\003Q\000\000\003Q\003Q\000\000\000\000\000\000\000\000\003Q\003Q\003Q\000\000\000\000\000\000\000\000\000\000\000\000\003Q\003Q\003Q\003Q\003Q\003Q\003Q\003Q\003Q\000\000\000\000\003Q\000\000\003Q\003Q\000\000\000\000\000\000\000\000\000\000\000\000\003Q\003Q\003Q\000\000\003Q\003Q\003Q\000\000\003Q\000\000\000\000\000\000\003Q\000\000\003Q\003Q\000\000\n\026\003Q\003Q\003Q\003Q\003Q\000\000\000\000\003Q\003Q\n.\000\000\000\000\000\000\000\000\003Q\003Q\003Q\003Q\003M\003M\000\000\000\000\000\000\003M\000\000\000\000\003M\000\000\000\000\003M\000\000\003M\000\000\000\000\011B\000\000\003M\003M\003M\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\003M\000\000\003M\000\000\000\000\000\000\000\000\000\000\003M\003M\012:\012R\003M\000\000\000\000\003M\000\000\000\000\000\000\000\000\003M\000\000\003M\003M\000\000\000\000\000\000\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\000\000\000\000\003M\003M\011Z\011\218\012\130\003M\003M\003M\003M\000\000\000\000\003M\000\000\003M\003M\000\000\000\000\000\000\000\000\000\000\000\000\003M\003M\003M\000\000\003M\003M\003M\000\000\003M\000\000\000\000\000\000\003M\000\000\003M\003M\000\000\003M\003M\003M\012\178\003M\003M\000\000\000\000\003M\003M\003M\000\000\000\000\000\000\000\000\003M\003M\003M\003M\002\153\002\153\000\000\000\000\000\000\002\153\000\000\000\000\002\153\000\000\000\000\002\153\000\000\002\153\000\000\000\000\002\153\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\153\000\000\002\153\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\153\000\000\000\000\002\153\000\000\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\153\002\153\002\153\002\153\002\153\000\000\000\000\002\153\000\000\002\153\002\153\000\000\000\000\000\000\000\000\000\000\000\000\002\153\002\153\002\153\000\000\002\153\002\153\002\153\000\000\002\153\000\000\000\000\000\000\002\153\000\000\002\153\002\153\000\000\n\026\002\153\002\153\002\153\002\153\002\153\000\000\000\000\002\153\002\153\n.\000\000\000\000\000\000\000\000\002\153\002\153\002\153\002\153\002\149\002\149\000\000\000\000\000\000\002\149\000\000\000\000\002\149\000\000\000\000\002\149\000\000\002\149\000\000\000\000\011B\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\002\149\000\000\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\012:\012R\002\149\000\000\000\000\002\149\000\000\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\000\000\000\000\000\000\002\149\002\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\011Z\011\218\012\130\012\154\002\149\002\149\002\149\000\000\000\000\002\149\000\000\002\149\002\149\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\000\000\002\149\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\002\149\002\149\002\149\012\178\002\149\002\149\000\000\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\002\149\002\149\002\149\002\149\003\t\003\t\000\000\000\000\000\000\003\t\000\000\000\000\003\t\000\000\000\000\003\t\000\000\003\t\000\000\000\000\003\t\000\000\003\t\003\t\003\t\000\000\003\t\003\t\003\t\000\000\000\000\000\000\000\000\000\000\003\t\003\t\003\t\003\t\003\t\000\000\003\t\000\000\000\000\000\000\000\000\000\000\003\t\003\t\003\t\003\t\003\t\000\000\000\000\003\t\000\000\000\000\000\000\000\000\003\t\000\000\003\t\003\t\000\000\000\000\000\000\000\000\003\t\003\t\003\t\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\003\t\003\t\003\t\003\t\003\t\003\t\003\t\000\000\000\000\003\t\000\000\003\t\003\t\000\000\000\000\000\000\000\000\000\000\000\000\003\t\003\t\003\t\000\000\003\t\003\t\003\t\000\000\003\t\000\000\000\000\000\000\003\t\000\000\003\t\003\t\000\000\n\026\003\t\003\t\003\t\003\t\003\t\000\000\000\000\003\t\003\t\n.\000\000\000\000\000\000\000\000\003\t\003\t\003\t\003\t\003\005\003\005\000\000\000\000\000\000\003\005\000\000\000\000\003\005\000\000\000\000\003\005\000\000\003\005\000\000\000\000\011B\000\000\003\005\003\005\003\005\000\000\003\005\003\005\003\005\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\003\005\000\000\003\005\000\000\000\000\000\000\000\000\000\000\003\005\003\005\012:\012R\003\005\000\000\000\000\003\005\000\000\000\000\000\000\000\000\003\005\000\000\003\005\003\005\000\000\000\000\000\000\000\000\003\005\003\005\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\005\003\005\011Z\011\218\012\130\012\154\003\005\003\005\003\005\000\000\000\000\003\005\000\000\003\005\003\005\000\000\000\000\000\000\000\000\000\000\000\000\003\005\003\005\003\005\000\000\003\005\003\005\003\005\000\000\003\005\000\000\000\000\000\000\003\005\000\000\003\005\003\005\000\000\003\005\003\005\003\005\012\178\003\005\003\005\000\000\000\000\003\005\003\005\003\005\000\000\000\000\000\000\000\000\003\005\003\005\003\005\003\005\002\249\002\249\000\000\000\000\000\000\002\249\000\000\000\000\002\249\000\000\000\000\002\249\000\000\002\249\000\000\000\000\002\249\000\000\002\249\002\249\002\249\000\000\002\249\002\249\002\249\000\000\000\000\000\000\000\000\000\000\002\249\002\249\002\249\002\249\002\249\000\000\002\249\000\000\000\000\000\000\000\000\000\000\002\249\002\249\002\249\002\249\002\249\000\000\000\000\002\249\000\000\000\000\000\000\000\000\002\249\000\000\002\249\002\249\000\000\000\000\000\000\000\000\002\249\002\249\002\249\000\000\000\000\000\000\000\000\000\000\000\000\002\249\002\249\002\249\002\249\002\249\002\249\002\249\002\249\002\249\000\000\000\000\002\249\000\000\002\249\002\249\000\000\000\000\000\000\000\000\000\000\000\000\002\249\002\249\002\249\000\000\002\249\002\249\002\249\000\000\002\249\000\000\000\000\000\000\002\249\000\000\002\249\002\249\000\000\n\026\002\249\002\249\002\249\002\249\002\249\000\000\000\000\002\249\002\249\n.\000\000\000\000\000\000\000\000\002\249\002\249\002\249\002\249\002\245\002\245\000\000\000\000\000\000\002\245\000\000\000\000\002\245\000\000\000\000\002\245\000\000\002\245\000\000\000\000\011B\000\000\002\245\002\245\002\245\000\000\002\245\002\245\002\245\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\002\245\000\000\002\245\000\000\000\000\000\000\000\000\000\000\002\245\002\245\012:\012R\002\245\000\000\000\000\002\245\000\000\000\000\000\000\000\000\002\245\000\000\002\245\002\245\000\000\000\000\000\000\000\000\002\245\002\245\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\245\002\245\011Z\011\218\012\130\012\154\002\245\002\245\002\245\000\000\000\000\002\245\000\000\002\245\002\245\000\000\000\000\000\000\000\000\000\000\000\000\002\245\002\245\002\245\000\000\002\245\002\245\002\245\000\000\002\245\000\000\000\000\000\000\002\245\000\000\002\245\002\245\000\000\002\245\002\245\002\245\012\178\002\245\002\245\000\000\000\000\002\245\002\245\002\245\000\000\000\000\000\000\000\000\002\245\002\245\002\245\002\245\003\025\003\025\000\000\000\000\000\000\003\025\000\000\000\000\003\025\000\000\000\000\003\025\000\000\003\025\000\000\000\000\003\025\000\000\003\025\003\025\003\025\000\000\003\025\003\025\003\025\000\000\000\000\000\000\000\000\000\000\003\025\003\025\003\025\003\025\003\025\000\000\003\025\000\000\000\000\000\000\000\000\000\000\003\025\003\025\003\025\003\025\003\025\000\000\000\000\003\025\000\000\000\000\000\000\000\000\003\025\000\000\003\025\003\025\000\000\000\000\000\000\000\000\003\025\003\025\003\025\000\000\000\000\000\000\000\000\000\000\000\000\003\025\003\025\003\025\003\025\003\025\003\025\003\025\003\025\003\025\000\000\000\000\003\025\000\000\003\025\003\025\000\000\000\000\000\000\000\000\000\000\000\000\003\025\003\025\003\025\000\000\003\025\003\025\003\025\000\000\003\025\000\000\000\000\000\000\003\025\000\000\003\025\003\025\000\000\n\026\003\025\003\025\003\025\003\025\003\025\000\000\000\000\003\025\003\025\n.\000\000\000\000\000\000\000\000\003\025\003\025\003\025\003\025\003\021\003\021\000\000\000\000\000\000\003\021\000\000\000\000\003\021\000\000\000\000\003\021\000\000\003\021\000\000\000\000\011B\000\000\003\021\003\021\003\021\000\000\003\021\003\021\003\021\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003\021\000\000\000\000\000\000\000\000\000\000\003\021\003\021\012:\012R\003\021\000\000\000\000\003\021\000\000\000\000\000\000\000\000\003\021\000\000\012j\003\021\000\000\000\000\000\000\000\000\003\021\003\021\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\021\003\021\011Z\011\218\012\130\012\154\012\202\003\021\003\021\000\000\000\000\003\021\000\000\003\021\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003\021\003\021\012\250\000\000\003\021\003\021\003\021\000\000\003\021\000\000\000\000\000\000\003\021\000\000\003\021\003\021\000\000\003\021\003\021\003\021\012\178\003\021\003\021\000\000\000\000\003\021\r\018\003\021\000\000\000\000\000\000\000\000\003\021\003\021\r*\rB\003!\003!\000\000\000\000\000\000\003!\000\000\000\000\003!\000\000\000\000\003!\000\000\003!\000\000\000\000\003!\000\000\003!\003!\003!\000\000\003!\003!\003!\000\000\000\000\000\000\000\000\000\000\003!\003!\003!\003!\003!\000\000\003!\000\000\000\000\000\000\000\000\000\000\003!\003!\003!\003!\003!\000\000\000\000\003!\000\000\000\000\000\000\000\000\003!\000\000\003!\003!\000\000\000\000\000\000\000\000\003!\003!\003!\000\000\000\000\000\000\000\000\000\000\000\000\003!\003!\003!\003!\003!\003!\003!\003!\003!\000\000\000\000\003!\000\000\003!\003!\000\000\000\000\000\000\000\000\000\000\000\000\003!\003!\003!\000\000\003!\003!\003!\000\000\003!\000\000\000\000\000\000\003!\000\000\003!\003!\000\000\n\026\003!\003!\003!\003!\003!\000\000\000\000\003!\003!\n.\000\000\000\000\000\000\000\000\003!\003!\003!\003!\003\029\003\029\000\000\000\000\000\000\003\029\000\000\000\000\003\029\000\000\000\000\003\029\000\000\003\029\000\000\000\000\011B\000\000\003\029\003\029\003\029\000\000\003\029\003\029\003\029\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\003\029\000\000\003\029\000\000\000\000\000\000\000\000\000\000\003\029\003\029\012:\012R\003\029\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\000\000\012j\003\029\000\000\000\000\000\000\000\000\003\029\003\029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\029\003\029\011Z\011\218\012\130\012\154\012\202\003\029\003\029\000\000\000\000\003\029\000\000\003\029\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003\029\003\029\012\250\000\000\003\029\003\029\003\029\000\000\003\029\000\000\000\000\000\000\003\029\000\000\003\029\003\029\000\000\003\029\003\029\003\029\012\178\003\029\003\029\000\000\000\000\003\029\003\029\003\029\000\000\000\000\000\000\000\000\003\029\003\029\r*\rB\003)\003)\000\000\000\000\000\000\003)\000\000\000\000\003)\000\000\000\000\003)\000\000\003)\000\000\000\000\003)\000\000\003)\003)\003)\000\000\003)\003)\003)\000\000\000\000\000\000\000\000\000\000\003)\003)\003)\003)\003)\000\000\003)\000\000\000\000\000\000\000\000\000\000\003)\003)\003)\003)\003)\000\000\000\000\003)\000\000\000\000\000\000\000\000\003)\000\000\003)\003)\000\000\000\000\000\000\000\000\003)\003)\003)\000\000\000\000\000\000\000\000\000\000\000\000\003)\003)\003)\003)\003)\003)\003)\003)\003)\000\000\000\000\003)\000\000\003)\003)\000\000\000\000\000\000\000\000\000\000\000\000\003)\003)\003)\000\000\003)\003)\003)\000\000\003)\000\000\000\000\000\000\003)\000\000\003)\003)\000\000\n\026\003)\003)\003)\003)\003)\000\000\000\000\003)\003)\n.\000\000\000\000\000\000\000\000\003)\003)\003)\003)\003%\003%\000\000\000\000\000\000\003%\000\000\000\000\003%\000\000\000\000\003%\000\000\003%\000\000\000\000\011B\000\000\003%\003%\003%\000\000\003%\003%\003%\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\003%\000\000\003%\000\000\000\000\000\000\000\000\000\000\003%\003%\012:\012R\003%\000\000\000\000\003%\000\000\000\000\000\000\000\000\003%\000\000\012j\003%\000\000\000\000\000\000\000\000\003%\003%\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003%\003%\011Z\011\218\012\130\012\154\012\202\003%\003%\000\000\000\000\003%\000\000\003%\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003%\003%\012\250\000\000\003%\003%\003%\000\000\003%\000\000\000\000\000\000\003%\000\000\003%\003%\000\000\003%\003%\003%\012\178\003%\003%\000\000\000\000\003%\003%\003%\000\000\000\000\000\000\000\000\003%\003%\r*\rB\n\021\n\021\000\000\000\000\000\000\n\021\000\000\000\000\n\021\000\000\000\000\n\021\000\000\n\021\000\000\000\000\n\021\000\000\n\021\n\021\n\021\000\000\n\021\n\021\n\021\000\000\000\000\000\000\000\000\000\000\n\021\n\021\n\021\n\021\n\021\000\000\n\021\000\000\000\000\000\000\000\000\000\000\n\021\n\021\n\021\n\021\n\021\000\000\000\000\n\021\000\000\000\000\000\000\000\000\n\021\000\000\n\021\n\021\000\000\000\000\000\000\000\000\n\021\n\021\n\021\000\000\000\000\000\000\000\000\000\000\000\000\n\021\n\021\n\021\n\021\n\021\n\021\n\021\n\021\n\021\000\000\000\000\n\021\000\000\n\021\n\021\000\000\000\000\000\000\000\000\000\000\000\000\n\021\n\021\n\021\000\000\n\021\n\021\n\021\000\000\n\021\000\000\000\000\000\000\n\021\000\000\n\021\n\021\000\000\n\026\n\021\n\021\n\021\n\021\n\021\000\000\000\000\n\021\n\021\n.\000\000\000\000\000\000\000\000\n\021\n\021\n\021\n\021\n\017\n\017\000\000\000\000\000\000\n\017\000\000\000\000\n\017\000\000\000\000\n\017\000\000\n\017\000\000\000\000\011B\000\000\n\017\n\017\n\017\000\000\n\017\n\017\n\017\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\n\017\000\000\000\000\000\000\000\000\000\000\n\017\n\017\012:\012R\n\017\000\000\000\000\n\017\000\000\000\000\000\000\000\000\n\017\000\000\012j\n\017\000\000\000\000\000\000\000\000\n\017\n\017\000\238\000\000\000\000\000\000\000\000\000\000\000\000\n\017\n\017\011Z\011\218\012\130\012\154\012\202\n\017\n\017\000\000\000\000\n\017\000\000\n\017\012\226\000\000\000\000\000\000\000\000\000\000\000\000\n\017\n\017\012\250\000\000\n\017\n\017\n\017\000\000\n\017\000\000\000\000\000\000\n\017\000\000\n\017\n\017\000\000\n\017\n\017\n\017\012\178\n\017\n\017\000\000\000\000\n\017\r\018\n\017\000\000\000\000\000\000\000\000\n\017\n\017\r*\rB\0031\0031\000\000\000\000\000\000\0031\000\000\000\000\0031\000\000\000\000\0031\000\000\0031\000\000\000\000\0031\000\000\0031\0031\0031\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\0031\0031\0031\0031\0031\000\000\0031\000\000\000\000\000\000\000\000\000\000\0031\0031\0031\0031\0031\000\000\000\000\0031\000\000\000\000\000\000\000\000\0031\000\000\0031\0031\000\000\000\000\000\000\000\000\0031\0031\0031\000\000\000\000\000\000\000\000\000\000\000\000\0031\0031\0031\0031\0031\0031\0031\0031\0031\000\000\000\000\0031\000\000\0031\0031\000\000\000\000\000\000\000\000\000\000\000\000\0031\0031\0031\000\000\0031\0031\0031\000\000\0031\000\000\000\000\000\000\0031\000\000\0031\0031\000\000\n\026\0031\0031\0031\0031\0031\000\000\000\000\0031\0031\n.\000\000\000\000\000\000\000\000\0031\0031\0031\0031\003-\003-\000\000\000\000\000\000\003-\000\000\000\000\003-\000\000\000\000\003-\000\000\003-\000\000\000\000\011B\000\000\003-\003-\003-\000\000\003-\003-\003-\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003-\000\000\000\000\000\000\000\000\000\000\003-\003-\012:\012R\003-\000\000\000\000\003-\000\000\000\000\000\000\000\000\003-\000\000\012j\003-\000\000\000\000\000\000\000\000\003-\003-\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003-\003-\011Z\011\218\012\130\012\154\012\202\003-\003-\000\000\000\000\003-\000\000\003-\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003-\003-\012\250\000\000\003-\003-\003-\000\000\003-\000\000\000\000\000\000\003-\000\000\003-\003-\000\000\rZ\003-\rr\012\178\003-\003-\000\000\000\000\003-\r\018\003-\000\000\000\000\000\000\000\000\003-\003-\r*\rB\n\t\n\t\000\000\000\000\000\000\n\t\000\000\000\000\n\t\000\000\000\000\n\t\000\000\n\t\000\000\000\000\011B\000\000\n\t\n\t\n\t\000\000\n\t\n\t\n\t\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\n\t\000\000\000\000\000\000\000\000\000\000\n\t\n\t\012:\012R\n\t\000\000\000\000\n\t\000\000\000\000\000\000\000\000\n\t\000\000\012j\n\t\000\000\000\000\000\000\000\000\n\t\n\t\000\238\000\000\000\000\000\000\000\000\000\000\000\000\n\t\n\t\011Z\011\218\012\130\012\154\012\202\n\t\n\t\000\000\000\000\n\t\000\000\n\t\012\226\000\000\000\000\000\000\000\000\000\000\000\000\n\t\n\t\012\250\000\000\n\t\n\t\n\t\000\000\n\t\000\000\000\000\000\000\n\t\000\000\n\t\n\t\000\000\n\t\n\t\n\t\012\178\n\t\n\t\000\000\000\000\n\t\r\018\n\t\000\000\000\000\000\000\000\000\n\t\n\t\r*\rB\003\129\003\129\000\000\000\000\000\000\003\129\000\000\000\000\003\129\000\000\000\000\003\129\000\000\003\129\000\000\000\000\003\129\000\000\003\129\003\129\003\129\000\000\003\129\003\129\003\129\000\000\000\000\000\000\000\000\000\000\003\129\003\129\003\129\003\129\003\129\000\000\003\129\000\000\000\000\000\000\000\000\000\000\003\129\003\129\003\129\003\129\003\129\000\000\000\000\003\129\000\000\000\000\000\000\000\000\003\129\000\000\003\129\003\129\000\000\000\000\000\000\000\000\003\129\003\129\003\129\000\000\000\000\000\000\000\000\000\000\000\000\003\129\003\129\003\129\003\129\003\129\003\129\003\129\003\129\003\129\000\000\000\000\003\129\000\000\003\129\003\129\000\000\000\000\000\000\000\000\000\000\000\000\003\129\003\129\003\129\000\000\003\129\003\129\003\129\000\000\003\129\000\000\000\000\000\000\003\129\000\000\003\129\003\129\000\000\n\026\003\129\003\129\003\129\003\129\003\129\000\000\000\000\003\129\003\129\n.\000\000\000\000\000\000\000\000\003\129\003\129\003\129\003\129\003}\003}\000\000\000\000\000\000\003}\000\000\000\000\003}\000\000\000\000\003}\000\000\003}\000\000\000\000\011B\000\000\003}\003}\003}\000\000\003}\003}\003}\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003}\000\000\000\000\000\000\000\000\000\000\003}\003}\012:\012R\003}\000\000\000\000\003}\000\000\000\000\000\000\000\000\003}\000\000\012j\003}\000\000\000\000\000\000\000\000\003}\003}\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003}\003}\011Z\011\218\012\130\012\154\012\202\003}\003}\000\000\000\000\003}\000\000\003}\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003}\003}\012\250\000\000\003}\003}\003}\000\000\003}\000\000\000\000\000\000\003}\000\000\003}\003}\000\000\rZ\003}\rr\012\178\003}\003}\000\000\000\000\003}\r\018\003}\000\000\000\000\000\000\000\000\003}\003}\r*\rB\003\161\003\161\000\000\000\000\000\000\003\161\000\000\000\000\003\161\000\000\000\000\003\161\000\000\003\161\000\000\000\000\003\161\000\000\003\161\003\161\003\161\000\000\003\161\003\161\003\161\000\000\000\000\000\000\000\000\000\000\003\161\003\161\003\161\003\161\003\161\000\000\003\161\000\000\000\000\000\000\000\000\000\000\003\161\003\161\003\161\003\161\003\161\000\000\000\000\003\161\000\000\000\000\000\000\000\000\003\161\000\000\003\161\003\161\000\000\000\000\000\000\000\000\003\161\003\161\003\161\000\000\000\000\000\000\000\000\000\000\000\000\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\000\000\000\000\003\161\000\000\003\161\003\161\000\000\000\000\000\000\000\000\000\000\000\000\003\161\003\161\003\161\000\000\003\161\003\161\003\161\000\000\003\161\000\000\000\000\000\000\003\161\000\000\003\161\003\161\000\000\n\026\003\161\003\161\003\161\003\161\003\161\000\000\000\000\003\161\003\161\n.\000\000\000\000\000\000\000\000\003\161\003\161\003\161\003\161\003\157\003\157\000\000\000\000\000\000\003\157\000\000\000\000\003\157\000\000\000\000\003\157\000\000\003\157\000\000\000\000\011B\000\000\003\157\003\157\003\157\000\000\003\157\003\157\003\157\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003\157\000\000\000\000\000\000\000\000\000\000\003\157\003\157\012:\012R\003\157\000\000\000\000\003\157\000\000\000\000\000\000\000\000\003\157\000\000\012j\003\157\000\000\000\000\000\000\000\000\003\157\003\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\157\003\157\011Z\011\218\012\130\012\154\012\202\003\157\003\157\000\000\000\000\003\157\000\000\003\157\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003\157\003\157\012\250\000\000\003\157\003\157\003\157\000\000\003\157\000\000\000\000\000\000\003\157\000\000\003\157\003\157\000\000\rZ\003\157\rr\012\178\003\157\003\157\000\000\000\000\003\157\r\018\003\157\000\000\000\000\000\000\000\000\003\157\003\157\r*\rB\003\145\003\145\000\000\000\000\000\000\003\145\000\000\000\000\003\145\000\000\000\000\003\145\000\000\003\145\000\000\000\000\003\145\000\000\003\145\003\145\003\145\000\000\003\145\003\145\003\145\000\000\000\000\000\000\000\000\000\000\003\145\003\145\003\145\003\145\003\145\000\000\003\145\000\000\000\000\000\000\000\000\000\000\003\145\003\145\003\145\003\145\003\145\000\000\000\000\003\145\000\000\000\000\000\000\000\000\003\145\000\000\003\145\003\145\000\000\000\000\000\000\000\000\003\145\003\145\003\145\000\000\000\000\000\000\000\000\000\000\000\000\003\145\003\145\003\145\003\145\003\145\003\145\003\145\003\145\003\145\000\000\000\000\003\145\000\000\003\145\003\145\000\000\000\000\000\000\000\000\000\000\000\000\003\145\003\145\003\145\000\000\003\145\003\145\003\145\000\000\003\145\000\000\000\000\000\000\003\145\000\000\003\145\003\145\000\000\n\026\003\145\003\145\003\145\003\145\003\145\000\000\000\000\003\145\003\145\n.\000\000\000\000\000\000\000\000\003\145\003\145\003\145\003\145\003\141\003\141\000\000\000\000\000\000\003\141\000\000\000\000\003\141\000\000\000\000\003\141\000\000\003\141\000\000\000\000\011B\000\000\003\141\003\141\003\141\000\000\003\141\003\141\003\141\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003\141\000\000\000\000\000\000\000\000\000\000\003\141\003\141\012:\012R\003\141\000\000\000\000\003\141\000\000\000\000\000\000\000\000\003\141\000\000\012j\003\141\000\000\000\000\000\000\000\000\003\141\003\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\141\003\141\011Z\011\218\012\130\012\154\012\202\003\141\003\141\000\000\000\000\003\141\000\000\003\141\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003\141\003\141\012\250\000\000\003\141\003\141\003\141\000\000\003\141\000\000\000\000\000\000\003\141\000\000\003\141\003\141\000\000\rZ\003\141\rr\012\178\003\141\003\141\000\000\000\000\003\141\r\018\003\141\000\000\000\000\000\000\000\000\003\141\003\141\r*\rB\003i\003i\000\000\000\000\000\000\003i\000\000\000\000\003i\000\000\000\000\003i\000\000\003i\000\000\000\000\003i\000\000\003i\003i\003i\000\000\003i\003i\003i\000\000\000\000\000\000\000\000\000\000\003i\003i\003i\003i\003i\000\000\003i\000\000\000\000\000\000\000\000\000\000\003i\003i\003i\003i\003i\000\000\000\000\003i\000\000\000\000\000\000\000\000\003i\000\000\003i\003i\000\000\000\000\000\000\000\000\003i\003i\003i\000\000\000\000\000\000\000\000\000\000\000\000\003i\003i\003i\003i\003i\003i\003i\003i\003i\000\000\000\000\003i\000\000\003i\003i\000\000\000\000\000\000\000\000\000\000\000\000\003i\003i\003i\000\000\003i\003i\003i\000\000\003i\000\000\000\000\000\000\003i\000\000\003i\003i\000\000\n\026\003i\003i\003i\003i\003i\000\000\000\000\003i\003i\n.\000\000\000\000\000\000\000\000\003i\003i\003i\003i\003e\003e\000\000\000\000\000\000\003e\000\000\000\000\003e\000\000\000\000\003e\000\000\003e\000\000\000\000\011B\000\000\003e\003e\003e\000\000\003e\003e\003e\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003e\000\000\000\000\000\000\000\000\000\000\003e\003e\012:\012R\003e\000\000\000\000\003e\000\000\000\000\000\000\000\000\003e\000\000\012j\003e\000\000\000\000\000\000\000\000\003e\003e\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003e\003e\011Z\011\218\012\130\012\154\012\202\003e\003e\000\000\000\000\003e\000\000\003e\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003e\003e\012\250\000\000\003e\003e\003e\000\000\003e\000\000\000\000\000\000\003e\000\000\003e\003e\000\000\rZ\003e\rr\012\178\003e\003e\000\000\000\000\003e\r\018\003e\000\000\000\000\000\000\000\000\003e\003e\r*\rB\003y\003y\000\000\000\000\000\000\003y\000\000\000\000\003y\000\000\000\000\003y\000\000\003y\000\000\000\000\003y\000\000\003y\003y\003y\000\000\003y\003y\003y\000\000\000\000\000\000\000\000\000\000\003y\003y\003y\003y\003y\000\000\003y\000\000\000\000\000\000\000\000\000\000\003y\003y\003y\003y\003y\000\000\000\000\003y\000\000\000\000\000\000\000\000\003y\000\000\003y\003y\000\000\000\000\000\000\000\000\003y\003y\003y\000\000\000\000\000\000\000\000\000\000\000\000\003y\003y\003y\003y\003y\003y\003y\003y\003y\000\000\000\000\003y\000\000\003y\003y\000\000\000\000\000\000\000\000\000\000\000\000\003y\003y\003y\000\000\003y\003y\003y\000\000\003y\000\000\000\000\000\000\003y\000\000\003y\003y\000\000\n\026\003y\003y\003y\003y\003y\000\000\000\000\003y\003y\n.\000\000\000\000\000\000\000\000\003y\003y\003y\003y\003u\003u\000\000\000\000\000\000\003u\000\000\000\000\003u\000\000\000\000\003u\000\000\003u\000\000\000\000\011B\000\000\003u\003u\003u\000\000\003u\003u\003u\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003u\000\000\000\000\000\000\000\000\000\000\003u\003u\012:\012R\003u\000\000\000\000\003u\000\000\000\000\000\000\000\000\003u\000\000\012j\003u\000\000\000\000\000\000\000\000\003u\003u\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003u\003u\011Z\011\218\012\130\012\154\012\202\003u\003u\000\000\000\000\003u\000\000\003u\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003u\003u\012\250\000\000\003u\003u\003u\000\000\003u\000\000\000\000\000\000\003u\000\000\003u\003u\000\000\rZ\003u\rr\012\178\003u\003u\000\000\000\000\003u\r\018\003u\000\000\000\000\000\000\000\000\003u\003u\r*\rB\003q\003q\000\000\000\000\000\000\003q\000\000\000\000\003q\000\000\000\000\003q\000\000\003q\000\000\000\000\003q\000\000\003q\003q\003q\000\000\003q\003q\003q\000\000\000\000\000\000\000\000\000\000\003q\003q\003q\003q\003q\000\000\003q\000\000\000\000\000\000\000\000\000\000\003q\003q\003q\003q\003q\000\000\000\000\003q\000\000\000\000\000\000\000\000\003q\000\000\003q\003q\000\000\000\000\000\000\000\000\003q\003q\003q\000\000\000\000\000\000\000\000\000\000\000\000\003q\003q\003q\003q\003q\003q\003q\003q\003q\000\000\000\000\003q\000\000\003q\003q\000\000\000\000\000\000\000\000\000\000\000\000\003q\003q\003q\000\000\003q\003q\003q\000\000\003q\000\000\000\000\000\000\003q\000\000\003q\003q\000\000\n\026\003q\003q\003q\003q\003q\000\000\000\000\003q\003q\n.\000\000\000\000\000\000\000\000\003q\003q\003q\003q\003m\003m\000\000\000\000\000\000\003m\000\000\000\000\003m\000\000\000\000\003m\000\000\003m\000\000\000\000\011B\000\000\003m\003m\003m\000\000\003m\003m\003m\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003m\000\000\000\000\000\000\000\000\000\000\003m\003m\012:\012R\003m\000\000\000\000\003m\000\000\000\000\000\000\000\000\003m\000\000\012j\003m\000\000\000\000\000\000\000\000\003m\003m\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003m\003m\011Z\011\218\012\130\012\154\012\202\003m\003m\000\000\000\000\003m\000\000\003m\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003m\003m\012\250\000\000\003m\003m\003m\000\000\003m\000\000\000\000\000\000\003m\000\000\003m\003m\000\000\rZ\003m\rr\012\178\003m\003m\000\000\000\000\003m\r\018\003m\000\000\000\000\000\000\000\000\003m\003m\r*\rB\003\137\003\137\000\000\000\000\000\000\003\137\000\000\000\000\003\137\000\000\000\000\003\137\000\000\003\137\000\000\000\000\003\137\000\000\003\137\003\137\003\137\000\000\003\137\003\137\003\137\000\000\000\000\000\000\000\000\000\000\003\137\003\137\003\137\003\137\003\137\000\000\003\137\000\000\000\000\000\000\000\000\000\000\003\137\003\137\003\137\003\137\003\137\000\000\000\000\003\137\000\000\000\000\000\000\000\000\003\137\000\000\003\137\003\137\000\000\000\000\000\000\000\000\003\137\003\137\003\137\000\000\000\000\000\000\000\000\000\000\000\000\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\003\137\000\000\000\000\003\137\000\000\003\137\003\137\000\000\000\000\000\000\000\000\000\000\000\000\003\137\003\137\003\137\000\000\003\137\003\137\003\137\000\000\003\137\000\000\000\000\000\000\003\137\000\000\003\137\003\137\000\000\n\026\003\137\003\137\003\137\003\137\003\137\000\000\000\000\003\137\003\137\n.\000\000\000\000\000\000\000\000\003\137\003\137\003\137\003\137\003\133\003\133\000\000\000\000\000\000\003\133\000\000\000\000\003\133\000\000\000\000\003\133\000\000\003\133\000\000\000\000\011B\000\000\003\133\003\133\003\133\000\000\003\133\003\133\003\133\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003\133\000\000\000\000\000\000\000\000\000\000\003\133\003\133\012:\012R\003\133\000\000\000\000\003\133\000\000\000\000\000\000\000\000\003\133\000\000\012j\003\133\000\000\000\000\000\000\000\000\003\133\003\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\133\003\133\011Z\011\218\012\130\012\154\012\202\003\133\003\133\000\000\000\000\003\133\000\000\003\133\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003\133\003\133\012\250\000\000\003\133\003\133\003\133\000\000\003\133\000\000\000\000\000\000\003\133\000\000\003\133\003\133\000\000\rZ\003\133\rr\012\178\003\133\003\133\000\000\000\000\003\133\r\018\003\133\000\000\000\000\000\000\000\000\003\133\003\133\r*\rB\003\169\003\169\000\000\000\000\000\000\003\169\000\000\000\000\003\169\000\000\000\000\003\169\000\000\003\169\000\000\000\000\003\169\000\000\003\169\003\169\003\169\000\000\003\169\003\169\003\169\000\000\000\000\000\000\000\000\000\000\003\169\003\169\003\169\003\169\003\169\000\000\003\169\000\000\000\000\000\000\000\000\000\000\003\169\003\169\003\169\003\169\003\169\000\000\000\000\003\169\000\000\000\000\000\000\000\000\003\169\000\000\003\169\003\169\000\000\000\000\000\000\000\000\003\169\003\169\003\169\000\000\000\000\000\000\000\000\000\000\000\000\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\003\169\000\000\000\000\003\169\000\000\003\169\003\169\000\000\000\000\000\000\000\000\000\000\000\000\003\169\003\169\003\169\000\000\003\169\003\169\003\169\000\000\003\169\000\000\000\000\000\000\003\169\000\000\003\169\003\169\000\000\n\026\003\169\003\169\003\169\003\169\003\169\000\000\000\000\003\169\003\169\n.\000\000\000\000\000\000\000\000\003\169\003\169\003\169\003\169\003\165\003\165\000\000\000\000\000\000\003\165\000\000\000\000\003\165\000\000\000\000\003\165\000\000\003\165\000\000\000\000\011B\000\000\003\165\003\165\003\165\000\000\003\165\003\165\003\165\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003\165\000\000\000\000\000\000\000\000\000\000\003\165\003\165\012:\012R\003\165\000\000\000\000\003\165\000\000\000\000\000\000\000\000\003\165\000\000\012j\003\165\000\000\000\000\000\000\000\000\003\165\003\165\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\165\003\165\011Z\011\218\012\130\012\154\012\202\003\165\003\165\000\000\000\000\003\165\000\000\003\165\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003\165\003\165\012\250\000\000\003\165\003\165\003\165\000\000\003\165\000\000\000\000\000\000\003\165\000\000\003\165\003\165\000\000\rZ\003\165\rr\012\178\003\165\003\165\000\000\000\000\003\165\r\018\003\165\000\000\000\000\000\000\000\000\003\165\003\165\r*\rB\003\153\003\153\000\000\000\000\000\000\003\153\000\000\000\000\003\153\000\000\000\000\003\153\000\000\003\153\000\000\000\000\003\153\000\000\003\153\003\153\003\153\000\000\003\153\003\153\003\153\000\000\000\000\000\000\000\000\000\000\003\153\003\153\003\153\003\153\003\153\000\000\003\153\000\000\000\000\000\000\000\000\000\000\003\153\003\153\003\153\003\153\003\153\000\000\000\000\003\153\000\000\000\000\000\000\000\000\003\153\000\000\003\153\003\153\000\000\000\000\000\000\000\000\003\153\003\153\003\153\000\000\000\000\000\000\000\000\000\000\000\000\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\003\153\000\000\000\000\003\153\000\000\003\153\003\153\000\000\000\000\000\000\000\000\000\000\000\000\003\153\003\153\003\153\000\000\003\153\003\153\003\153\000\000\003\153\000\000\000\000\000\000\003\153\000\000\003\153\003\153\000\000\n\026\003\153\003\153\003\153\003\153\003\153\000\000\000\000\003\153\003\153\n.\000\000\000\000\000\000\000\000\003\153\003\153\003\153\003\153\003\149\003\149\000\000\000\000\000\000\003\149\000\000\000\000\003\149\000\000\000\000\003\149\000\000\003\149\000\000\000\000\011B\000\000\003\149\003\149\003\149\000\000\003\149\003\149\003\149\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003\149\000\000\000\000\000\000\000\000\000\000\003\149\003\149\012:\012R\003\149\000\000\000\000\003\149\000\000\000\000\000\000\000\000\003\149\000\000\012j\003\149\000\000\000\000\000\000\000\000\003\149\003\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\149\003\149\011Z\011\218\012\130\012\154\012\202\003\149\003\149\000\000\000\000\003\149\000\000\003\149\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003\149\003\149\012\250\000\000\003\149\003\149\003\149\000\000\003\149\000\000\000\000\000\000\003\149\000\000\003\149\003\149\000\000\rZ\003\149\rr\012\178\003\149\003\149\000\000\000\000\003\149\r\018\003\149\000\000\000\000\000\000\000\000\003\149\003\149\r*\rB\003a\003a\000\000\000\000\000\000\003a\000\000\000\000\003a\000\000\000\000\003a\000\000\003a\000\000\000\000\003a\000\000\003a\003a\003a\000\000\003a\003a\003a\000\000\000\000\000\000\000\000\000\000\003a\003a\003a\003a\003a\000\000\003a\000\000\000\000\000\000\000\000\000\000\003a\003a\003a\003a\003a\000\000\000\000\003a\000\000\000\000\000\000\000\000\003a\000\000\003a\003a\000\000\000\000\000\000\000\000\003a\003a\003a\000\000\000\000\000\000\000\000\000\000\000\000\003a\003a\003a\003a\003a\003a\003a\003a\003a\000\000\000\000\003a\000\000\003a\003a\000\000\000\000\000\000\000\000\000\000\000\000\003a\003a\003a\000\000\003a\003a\003a\000\000\003a\000\000\000\000\000\000\003a\000\000\003a\003a\000\000\n\026\003a\003a\003a\003a\003a\000\000\000\000\003a\003a\n.\000\000\000\000\000\000\000\000\003a\003a\003a\003a\003]\003]\000\000\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\003]\000\000\003]\000\000\000\000\011B\000\000\003]\003]\003]\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003]\000\000\000\000\000\000\000\000\000\000\003]\003]\012:\012R\003]\000\000\000\000\003]\000\000\000\000\000\000\000\000\003]\000\000\012j\003]\000\000\000\000\000\000\000\000\003]\003]\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\011Z\011\218\012\130\012\154\012\202\003]\003]\000\000\000\000\003]\000\000\003]\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\012\250\000\000\003]\003]\003]\000\000\003]\000\000\000\000\000\000\003]\000\000\003]\003]\000\000\rZ\003]\rr\012\178\003]\003]\000\000\000\000\003]\r\018\003]\000\000\000\000\000\000\000\000\003]\003]\r*\rB\n\025\n\025\000\000\000\000\000\000\n\025\000\000\000\000\n\025\000\000\000\000\n\025\000\000\n\025\000\000\000\000\011B\000\000\n\025\n\025\n\025\000\000\n\025\n\025\n\025\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\n\025\000\000\000\000\000\000\000\000\000\000\n\025\n\025\012:\012R\n\025\000\000\000\000\n\025\000\000\000\000\000\000\000\000\n\025\000\000\012j\n\025\000\000\000\000\000\000\000\000\n\025\n\025\000\238\000\000\000\000\000\000\000\000\000\000\000\000\n\025\n\025\011Z\011\218\012\130\012\154\012\202\n\025\n\025\000\000\000\000\n\025\000\000\n\025\012\226\000\000\000\000\000\000\000\000\000\000\000\000\n\025\n\025\012\250\000\000\n\025\n\025\n\025\000\000\n\025\000\000\000\000\000\000\n\025\000\000\n\025\n\025\000\000\n\025\n\025\n\025\012\178\n\025\n\025\000\000\000\000\n\025\r\018\n\025\000\000\000\000\000\000\000\000\n\025\n\025\r*\rB\nq\nq\000\000\000\000\000\000\nq\000\000\000\000\nq\000\000\000\000\nq\000\000\nq\000\000\000\000\nq\000\000\nq\nq\nq\000\000\nq\nq\nq\000\000\000\000\000\000\000\000\000\000\nq\nq\nq\nq\nq\000\000\nq\000\000\000\000\000\000\000\000\000\000\nq\nq\nq\nq\nq\000\000\000\000\nq\000\000\000\000\000\000\000\000\nq\000\000\nq\nq\000\000\000\000\000\000\000\000\nq\nq\nq\000\000\000\000\000\000\000\000\000\000\000\000\nq\nq\nq\nq\nq\nq\nq\nq\nq\000\000\000\000\nq\000\000\nq\nq\000\000\000\000\000\000\000\000\000\000\000\000\nq\nq\nq\000\000\nq\nq\nq\000\000\nq\000\000\000\000\000\000\nq\000\000\nq\nq\000\000\n\026\nq\nq\nq\nq\nq\000\000\000\000\nq\nq\n.\000\000\000\000\000\000\000\000\nq\nq\nq\nq\002i\002i\000\000\000\000\000\000\002i\000\000\000\000\002i\000\000\000\000\002i\000\000\002i\000\000\000\000\002i\000\000\002i\002i\002i\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002i\000\000\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002i\000\000\000\000\002i\000\000\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002i\002i\002i\002i\002i\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\002i\002i\017\n\000\000\002i\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\n\026\002i\002i\002i\002i\002i\000\000\000\000\002i\002i\n.\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002a\002a\000\000\000\000\000\000\002a\000\000\000\000\002a\000\000\000\000\002a\000\000\002a\000\000\000\000\002a\000\000\002a\002a\002a\000\000\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\002a\002a\000\000\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\002a\002a\000\000\000\000\002a\000\000\000\000\000\000\000\000\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\002a\002a\002a\002a\002a\002a\000\000\000\000\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\000\000\002a\002a\002a\000\000\002a\000\000\000\000\000\000\002a\000\000\002a\002a\000\000\n\026\002a\002a\002a\002a\002a\000\000\000\000\002a\002a\n.\000\000\000\000\000\000\000\000\002a\002a\002a\002a\002]\002]\000\000\000\000\000\000\002]\000\000\000\000\002]\000\000\000\000\002]\000\000\002]\000\000\000\000\011B\000\000\002]\002]\002]\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\012:\012R\002]\000\000\000\000\002]\000\000\000\000\000\000\000\000\002]\000\000\012j\002]\000\000\000\000\000\000\000\000\002]\002]\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\011Z\011\218\012\130\012\154\012\202\002]\002]\000\000\000\000\002]\000\000\002]\012\226\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\012\250\000\000\002]\002]\002]\000\000\002]\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\rZ\002]\rr\012\178\002]\002]\000\000\000\000\002]\r\018\002]\000\000\000\000\000\000\000\000\002]\002]\r*\rB\002e\002e\000\000\000\000\000\000\002e\000\000\000\000\002e\000\000\000\000\002e\000\000\002e\000\000\000\000\011B\000\000\002e\002e\002e\000\000\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\012:\012R\002e\000\000\000\000\002e\000\000\000\000\000\000\000\000\002e\000\000\012j\002e\000\000\000\000\000\000\000\000\002e\002e\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002e\002e\011Z\011\218\012\130\012\154\012\202\002e\002e\000\000\000\000\002e\000\000\002e\012\226\000\000\000\000\000\000\000\000\000\000\000\000\002e\002e\012\250\000\000\002e\002e\017&\000\000\002e\000\000\000\000\000\000\002e\000\000\002e\002e\000\000\rZ\002e\rr\012\178\002e\002e\000\000\000\000\002e\r\018\002e\000\000\000\000\000\000\000\000\002e\002e\r*\rB\002Y\002Y\000\000\000\000\000\000\002Y\000\000\000\000\002Y\000\000\000\000\002Y\000\000\002Y\000\000\000\000\002Y\000\000\002Y\002Y\002Y\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\002Y\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\000\000\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\000\000\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\000\000\002Y\002Y\002Y\000\000\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\n\026\002Y\002Y\002Y\002Y\002Y\000\000\000\000\002Y\002Y\n.\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002U\002U\000\000\000\000\000\000\002U\000\000\000\000\002U\000\000\000\000\002U\000\000\002U\000\000\000\000\011B\000\000\002U\002U\002U\000\000\002U\002U\002U\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\002U\000\000\000\000\000\000\000\000\000\000\002U\002U\012:\012R\002U\000\000\000\000\002U\000\000\000\000\000\000\000\000\002U\000\000\012j\002U\000\000\000\000\000\000\000\000\002U\002U\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002U\002U\011Z\011\218\012\130\012\154\012\202\002U\002U\000\000\000\000\002U\000\000\002U\012\226\000\000\000\000\000\000\000\000\000\000\000\000\002U\002U\012\250\000\000\002U\002U\002U\000\000\002U\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\rZ\002U\rr\012\178\002U\002U\000\000\000\000\002U\r\018\002U\000\000\000\000\000\000\000\000\002U\002U\r*\rB\003Y\003Y\000\000\000\000\000\000\003Y\000\000\000\000\003Y\000\000\000\000\003Y\000\000\003Y\000\000\000\000\003Y\000\000\003Y\003Y\003Y\000\000\003Y\003Y\003Y\000\000\000\000\000\000\000\000\000\000\003Y\003Y\003Y\003Y\003Y\000\000\003Y\000\000\000\000\000\000\000\000\000\000\003Y\003Y\003Y\003Y\003Y\000\000\000\000\003Y\000\000\000\000\000\000\000\000\003Y\000\000\003Y\003Y\000\000\000\000\000\000\000\000\003Y\003Y\003Y\000\000\000\000\000\000\000\000\000\000\000\000\003Y\003Y\003Y\003Y\003Y\003Y\003Y\003Y\003Y\000\000\000\000\003Y\000\000\003Y\003Y\000\000\000\000\000\000\000\000\000\000\000\000\003Y\003Y\003Y\000\000\003Y\003Y\003Y\000\000\003Y\000\000\000\000\000\000\003Y\000\000\003Y\003Y\000\000\n\026\003Y\003Y\003Y\003Y\003Y\000\000\000\000\003Y\003Y\n.\000\000\000\000\000\000\000\000\003Y\003Y\003Y\003Y\003U\003U\000\000\000\000\000\000\003U\000\000\000\000\003U\000\000\000\000\003U\000\000\003U\000\000\000\000\011B\000\000\003U\003U\003U\000\000\003U\003U\003U\000\000\000\000\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\003U\000\000\000\000\000\000\000\000\000\000\003U\003U\012:\012R\003U\000\000\000\000\003U\000\000\000\000\000\000\000\000\003U\000\000\012j\003U\000\000\000\000\000\000\000\000\003U\003U\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003U\003U\011Z\011\218\012\130\012\154\012\202\003U\003U\000\000\000\000\003U\000\000\003U\012\226\000\000\000\000\000\000\000\000\000\000\000\000\003U\003U\012\250\000\000\003U\003U\003U\000\000\003U\000\000\000\000\000\000\003U\000\000\003U\003U\000\000\rZ\003U\rr\012\178\003U\003U\000\000\000\000\003U\r\018\003U\000\000\000\000\000\000\000\000\003U\003U\r*\rB\002I\002I\000\000\000\000\000\000\002I\000\000\000\000\002I\000\000\000\000\002I\000\000\002I\000\000\000\000\002I\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002I\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002I\000\000\000\000\002I\000\000\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002I\002I\002I\002I\002I\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\002I\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\002I\002I\002I\002I\002I\002I\000\000\000\000\002I\002I\n.\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002M\002M\000\000\000\000\000\000\002M\000\000\000\000\002M\000\000\000\000\002M\000\000\002M\000\000\000\000\002M\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\006\138\000\000\000\000\002M\002M\002M\002M\002M\000\000\002M\000\000\004\025\004\025\000\000\000\000\002M\002M\002M\002M\002M\006\142\000\000\002M\000\000\000\000\000\000\000\000\002M\000\000\002M\002M\004\025\000\000\014\005\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002M\002M\002M\002M\002M\014\005\004\025\002M\002.\002M\002M\0022\000\000\000\000\005\209\000\000\000\238\002M\002M\002M\000\000\002M\002M\002M\002>\002M\000\000\004\025\000\000\002M\000\000\002M\002M\000\000\002M\002M\002M\002M\002M\002M\000\000\000\000\002M\002M\n.\000\000\000\000\000\000\000\000\002M\002M\002M\002M\001\006\002J\000\006\000\000\000\000\000\000\002\194\002\198\006\146\002\242\002\146\006J\006\158\005\209\000\000\002\254\001\n\000\000\006\178\000\000\002\158\000\000\006\190\006e\000\000\001\210\000\000\000\000\000\000\003\250\001\018\t.\t2\001\030\001\"\000\000\000\000\t-\003\006\000\000\003\166\t-\019\190\000\000\tV\tZ\002N\003\226\003\230\000\000\003\234\003\246\004\002\t^\007n\000\000\001:\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\tr\001R\t-\007\249\000\000\001V\000\000\t~\t\150\n:\005\194\005\198\000\000\000\000\001Z\000\000\000\000\000\000\000\000\000\000\000\000\001^\007\249\t-\000\000\000\000\007\249\000\000\000\000\000\000\000\000\001\154\006~\000\000\006\226\005\202\b\242\000\000\001\158\000\000\017f\004\138\nN\001\006\001\166\000\006\001\170\001\174\000\000\002\194\002\198\000\000\002\242\002\146\006\230\000\000\000\000\000\000\002\254\001\n\000\000\005\006\000\000\t*\000\000\000\000\000\000\000\238\001\210\000\000\000\000\000\000\003\250\001\018\t.\t2\001\030\001\"\000\000\000\000\000\000\003\006\000\000\003\166\000\000\t6\000\000\tV\tZ\000\000\003\226\003\230\000\000\003\234\003\246\004\002\t^\007n\000\238\001:\000\000\002\186\b\005\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\006\146\005\182\000\000\006J\001>\001B\001F\001J\001N\b\005\006\178\tr\001R\b\005\006\190\000\000\001V\000\000\t~\t\150\n:\005\194\005\198\000\000\000\000\001Z\t\213\000\000\000\000\000\000\000\000\006\146\001^\000\000\006J\000\000\004\197\000\000\000\000\000\000\000\000\006\178\001\154\006\214\000\000\006\190\005\202\b\242\000\000\001\158\000\000\017f\004\138\nN\0059\001\166\000\006\001\170\001\174\000\246\002\194\002\198\002\202\002\242\002\146\000\000\000\000\000\000\t\213\002\254\000\000\000\000\003r\000\000\000\000\000\000\0059\000\000\003v\001\210\000\238\021\014\000\000\003\002\b\005\003z\003~\000\000\000\000\t\213\003\130\000\000\003\006\000\000\003\166\000\000\020\162\000\000\003\218\003\222\n\166\003\226\003\230\n\178\003\234\003\246\004\002\004\n\007n\000\249\004\197\021\006\002\186\000\000\000\249\003\254\021\030\000\000\000\000\b\218\b\222\b\234\b\254\t\213\005\182\006\146\000\000\005\006\006J\t\178\t\213\000\000\021&\000\249\tr\006\178\000\000\000\000\r\205\006\190\000\000\t~\t\150\n:\005\194\005\198\021:\021v\000\000\000\000\0059\0059\000\000\000\000\000\000\000\249\000\000\r\205\r\205\000\000\022\222\r\205\000\000\000\000\000\000\000\000\000\249\021\178\025\182\005\202\b\242\000\249\000\145\000\000\t\n\004\138\nN\000\145\000\000\002\198\000\145\000\249\002\146\000\000\n\154\000\000\000\000\002\254\000\000\000\000\000\145\000\000\000\145\000\000\000\145\000\000\000\145\001\210\000\000\n\210\000\000\003\002\000\238\t\209\000\000\000\000\000\249\n\218\000\145\000\000\003\006\002\001\003\166\000\000\000\145\022\170\000\249\000\000\000\145\003\226\003\230\000\000\000\000\003\246\001\190\000\000\000\145\000\000\000\000\000\145\002\186\000\000\r\205\003\254\000\145\000\145\000\145\b\218\b\222\b\234\000\n\014\234\005\182\000\145\000\145\t\209\000\000\000\000\n\190\000\000\000\145\000\000\000\000\000\000\000\145\nU\000\000\000\000\000\000\002\001\000\000\000\000\005\194\005\198\000\145\000\145\t\209\000\000\000\145\000\145\000\000\002\001\002\001\000\000\007\002\029\n\000\000\nU\005%\000\145\000\000\000\000\000\000\005%\000\000\000\145\000\145\005\202\b\242\000\000\000\000\000\169\t\n\004\138\000\000\000\145\000\169\000\145\002\198\000\169\t\209\002\146\005%\n\154\005\006\000\000\002\254\t\209\000\000\000\169\000\000\000\169\000\000\000\169\000\000\000\169\001\210\000\000\n\210\000\238\003\002\000\000\000\000\000\000\005%\000\000\n\218\000\169\000\000\003\006\000\000\003\166\000\000\000\169\000\000\005%\000\000\000\169\003\226\003\230\005%\002\234\003\246\001\190\000\000\000\169\000\000\000\000\000\169\002\186\005%\000\000\003\254\000\169\000\169\000\169\b\218\b\222\b\234\000\000\014\234\005\182\000\169\000\169\006\146\000\000\000\000\006J\029\014\000\169\000\000\000\000\nU\000\169\006\178\005%\000\000\000\000\006\190\000\000\000\000\005\194\005\198\000\169\000\169\005%\000\000\000\169\000\169\003F\007\158\000\000\000\000\000\000\000\000\000\000\000\000\002\018\000\169\000\000\002\026\000\000\000\000\007\142\000\169\000\169\005\202\b\242\001\210\000\000\000\000\t\n\004\138\000\000\000\169\000\006\000\169\000\000\000\246\002\194\002\198\002\202\002\242\002\146\000\000\003Z\000\000\000\000\002\254\000\000\000\000\005Y\000\000\000\000\007\154\001\222\000\000\003v\001\210\000\000\000\000\002\186\003\002\000\000\003z\003~\000\000\000\000\000\000\003\130\000\000\003\006\000\000\003\166\000\000\020\162\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\007\162\021\006\002\186\000\000\000\000\003\254\021\030\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\t)\000\000\000\000\000\000\t)\000\000\021&\014\005\tr\n9\031\238\000\000\000\000\000\000\000\000\t~\t\150\n:\005\194\005\198\021:\021v\000\000\000\000 \015\017\246\000\000\014\005\n~\n9\002.\n9\n9\0022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\025\182\005\202\b\242\t)\002>\000\000\t\n\004\138\nN\000\006\002F\r\241\000\246\002\194\002\198\002\202\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\t) >\000\000\000\000\000\000\000\000\000\000\003v\001\210\000\000\002J\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\003\130\000\000\003\006\000\000\003\166\000\000\020\162\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\005\006\000\000\021\006\002\186\000\000\000\000\003\254\021\030\000\000\000\000\b\218\b\222\b\234\b\254\n\026\005\182\000\000\002N\000\000\000\000\000\000\000\000\n9\021&\n.\tr\000\000\031\238\000\000\000\000\000\000\000\000\t~\t\150\n:\005\194\005\198\021:\021v\001\206\000\000\005a\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\001\210\000>\025\182\005\202\b\242\000B\000\000\000\000\t\n\004\138\nN\000\000\000F\022\214\000\000\000\000\000\000\000\000\000J\000\000\000N\000R\000V\000Z\000^\000b\000f\002\170\001*\023N\000j\000\000\000\000\002\186\000n\002\001\000r\000\000\000v\000\000\023f\000\000\002\001\000\000\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000z\002\001\000\000\000~\000\130\000\000\000\000\000\000\000\000\000\n\000\134\000\138\000\142\000\000\000\000\000\000\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\002\001\000\000\000\174\000\178\000\000\000\182\000\000\002\001\000\000\000\186\000\000\000\190\000\194\002\001\000\000\000\000\001\006\000\000\000\000\000\198\000\000\000\202\003\022\002\198\006b\000\000\002\146\000\206\000\210\000\000\000\214\002\254\001\n\000\000\000\000\002\001\002\158\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\0036\001\030\001\"\000\000\000\000\000\000\002\001\000\000\000\000\000\000\003:\002\001\001.\006z\000\000\000\000\000\000\000\000\000\000\0032\001\190\0016\000\000\000\000\001:\000\000\002\186\000\000\000\000\004\014\002\001\000\000\000\000\004\018\000\000\004\026\005\170\002\001\005\182\000\n\002\001\001>\001B\001F\001J\001N\000\000\000\000\002\001\001R\005\186\000\000\002\001\001V\000\000\000\000\000\n\002\001\005\194\005\198\000\000\006\n\001Z\002\001\000\000\002\001\000\000\006\022\002\001\001^\002\001\000\000\000\000\000\000\002\001\002\001\000\000\002\001\002\001\001\154\006~\002\001\000\000\005\202\000\000\000\000\001\158\002\001\001\162\004\138\001\006\000\000\001\166\000\000\001\170\001\174\003\022\002\198\t\210\000\000\002\146\000\000\000\000\002\001\000\000\002\254\001\n\000\000\000\000\002\001\002\158\000\000\000\000\002\001\000\000\001\210\003\158\000\000\002\198\001\014\001\018\001\022\0036\001\030\001\"\003j\000\000\000\000\003\146\000\000\000\000\b\162\003:\000\000\001.\006z\001\210\000\000\000\000\000\000\000\000\0032\001\190\0016\000\000\000\000\001:\000\000\002\186\018\178\000\000\004\014\002\146\000\000\000\000\004\018\000\000\004\026\005\170\000\000\005\182\000\000\003\154\001>\001B\001F\001J\001N\000\000\002\186\025^\001R\005\186\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\194\005\198\000\000\006\n\001Z\000\000\000\000\000\000\000\000\006\022\000\000\001^\000\000\018\182\000\000\000\000\000\000\007\130\000\000\000\000\000\000\001\154\006~\000\000\000\000\005\202\000\000\018\194\001\158\025\130\001\162\004\138\000\000\004\149\001\166\000\000\001\170\001\174\004\149\003\022\002\198\004\149\007\201\002\146\000\000\007>\000\000\007\201\002\254\018\178\000\000\004\149\002\146\005\198\000\000\004\149\000\000\004\149\001\210\000\000\007^\000\000\000\000\000\000\025\142\003\026\007\201\000\000\t\162\004\149\000\000\000\000\000\000\000\000\000\000\004\149\000\000\000\000\003&\000\000\000\000\025\"\000\000\000\000\t\206\001\190\000\000\004\149\007\201\000\000\004\149\002\186\000\000\018\182\004\014\004\149\004\149\012\005\004\018\007\201\004\026\000\000\t\222\005\182\007\201\007\201\000\238\018\194\000\000\025b\000\000\004\149\004\149\007\201\007\201\005\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\194\005\198\004\149\004\149\r\150\000\000\004\149\004\149\000\000\000\000\005\198\000\000\000\000\000\000\000\000\000\000\007\201\000\000\000\000\012\005\n\166\025n\012\005\r\158\004\149\005\202\007\201\000\000\000\000\012\005\n=\004\138\000\006\012\005\000\000\004\149\002\194\002\198\025\"\002\242\002\146\000\000\027\214\000\000\000\000\002\254\000\000\000\000\000\000\000\000\n=\000\000\n=\n=\000\000\001\210\000\000\000\000\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\nn\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\001\000\000\n5\000\000\000\006\000\000\000\000\002\001\002\194\002\198\002\001\002\242\002\146\000\000\005\202\b\242\n=\002\254\002\001\t\n\004\138\nN\n5\000\000\n5\n5\000\n\001\210\000\000\000\000\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\002\001\002\001\003\006\000\000\003\166\000\000\002\001\000\000\003\218\003\222\000\000\003\226\003\230\002\001\003\234\003\246\004\002\004\n\007n\002\001\002\001\000\000\002\186\002\001\000\000\003\254\002\001\000\n\000\000\b\218\b\222\b\234\b\254\002\001\005\182\000\000\000\000\000\000\000\000\002\001\000\000\002\001\000\000\000\000\tr\002\001\002\001\000\000\000\000\000\000\002\001\nn\t\150\n:\005\194\005\198\002\001\002\001\002\001\002\001\002\001\000\000\000\000\000\000\002\001\002\001\000\000\002\001\002\001\002\001\000\000\000\000\000\000\002\001\002\001\003\134\000\n\000\000\002\001\005\202\b\242\n5\000\n\002\001\t\n\004\138\nN\002\001\000\000\002\001\002\001\000\n\000\000\000\000\002\001\000\000\002\001\002\001\002\001\000\000\002\001\002\001\002\001\002\001\000\000\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\000\000\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\000\n\000\000\002\001\007r\000\000\002\001\002\001\002\001\000\000\018f\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\002\001\002\001\000\000\000\000\002\001\000\000\002\001\002\001\000\000\000\000\002\001\000\000\007v\002\001\002\001\000\000\002\001\002\001\002\001\002\001\000\000\000\000\002\001\002\001\000\000\005\201\005\201\002\001\002\001\002\001\005\201\002\001\005\201\005\201\000\000\005\201\000\000\005\201\005\201\002\001\002\001\005\201\018\166\005\201\005\201\005\201\005\201\005\201\005\201\005\201\005\201\000\000\005\201\000\000\005\201\000\000\000\000\000\000\000\000\000\000\000\000\005\201\000\000\000\000\002\001\000\000\005\201\005\201\005\201\000\000\002\001\005\201\005\201\005\201\000\000\000\000\000\000\005\201\000\000\005\201\000\000\000\000\005\201\000\000\000\000\005I\000\000\005\201\005\201\005\201\022\238\000\000\005\201\005\201\005\201\000\000\005\201\005\201\000\000\000\000\000\000\000\000\000\000\005\201\000\000\000\000\000\000\005\201\005\201\003v\005\201\000\000\005\201\000\000\000\000\000\000\000\000\005\201\005\201\005\201\000\000\005\201\005\201\005\201\005\201\000\000\005\201\005\201\000\000\000\000\000\000\023\026\005\201\000\000\005\201\005\201\000\000\000\000\002\166\005\201\000\000\000\000\021\006\0242\005\201\000\000\012!\021\030\005\201\012!\005\201\005\201\012!\012!\000\000\005\201\012!\023F\012!\000\000\000\000\012!\000\000\000\000\000\000\012!\012!\000\000\012!\012!\000\000\012!\000\000\012!\000\000\000\000\000\000\000\000\012!\000\000\000\000\012!\005I\000\000\000\000\000\000\000\000\000\000\000\000\012!\000\000\012!\023\170\000\000\000\000\000\000\000\000\012!\012!\014\005\r\241\000\000\000\000\000\000\012!\000\000\000\000\012!\000\000\000\000\012!\012!\000\000\012!\000\000\012!\012!\000\000\000\000\014\005\000\000\000\000\002.\000\000\000\000\0022\000\000\000\000\012!\000\000\000\000\000\000\002:\000\000\000\000\000\000\012!\012!\002>\000\000\012!\000\000\012!\000\000\002F\r\241\000\000\000\000\005\230\000\000\000\000\000\000\014\005\r\241\000\000\012!\012!\000\000\012!\012!\000\000\012!\000\000\012!\007y\012!\000A\012!\002J\012!\000A\000A\014\005\000A\000A\002.\000\000\000\000\0022\000A\000\000\000\000\000\000\000\000\007y\002\214\000\000\000\000\000\000\000A\000\000\002>\000\000\000A\000\000\000A\000A\002F\r\241\000\000\005Q\000\000\000A\000\000\000A\025\222\000\000\000\000\000A\000A\000\000\000A\000A\002N\000A\000A\000A\000A\000A\005\249\014E\002J\000A\000\000\003v\000A\000\000\000\000\000\000\000A\000A\000A\000A\000\000\000A\000\000\000\000\000\000\005\249\000\000\005\253\014E\005\249\000\000\000A\000\000\026N\000\000\000\000\000\000\000\000\000A\000A\000A\000A\000A\000\000\021\006\007u\005\253\000=\000\000\021\030\005\253\000=\000=\002N\000=\000=\000\000\000\000\026\242\027\002\000=\000\000\000\000\000\000\000\000\007u\000A\000A\000\000\000\000\000=\000A\000A\000A\000=\000\000\000=\000=\000\000\000\000\000\000\005%\000\000\000=\005Q\000=\005%\014E\014E\000=\000=\000\000\000=\000=\027\246\000=\000=\000=\000=\000=\005\249\000\000\000\000\000=\000\000\005%\000=\014E\014E\014E\000=\000=\000=\000=\000\000\000=\005\249\000\000\000\000\005\249\000\000\005\253\000\000\000\000\000\000\000=\000\000\005%\014E\000\000\014E\000\000\000=\000=\000=\000=\000=\005\253\005%\007\133\005\253\r\141\000\000\005%\002\234\r\141\r\141\000\000\r\141\r\141\000\000\000\000\005%\005%\r\141\000\000\000\000\000\000\000\000\007\133\000=\000=\000\000\000\000\r\141\000=\000=\000=\r\141\000\000\r\141\r\141\000\000\000\000\000\000\000\000\000\000\r\141\005%\r\141\000\000\000\000\000\000\r\141\r\141\000\000\r\141\r\141\005%\r\141\r\141\r\141\r\141\r\141\000\000\000\000\000\000\r\141\000\000\000\000\r\141\000\000\000\000\000\000\r\141\r\141\r\141\r\141\000\000\r\141\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\141\000\000\000\000\000\000\000\000\tJ\000\000\r\141\r\141\r\141\r\141\r\141\002\014\000\000\007\129\000\000\r\137\000\000\000\000\002\018\r\137\r\137\002\026\r\137\r\137\000\000\000\000\000\000\000\000\r\137\001\210\000\000\000\000\000\000\007\129\r\141\r\141\000\000\000\000\r\137\r\141\r\141\r\141\r\137\000\000\r\137\r\137\003Z\000\000\000\000\000\000\000\000\r\137\000\000\r\137\000\000\007\154\001\222\r\137\r\137\000\000\r\137\r\137\002\186\r\137\r\137\r\137\r\137\r\137\000\000\000\000\000\000\r\137\000\000\000\000\r\137\000\000\000\000\000\000\r\137\r\137\r\137\r\137\000\000\r\137\000\000\000\000\000\000\000\000\000\000\000\000\007\162\000\000\000\000\r\137\000\000\000\000\000\000\000\000\000\000\000\000\r\137\r\137\r\137\r\137\r\137\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\r\137\r\137\000\000\000\000\001\210\r\137\r\137\r\137\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\n\182\003\234\003\246\004\002\004\n\007n\001\202\001\206\r\162\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\000\000\tr\000\000\000\000\000\000\001\242\000\000\000\000\nn\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\246\002\162\000\000\000\000\000\000\002\174\000\000\002\186\0046\004B\000\000\000\000\000\000\000\000\004N\005\202\b\242\019\170\r\197\r\197\t\n\004\138\nN\r\197\000\000\001\206\r\197\000\000\000\000\000\000\000\000\004R\000\000\000\000\004\222\000\000\r\197\r\197\r\197\000\000\r\197\r\197\r\197\000\000\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\000\000\000\000\r\197\000\000\000\000\000\000\000\000\000\000\r\197\r\197\000\000\000\000\r\197\000\000\001\210\000\000\000\000\000\000\002\170\000\000\r\197\000\000\000\000\r\197\000\000\000\000\000\000\025\210\r\197\r\197\r\197\000\000\000\000\000\000\000\000\000\000\000\000\r\197\r\197\000\000\027\014\003\178\000\000\027\018\r\197\000\000\000\000\002\186\004\230\000\000\000\000\r\197\000\000\000\000\027B\000\000\000\000\000\000\r\197\r\197\r\197\000\000\r\197\r\197\000\000\000\000\004\253\000\000\000\000\000\000\000\000\004\253\000\000\r\197\004\253\r\197\r\197\027R\000\000\000\000\r\197\000\000\000\000\000\000\004\253\r\197\000\000\000\000\004\253\r\197\004\253\r\197\r\197\n%\n%\000\000\000\000\000\000\n%\000\000\001\206\n%\004\253\000\000\000\000\000\000\000\000\000\000\004\253\n%\000\000\n%\n%\n%\000\000\n%\n%\n%\000\000\000\000\004\253\000\000\000\000\004\253\000\000\000\000\000\000\000\000\004\253\n%\000\000\000\000\000\000\000\000\000\000\n%\n%\000\000\000\000\n%\000\000\000\000\000\000\000\000\004\253\002\170\000\000\n%\004\253\000\000\n%\000\000\000\000\000\000\000\000\n%\n%\n%\004\253\004\253\000\000\000\000\004\253\004\253\n%\n%\000\000\000\000\000\000\000\000\000\000\n%\000\000\000\000\000\000\004\230\000\000\000\000\n%\000\000\004\253\000\000\000\000\000\000\000\000\n%\n%\n%\000\000\n%\n%\020\222\000\000\004\245\000\000\000\000\000\000\000\000\004\245\000\000\n%\004\245\n%\n%\000\000\000\000\000\000\n%\000\000\000\000\000\000\004\245\n%\000\000\000\000\004\245\n%\004\245\n%\n%\n!\n!\000\000\000\000\000\000\n!\000\000\001\206\n!\004\245\000\000\000\000\000\000\000\000\000\000\004\245\n!\000\000\n!\n!\n!\000\000\n!\n!\n!\000\000\000\000\004\245\000\000\000\000\004\245\000\000\000\000\000\000\000\000\004\245\n!\000\000\000\000\000\000\000\000\000\000\n!\n!\000\000\000\000\n!\000\000\000\000\000\000\000\000\004\245\002\170\000\000\n!\004\245\000\000\n!\000\000\000\000\000\000\000\000\n!\n!\n!\004\245\004\245\000\000\000\000\004\245\004\245\n!\n!\000\000\000\000\000\000\000\000\000\000\n!\000\000\000\000\000\000\004\230\000\000\000\000\n!\000\000\004\245\000\000\000\000\000\000\000\000\n!\n!\n!\000\000\n!\n!\023\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\169\n!\000\006\n!\n!\001\169\002\194\002\198\n!\002\242\002\146\000\000\000\000\n!\000\000\002\254\000\000\n!\000\000\n!\n!\000\000\004\022\000\000\001\169\001\210\000\000\000\000\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\001\169\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\001\169\002\186\000\000\000\000\003\254\001\169\001\169\000\238\b\218\b\222\b\234\b\254\000\000\005\182\001\169\001\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\nn\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\000\001\169\000\000\000\000\000\000\000\000\000\000\014Q\000\000\000\006\000\000\001\169\014Q\002\194\002\198\000\000\002\242\002\146\000\000\005\202\b\242\017z\002\254\000\000\t\n\004\138\nN\000\000\000\000\017\142\000\000\014Q\001\210\000\000\000\000\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\014Q\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\014Q\002\186\000\000\000\000\003\254\014Q\014Q\000\238\b\218\b\222\b\234\b\254\000\000\005\182\014Q\014Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\nn\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\000\014Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014Q\000\000\rI\000\000\000\000\000\000\000\000\rI\005\202\b\242\rI\000y\000\000\t\n\004\138\nN\000y\000\000\000y\000y\rI\000\000\000\000\000\000\rI\000\000\rI\000y\000\000\000y\000y\000\000\000\000\000y\000y\000y\000\000\t\189\rI\000\000\000\000\000\000\000\000\000\000\rI\000\000\000\000\000y\000\000\000\000\000\000\000\000\000\000\000y\000y\000\000\rI\000y\000\000\rI\000\000\000\000\000\000\000y\rI\000y\000\000\000\000\000y\000\000\000\000\000\000\000\000\000y\000y\000y\000\000\000\000\000\000\000\000\rI\0112\000y\000y\rI\000\000\000\000\000\000\000\000\000y\000y\000\000\000\000\000y\rI\rI\000y\000\000\rI\rI\000\000\000\000\000\000\000y\000y\000y\000\000\000y\000y\000\000\000\000\000\000\000\000\000\000\t\189\000\006\rI\000\000\000y\002\194\002\198\000y\002\242\002\146\000\000\000y\000\000\r\138\002\254\000\000\000y\000\000\000\000\000\000\000y\000\000\000y\000\000\001\210\000\000\000\000\000\000\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\020\014\t\150\n:\005\194\005\198\000\000\000\000\005-\000\000\000\006\000\000\000\000\000\246\002\194\002\198\002\"\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\021\182\000\000\000\000\005\202\b\242\000\000\003v\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\021\186\000\000\003\006\000\000\003\166\000\000\021\226\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\021\006\002\186\000\000\000\000\003\254\021\030\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022\130\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\019\150\t\150\n:\005\194\005\198\021:\022\150\005%\000\000\000\006\005-\000\000\005%\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\022\166\005\202\b\242\000\000\005%\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\005%\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\005%\002\186\000\000\000\000\003\254\005%\002\234\000\238\b\218\b\222\b\234\b\254\000\000\005\182\000\000\005%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\018\130\000\000\018\018\t\150\n:\005\194\005\198\002\014\000\000\000\000\000\000\000\006\005%\000\000\002\018\002\194\002\198\002\026\002\242\002\146\000\000\000\000\005%\000\000\002\254\001\210\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\003Z\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\007\154\001\222\003\218\003\222\000\000\003\226\003\230\002\186\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\007\162\000\000\000\000\tr\000\000\000\000\000\000\000\000\019\214\000\000\n\n\t\150\n:\005\194\005\198\002\014\000\000\000\000\000\000\000\006\000\000\000\000\002\018\002\194\002\198\002\026\002\242\002\146\000\000\000\000\000\000\000\000\002\254\001\210\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\003Z\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\007\154\001\222\003\218\003\222\000\000\003\226\003\230\002\186\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\007\162\000\000\000\000\tr\000\000\000\000\000\000\000\000\020*\000\000\n\030\t\150\n:\005\194\005\198\002\014\000\000\000\000\000\000\000\006\000\000\000\000\002\018\002\194\002\198\002\026\002\242\002\146\000\000\000\000\000\000\000\000\002\254\001\210\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\003Z\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\007\154\001\222\003\218\003\222\000\000\003\226\003\230\002\186\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\007\162\000\000\000\000\tr\000\000\000\000\000\000\000\000\020:\000\000\n\134\t\150\n:\005\194\005\198\002\014\000\000\000\000\000\000\000\006\000\000\000\000\002\018\002\194\002\198\002\026\002\242\002\146\000\000\000\000\000\000\000\000\002\254\001\210\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\003Z\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\007\154\001\222\003\218\003\222\000\000\003\226\003\230\002\186\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\007\162\000\000\000\000\tr\000\000\000\000\000\000\000\000\020b\000\000\011\006\t\150\n:\005\194\005\198\002\014\000\000\000\000\000\000\000\006\000\000\000\000\002\018\002\194\002\198\002\026\002\242\002\146\000\000\000\000\000\000\000\000\002\254\001\210\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\003Z\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\007\154\001\222\003\218\003\222\000\000\003\226\003\230\002\186\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\007\162\000\000\000\000\tr\000\000\000\000\000\000\000\000\020r\000\000\011F\t\150\n:\005\194\005\198\002\014\000\000\000\000\000\000\000\006\000\000\000\000\002\018\002\194\002\198\002\026\002\242\002\146\000\000\000\000\000\000\000\000\002\254\001\210\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\003Z\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\007\154\001\222\003\218\003\222\000\000\003\226\003\230\002\186\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\007\162\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\011^\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\011\130\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\011\174\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\011\198\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\011\222\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\011\246\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012\014\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012&\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012>\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012V\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012n\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012\134\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012\158\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012\182\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012\206\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012\230\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\012\254\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\r\022\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\r.\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\rF\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\r^\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\rv\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\015\n\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\0152\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\015Z\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\015\130\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\015\166\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\015\202\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\015\246\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\016\026\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\016>\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\016Z\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\016\250\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\017\014\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\002\194\002\198\000\000\002\242\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\000\000\005\202\b\242\000\000\000\000\001\210\t\n\004\138\nN\003\002\000\000\003z\003~\000\000\000\000\000\000\000\000\000\000\003\006\000\000\003\166\000\000\000\000\000\000\003\218\003\222\000\000\003\226\003\230\000\000\003\234\003\246\004\002\004\n\007n\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\b\254\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\tr\000\000\000\000\000\000\000\000\000\000\000\000\017*\t\150\n:\005\194\005\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\246\000\000\000\000\002\202\r\201\r\201\000\000\000\000\000\000\r\201\005\202\b\242\r\201 >\000\000\t\n\004\138\nN\000\000\003v\004\162\000\000\r\201\r\201\r\201\000\000\r\201\r\201\r\201\000\000\000\000\003\130\000\000\000\000\000\000\000\000\000\000\020\162\000\000\000\000\r\201\000\000\000\000\000\000\000\000\000\000\r\201\r\201\000\000\028v\r\201\000\000\021\006\000\000\000\000\000\000\000\000\021\030\r\201\000\000\000\000\r\201\000\000\000\000\000\000\000\000\r\201\r\201\r\201\000\000\000\000\000\000\000\000\021&\000\000\r\201\r\201\031\238\000\000\000\000\000\000\000\000\r\201\000\000\000\000\000\000\r\201\021:\021v\r\201\000\000\005a\000\000\000\000\000\000\000\000\r\201\r\201\r\201\000\000\r\201\r\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\025\182\000\000\r\201\000\000\r\201\r\201\000\000\000\000\000\000\r\201\000\000\000\000\000\000\000\000\r\201\000\000\012-\000\000\r\201\012-\r\201\r\201\003\022\002\198\000\000\000\241\002\146\000\000\007>\000\000\000\241\002\254\000\000\000\000\000\000\012-\012-\000\000\012-\012-\000\000\001\210\000\000\007^\000\000\000\000\000\000\000\000\003\026\000\241\000\000\t\162\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012-\000\000\003&\000\000\000\000\000\000\000\000\000\000\0032\001\190\000\000\000\000\000\241\000\000\000\000\002\186\000\000\003\018\004\014\000\000\000\000\012-\004\018\000\241\004\026\005\170\t\222\005\182\000\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\241\005\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\194\005\198\000\000\006\n\012-\000\000\012-\000\000\000\000\006\022\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\000\000\000\012-\000\000\000\000\012-\012-\000\000\005\202\000\241\012-\000\000\012-\000\000\004\138\012)\012-\000\000\012)\000\000\000\000\003\022\002\198\000\000\000\000\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\012)\012)\000\000\012)\012)\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012)\000\000\003&\000\000\000\000\000\000\000\000\000\000\006^\001\190\000\000\000\000\000\000\000\000\000\000\002\186\000\000\000\000\004\014\000\000\000\000\012)\004\018\000\000\004\026\005\170\000\000\005\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\186\000\000\003\209\003\209\000\000\000\000\000\000\003\209\005\194\005\198\003\209\006\n\012)\000\000\012)\000\000\000\000\006\022\000\000\000\000\003\209\003\209\003\209\000\000\003\209\003\209\003\209\012)\000\000\000\000\012)\012)\000\000\005\202\000\000\012)\000\000\012)\003\209\004\138\000\000\012)\000\000\000\000\003\209\004\154\000\000\000\000\003\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\209\000\000\000\000\003\209\000\000\000\000\000\000\000\000\003\209\003\209\003\209\000\000\000\000\000\000\000\000\000\000\000\000\003\209\003\209\000\000\000\000\000\000\000\000\000\000\003\209\000\000\000\000\000\000\003\209\000\000\000\000\003\209\000\000\000\000\000\000\000\000\000\000\000\000\003\209\003\209\003\209\000\000\003\209\003\209\001\193\001\193\000\000\000\000\000\000\001\193\000\000\000\000\001\193\003\209\000\000\003\209\003\209\000\000\000\000\000\000\003\209\000\000\001\193\001\193\001\193\003\209\001\193\001\193\001\193\003\209\000\000\003\209\003\209\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\193\000\000\000\000\000\000\000\000\000\000\001\193\001\193\000\000\000\000\001\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\193\000\000\000\000\001\193\000\000\000\000\000\000\000\000\001\193\001\193\001\193\000\000\000\000\000\000\000\000\000\000\000\000\001\193\001\193\000\000\000\000\000\000\000\000\000\000\001\193\000\000\000\000\000\000\001\193\000\000\000\000\001\193\000\000\000\000\000\000\000\000\000\000\000\000\001\193\001\193\001\193\000\000\001\193\001\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\193\000\000\001\193\001\193\003\022\002\198\000\000\001\193\002\146\000\000\007>\000\000\001\193\002\254\000\000\000\000\005\006\000\000\001\193\000\000\000\000\000\000\000\000\001\210\000\000\007^\000\000\000\000\000\000\000\000\003\026\000\000\000\000\t\162\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003&\000\000\000\000\000\000\000\000\000\000\t\206\001\190\000\000\000\000\000\000\000\000\000\000\002\186\000\000\000\000\004\014\000\000\000\000\012\005\004\018\000\000\004\026\000\000\t\222\005\182\000\000\000\000\000\000\000\000\006U\006U\000\000\000\000\004\209\006U\000\000\005\186\006U\000\000\000\000\000\000\000\000\000\000\000\000\005\194\005\198\000\000\006U\r\150\006U\000\000\006U\000\000\006U\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\005\000\000\006U\012\005\012\005\000\000\005\202\000\000\006U\006U\012\005\000\000\004\138\000\000\012\005\004\209\000\000\006U\000\000\000\000\006U\000\000\001\006\006U\000\000\000\000\000\000\000\000\006U\006U\006U\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\n\000\000\000\000\000\000\002\158\000\000\006U\006U\000\000\000\000\006U\000\000\000\000\001\014\001\018\001\022\001\026\001\030\001\"\000\000\006U\006U\006U\000\000\006U\006U\001&\000\000\001.\0012\000\000\bV\000\000\000\000\000\000\000\000\000\000\0016\006U\000\000\001:\006U\006U\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006U\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\000\000\000\000\000\000\001V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001Z\004\025\004\025\004\025\004\025\000\000\004\025\001^\004\025\004\025\000\000\004\025\000\000\000\000\000\000\000\000\000\000\001\154\031\002\004\025\000\000\004\025\000\000\004\025\001\158\004\025\001\162\004\025\000\000\000\000\001\166\000\000\001\170\001\174\000\000\000\000\000\000\004\025\000\000\004\025\000\000\000\000\000\000\004\025\004\025\004\025\004\025\000\000\000\000\000\000\000\000\000\000\005\209\000\000\005\213\004\025\000\000\004\025\004\025\000\000\004\025\000\000\000\000\004\025\004\025\004\025\004\025\004\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\025\000\000\004\025\000\000\004\025\000\000\004\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\025\004\025\004\025\004\025\004\025\004\025\004\025\004\025\000\000\000\000\000\000\005\209\000\000\005\213\000\000\000\000\000\000\000\000\004\025\004\025\004\025\004\025\004\025\000\000\004\025\000\000\006I\006I\000\000\000\000\000\000\006I\000\000\004\025\006I\004\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006I\000\000\006I\000\000\006I\000\000\006I\000\000\000\000\b\157\000\000\000\000\b\157\000\000\000\000\000\000\000\000\000\000\006I\000\000\000\000\000\000\000\000\000\000\006I\006I\000\000\000\000\b\157\b\157\000\000\b\157\b\157\b\158\000\000\000\000\006I\000\000\000\000\006I\000\000\000\000\000\000\000\000\006I\006I\000\238\000\000\000\000\000\000\000\000\000\000\b\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006I\006I\000\000\000\000\006I\000\000\000\000\n1\000\000\000\000\000\000\000\000\000\000\b\157\006I\006I\006I\000\000\006I\006I\000\000\000\000\000\000\011B\000\000\000\000\014\190\n1\000\000\n1\n1\000\000\006I\000\000\000\000\006I\006I\011\170\011\242\012\n\011\194\012\"\000\000\b\157\000\000\b\157\000\000\006I\000\000\000\000\000\000\012:\012R\000\000\000\000\000\000\000\000\000\000\006B\000\000\000\000\b\157\b\157\012j\000\000\000\000\b\157\000\000\b\157\000\000\000\000\000\238\b\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011Z\011\218\012\130\012\154\012\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\226\000\000\000\000\000\000\000\000\001\006\000\000\000\000\000\000\012\250\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\n\000\000\000\000\rZ\000\000\rr\012\178\000\000\000\000\000\000\000\000\n1\r\018\001\014\001\018\001\022\001\026\001\030\001\"\000\000\r*\rB\000\000\000\000\000\000\000\000\001&\000\000\001.\0012\000\000\005%\000\000\000\000\000\000\000\000\005%\0016\000\000\005%\001:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005%\000\000\000\000\000\000\005%\000\000\005%\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\000\000\005%\000\000\001V\000\000\000\000\000\000\005%\000\000\000\000\000\000\000\000\001Z\t\149\t\149\000\000\004Z\000\000\t\149\001^\000\000\t\149\005%\000\000\000\000\000\000\000\000\005%\002\234\001\154\031\030\t\149\000\000\t\149\000\000\t\149\001\158\t\149\001\162\000\000\000\000\000\000\001\166\005%\001\170\001\174\000\000\000\000\000\000\t\149\000\000\000\000\000\000\000\000\000\000\t\149\t\149\005%\005%\000\000\000\000\005%\005%\000\000\000\000\000\000\000\000\t\149\004j\000\000\t\149\000\000\007\238\000\000\000\000\t\149\t\149\t\149\000\000\005%\000\000\000\000\000\000\000\000\0256\000\000\000\000\000\000\000\000\000\000\005%\t\149\000\000\000\000\000\000\t\149\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\149\t\149\t\149\000\000\t\149\t\149\014\145\014\145\000\000\000\000\000\000\014\145\000\000\000\000\014\145\t\149\000\000\000\000\t\149\000\000\000\000\000\000\t\149\000\000\014\145\000\000\014\145\000\000\014\145\000\000\014\145\005\006\000\000\t\149\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\145\000\000\000\000\000\000\000\000\000\000\014\145\014\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004Z\000\000\000\000\014\145\000\000\000\000\014\145\000\000\000\000\000\000\000\000\014\145\014\145\014\145\014\149\014\149\000\000\000\000\000\000\014\149\000\000\000\000\014\149\000\000\000\000\000\000\000\000\014\145\000\000\000\000\000\000\014\145\014\149\000\000\014\149\000\000\014\149\000\000\014\149\000\000\000\000\014\145\014\145\014\145\000\000\014\145\014\145\000\000\000\000\000\000\014\149\000\000\004j\000\000\000\000\000\000\014\149\014\149\000\000\014\145\000\000\000\000\000\000\014\145\000\000\004Z\000\000\000\000\014\149\000\000\000\000\014\149\000\000\000\000\014\145\000\000\014\149\014\149\014\149\001\177\000\000\000\000\000\000\000\000\001\177\000\000\001\206\001\177\000\000\000\000\000\000\000\000\014\149\000\000\000\000\t\253\014\149\001\177\000\000\000\000\000\000\001\177\000\000\001\177\000\000\000\000\014\149\014\149\014\149\000\000\014\149\014\149\000\000\000\000\000\000\001\177\000\000\004j\000\000\000\000\000\000\001\177\001\177\000\000\014\149\000\000\000\000\000\000\014\149\000\000\000\000\002\170\000\000\001\177\000\000\000\000\001\177\000\000\000\000\014\149\000\000\001\177\001\177\001\177\000\000\000\000\005\021\000\000\000\000\000\000\000\000\005\021\000\000\000\000\005\021\000\000\000\000\001\177\001\177\000\000\000\000\004\230\000\000\000\000\005\021\000\000\000\000\000\000\005\021\000\000\005\021\001\177\001\177\003\253\000\000\001\177\001\177\000\000\003\253\000\000\001\206\003\253\005\021\000\000\000\000\000\000\001\177\000\000\005\021\t\249\000\000\003\253\000\000\001\177\000\000\003\253\000\000\003\253\001\177\000\000\005\021\000\000\000\000\005\021\001\177\000\000\000\000\000\000\005\021\003\253\000\000\000\000\000\000\000\000\000\000\003\253\001\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\021\002\170\000\000\003\253\005\021\000\000\003\253\000\000\000\000\000\000\000\000\003\253\003\253\003\253\005\021\005\021\000\000\000\000\005\021\005\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\253\003\253\000\000\000\000\004\230\000\000\000\000\000\000\000\000\005\021\000\000\000\000\000\000\000\000\003\253\003\253\003\249\000\000\003\253\003\253\024\210\003\249\000\000\001\206\003\249\000\000\000\000\000\000\000\000\003\253\000\000\000\000\t\249\000\000\003\249\000\000\003\253\000\000\003\249\000\000\003\249\003\253\000\000\000\000\000\000\000\000\000\000\003\253\000\000\000\000\000\000\000\000\003\249\000\000\000\000\000\000\000\000\000\000\003\249\001\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\170\000\000\003\249\000\000\000\000\003\249\000\000\000\000\000\000\000\000\003\249\003\249\003\249\000\000\000\153\000\000\000\000\000\000\000\000\000\153\000\000\000\000\000\153\000\000\000\000\000\000\003\249\003\249\000\000\000\000\004\230\000\000\000\153\000\000\000\153\000\000\000\153\000\000\000\153\000\000\003\249\003\249\000\000\000\000\003\249\003\249\000\000\000\000\000\000\000\000\000\153\000\000\000\000\000\000\000\000\003\249\000\153\000\000\000\000\000\000\000\153\000\000\003\249\000\000\000\000\000\000\000\000\003\249\000\153\000\000\000\000\000\153\000\000\003\249\000\000\000\000\000\153\000\153\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\153\000\153\000\000\000\000\000\000\000\000\000\000\000\153\000\000\000\221\000\000\000\153\000\000\000\000\000\221\000\000\000\000\000\221\000\000\000\000\000\000\000\153\000\153\000\000\000\000\000\153\000\153\000\221\000\000\000\221\000\000\000\221\000\000\000\221\000\000\000\000\000\153\000\000\000\000\000\000\000\000\000\000\000\153\000\153\000\000\000\221\000\000\000\000\000\000\000\000\000\000\000\221\000\153\000\000\000\153\000\221\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\221\000\000\000\000\000\221\000\000\000\000\000\000\000\000\000\221\000\221\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\221\000\221\000\000\000\000\000\000\000\000\000\000\000\221\000\000\000\161\000\000\000\221\000\000\000\000\000\161\000\000\000\000\000\161\000\000\000\000\000\000\000\221\000\221\000\000\000\000\000\221\000\221\000\161\000\000\000\161\000\000\000\161\000\000\000\161\000\000\000\000\000\221\000\000\000\000\000\000\000\000\000\000\000\221\000\221\000\000\000\161\000\000\000\000\000\000\000\000\000\000\000\161\000\221\000\000\000\221\000\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\161\000\000\000\000\000\161\000\000\000\000\000\000\000\000\000\161\000\161\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\161\000\161\000\000\000\000\000\000\000\000\000\000\000\161\000\000\000\157\000\000\000\161\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\000\000\161\000\161\000\000\000\000\000\161\000\161\000\157\000\000\000\157\000\000\000\157\000\000\000\157\000\000\000\000\000\161\000\000\000\000\000\000\000\000\000\000\000\161\000\161\000\000\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\161\000\000\000\161\000\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\157\000\000\000\000\000\157\000\000\000\000\000\000\000\000\000\157\000\157\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\157\000\157\000\000\000\000\000\000\000\000\000\000\000\157\000\000\001\141\000\000\000\157\000\000\000\000\001\141\000\000\000\000\001\141\000\000\000\000\000\000\000\157\000\157\000\000\000\000\000\157\000\157\001\141\000\000\000\000\000\000\001\141\000\000\001\141\000\000\000\000\000\157\000\246\000\000\000\000\002\202\000\000\000\157\000\157\000\000\001\141\001\141\000\000\000\000\000\000\005Y\001\141\000\157\000\000\000\157\000\000\003v\014\141\014\141\000\000\005\209\000\000\014\141\001\141\000\000\014\141\001\141\000\000\003\130\000\000\000\000\001\141\001\141\001\141\020\162\014\141\000\000\014\141\000\000\014\141\000\000\014\141\000\000\000\000\000\000\000\000\028v\001\141\000\000\021\006\000\000\001\141\000\000\014\141\021\030\000\000\000\000\000\000\000\000\014\141\014\141\001\141\001\141\000\000\000\000\001\141\001\141\000\000\000\000\000\000\021&\014\141\005\209\000\000\014\141\000\000\001\141\000\000\000\000\014\141\014\141\014\141\001\141\001\141\021:\021v\000\000\000\000\001\141\000\000\000\000\000\000\000\000\000\000\001\141\014\141\000\000\000\000\000\000\014\141\000\000\000\000\000\000\000\000\000\000\000\000\025\182\000\000\000\000\014\141\014\141\014\141\000\000\014\141\014\141\014\137\014\137\000\000\000\000\000\000\014\137\000\000\000\000\014\137\000\000\000\000\000\000\014\141\000\000\000\000\000\000\014\141\000\000\014\137\000\000\014\137\000\000\014\137\000\000\014\137\005\006\000\000\014\141\r\169\000\000\000\000\r\169\000\000\000\000\000\000\000\000\014\137\000\000\000\000\000\000\000\000\r\169\014\137\014\137\000\000\000\000\000\000\r\169\000\000\000\000\000\000\000\000\000\000\000\000\014\137\000\000\000\000\014\137\000\000\r\169\000\000\000\000\014\137\014\137\014\137\r\169\t\153\t\153\000\000\000\000\000\000\t\153\000\000\000\000\t\153\000\000\000\000\r\169\014\137\000\000\r\169\000\000\014\137\000\000\t\153\r\169\t\153\000\000\t\153\000\000\t\153\000\000\014\137\014\137\014\137\000\000\014\137\014\137\000\000\000\000\000\000\r\169\t\153\000\000\000\000\r\169\000\000\007\238\t\153\t\153\014\137\000\000\000\000\000\000\014\137\r\169\r\169\000\000\000\000\r\169\t\153\000\000\000\000\t\153\000\000\014\137\031\230\000\000\t\153\t\153\000\238\000\000\000\000\000\000\000\000\000\000\000\000\r\169\000\000\000\000\000\000\000\000\000\000\000\000\t\153\000\000\000\000\000\000\t\153\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\153\t\153\t\153\000\000\t\153\t\153\000\000\000\000\003\022\002\198\000\000\000\000\002\146\000\000\007>\t\153\000\000\002\254\t\153\000\000\000\000\000\000\t\153\000\000\000\000\000\000\000\000\001\210\000\000\007^\000\000\000\000\000\000\t\153\003\026\000\000\000\000\t\162\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\189\000\000\003&\000\000\000\000\000\000\000\000\000\000\t\206\001\190\000\000\000\000\007\229\000\000\000\000\002\186\000\000\000\000\004\014\000\000\000\000\000\000\004\018\000\000\004\026\000\000\t\222\005\182\011B\000\000\000\000\007\229\000\000\000\000\000\000\007\229\000\000\000\000\000\000\005\186\000\000\000\000\011\170\011\242\012\n\011\194\012\"\005\194\005\198\000\000\000\000\003\189\000\000\000\000\000\000\000\000\012:\012R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\189\012j\000\000\003\189\000\000\005\202\000\000\000\000\000\000\000\238\000\000\004\138\000\000\000\000\000\000\000\000\000\000\000\000\011Z\011\218\012\130\012\154\012\202\000\000\000\000\000\000\001\173\000\000\000\000\007\229\012\226\001\173\000\000\001\206\001\173\000\000\000\000\000\000\000\000\012\250\000\000\000\000\t\249\000\000\001\173\000\000\000\000\000\000\001\173\000\000\001\173\000\000\000\000\000\000\rZ\000\000\rr\012\178\000\000\000\000\000\000\000\000\001\173\r\018\000\000\000\000\000\000\000\000\001\173\000\000\000\000\r*\rB\000\000\000\000\000\000\000\000\000\000\002\170\000\000\001\173\000\000\020V\001\173\000\000\000\000\000\000\000\000\001\173\001\173\001\173\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011B\000\000\000\000\000\000\020Z\000\000\001\173\001\173\000\000\000\000\004\230\000\000\000\000\000\000\011\170\011\242\012\n\011\194\012\"\000\000\001\173\001\173\000\000\000\000\001\173\001\173\000\000\000\000\012:\012R\000\000\000\000\000\000\000\000\000\000\001\173\000\000\000\000\000\000\000\000\012j\000\000\001\173\000\000\000\000\000\000\000\000\001\173\000\238\000\000\000\000\000\000\000\000\001\173\000\000\000\000\000\000\011Z\011\218\012\130\012\154\012\202\000\000\000\000\000\000\005-\000\000\000\000\000\000\012\226\000\246\001\202\001\206\002\"\000\000\000\000\000\000\000\000\012\250\000\000\000\000\000\000\000\000\021\182\000\000\000\000\000\000\005-\000\000\003v\001\210\001\250\001\230\rZ\020^\rr\012\178\020n\000\000\000\000\001\242\021\186\r\018\000\000\000\000\000\000\000\000\021\226\000\000\000\000\r*\rB\000\000\000\000\000\000\000\000\001\246\002\162\000\000\000\000\000\000\002\174\021\006\002\186\0046\004B\000\000\021\030\000\000\000\000\004N\006\137\006\137\000\000\000\000\000\000\006\137\000\000\000\000\006\137\000\000\000\000\000\000\022\130\000\000\000\000\000\000\004R\000\000\006\137\000\000\006\137\000\000\006\137\000\000\006\137\000\000\021:\022\150\000\000\000\000\005-\005-\000\000\000\000\000\000\000\000\006\137\000\000\000\000\000\000\000\000\000\000\006\137\006\137\000\000\000\000\000\000\000\000\022\166\000\000\000\000\b\158\000\000\004\134\006\137\004\138\000\000\006\137\000\000\000\000\000\000\000\000\006\137\006\137\000\238\006\133\007\194\000\000\000\000\000\000\006\133\000\000\000\000\006\133\000\000\000\000\000\000\000\000\006\137\000\000\000\000\000\000\006\137\006\133\000\000\006\133\000\000\006\133\000\000\006\133\000\000\000\000\006\137\006\137\006\137\000\000\006\137\006\137\000\000\000\000\000\000\006\133\000\000\000\000\000\000\000\000\000\000\006\133\bB\000\000\006\137\000\000\000\000\000\000\006\137\000\000\000\000\000\000\000\000\006\133\000\000\000\000\006\133\000\000\000\000\006\137\000\000\006\133\006\133\000\238\014\153\014\153\000\000\000\000\000\000\014\153\000\000\000\000\014\153\000\000\000\000\000\000\000\000\006\133\000\000\000\000\000\000\006\133\014\153\000\000\014\153\000\000\014\153\000\000\014\153\000\000\000\000\006\133\006\133\006\133\000\000\006\133\006\133\000\000\000\000\000\000\014\153\000\000\000\000\000\000\000\000\000\000\014\153\014\153\000\000\006\133\000\000\000\000\000\000\006\133\000\000\000\000\000\000\000\000\014\153\000\000\000\000\014\153\000\000\000\000\006\133\000\000\014\153\014\153\000\238\014\157\014\157\000\000\000\000\000\000\014\157\000\000\000\000\014\157\000\000\000\000\000\000\000\000\014\153\000\000\000\000\000\000\014\153\014\157\000\000\014\157\000\000\014\157\000\000\014\157\000\000\000\000\014\153\014\153\014\153\000\000\014\153\014\153\000\000\000\000\000\000\014\157\000\000\000\000\000\000\000\000\000\000\014\157\bB\000\000\014\153\000\000\000\000\000\000\014\153\000\000\000\000\000\000\000\000\014\157\000\000\000\000\014\157\000\000\000\000\014\153\000\000\014\157\014\157\000\238\006\157\007\194\000\000\000\000\000\000\006\157\000\000\000\000\006\157\000\000\000\000\000\000\000\000\014\157\000\000\000\000\000\000\014\157\006\157\000\000\006\157\000\000\006\157\000\000\006\157\000\000\000\000\014\157\014\157\014\157\000\000\014\157\014\157\000\000\000\000\000\000\006\157\000\000\000\000\000\000\000\000\000\000\006\157\bB\000\000\014\157\000\000\000\000\000\000\014\157\000\000\000\000\000\000\000\000\006\157\000\000\000\000\006\157\000\000\000\000\014\157\000\000\006\157\006\157\000\238\006\161\006\161\000\000\000\000\000\000\006\161\000\000\000\000\006\161\000\000\000\000\000\000\000\000\006\157\000\000\000\000\000\000\006\157\006\161\000\000\006\161\000\000\006\161\000\000\006\161\000\000\000\000\006\157\006\157\006\157\000\000\006\157\006\157\000\000\000\000\000\000\006\161\000\000\000\000\000\000\000\000\000\000\006\161\006\161\000\000\006\157\000\000\000\000\000\000\006\157\000\000\000\000\000\000\000\000\006\161\000\000\000\000\006\161\000\000\000\000\006\157\000\000\006\161\006\161\006\161\006\129\007\194\000\000\000\000\000\000\006\129\000\000\000\000\006\129\000\000\000\000\000\000\000\000\006\161\000\000\000\000\000\000\006\161\006\129\000\000\006\129\000\000\006\129\000\000\006\129\000\000\000\000\006\161\006\161\006\161\000\000\006\161\006\161\000\000\000\000\000\000\006\129\000\000\000\000\000\000\000\000\000\000\006\129\bB\000\000\006\161\000\000\000\000\000\000\006\161\000\000\000\000\000\000\000\000\006\129\000\000\000\000\006\129\000\000\000\000\bj\000\000\006\129\006\129\000\238\003\245\000\000\000\000\000\000\000\000\003\245\000\000\001\206\003\245\000\000\000\000\000\000\000\000\006\129\000\000\000\000\000\000\006\129\003\245\000\000\000\000\000\000\003\245\000\000\003\245\000\000\000\000\006\129\006\129\006\129\000\000\006\129\006\129\000\000\000\000\000\000\003\245\000\000\000\000\000\000\000\000\000\000\003\245\000\000\000\000\006\129\000\000\000\000\003\241\006\129\000\000\000\000\002\170\003\241\003\245\001\206\003\241\003\245\000\000\000\000\006\129\000\000\003\245\003\245\003\245\000\000\003\241\000\000\000\000\000\000\003\241\000\000\003\241\000\000\000\000\000\000\000\000\000\000\003\245\003\245\000\000\000\000\004\230\000\000\003\241\000\000\000\000\000\000\000\000\000\000\003\241\000\000\003\245\003\245\000\000\000\000\003\245\003\245\000\000\000\000\002\170\000\000\003\241\000\000\000\000\003\241\000\000\003\245\000\000\000\000\003\241\003\241\003\241\000\000\003\245\0011\000\000\000\000\000\000\003\245\0011\000\000\000\000\0011\000\000\003\245\003\241\003\241\000\000\000\000\004\230\000\000\000\000\0011\000\000\0011\000\000\0011\000\000\0011\003\241\003\241\000\000\000\000\003\241\003\241\000\000\000\000\000\000\000\000\000\000\0011\000\000\000\000\000\000\003\241\000\000\0011\007\237\000\000\000\000\0011\003\241\007\237\000\000\000\000\007\237\003\241\000\000\0011\000\000\000\000\0011\003\241\000\000\000\000\007\237\0011\0011\000\238\007\237\001-\007\237\000\000\000\000\000\000\001-\0011\000\000\001-\000\000\000\000\000\000\0011\007\237\000\000\000\000\0011\000\000\001-\007\237\001-\000\000\001-\000\000\001-\000\000\0011\0011\0011\000\000\0011\0011\000\000\000\000\007\237\000\000\001-\000\000\000\000\007\237\007\237\0011\001-\000\000\000\000\000\000\001-\000\000\0011\000\000\000\000\000\000\000\000\000\000\001-\007\237\000\000\001-\000\000\0011\000\000\000\000\001-\001-\000\238\000\000\000\000\000\000\000\000\007\237\007\237\020\182\001-\007\237\007\237\000\000\000\000\000\000\001-\000\000\000\000\000\000\001-\000\000\000\000\000\000\000\000\000\000\021\246\000\000\000\000\007\237\001-\001-\001-\001i\001-\001-\000\000\000\000\001i\000\000\r\233\001i\000\000\000\000\000\000\001-\000\000\000\000\000\000\r\233\000\000\001i\001-\001i\000\000\001i\000\000\001i\000\000\000\000\000\000\000\000\000\000\001-\000\000\000\000\000\000\000\000\000\000\001i\000\000\000\000\000\000\000\000\000\000\001i\r\233\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\233\000\000\000\000\000\000\000\000\001i\000\000\000\000\000\000\000\000\001i\001i\001i\001\029\000\000\000\000\000\000\000\000\001\029\000\000\002\025\001\029\000\000\000\000\000\000\000\000\001i\000\000\000\000\002\025\r\233\001\029\000\000\001\029\000\000\001\029\000\000\001\029\000\000\000\000\001i\001i\001i\000\000\001i\001i\000\000\000\000\000\000\001\029\000\000\000\000\000\000\000\000\000\000\001\029\002\025\000\000\000\000\000\000\000\000\001\185\001i\000\000\000\000\002\025\001\185\000\000\018\178\001\185\001\029\002\146\000\000\001i\000\000\001\029\001\029\001\029\000\000\001\185\000\000\000\000\000\000\001\185\000\000\001\185\000\000\000\000\000\000\000\000\000\000\001\029\000\000\000\000\000\000\002\025\000\000\001\185\000\000\000\000\000\000\000\000\000\000\001\185\000\000\001\029\001\029\001\029\000\000\001\029\001\029\000\000\018\182\000\000\000\000\001\185\000\000\000\000\001\185\000\000\000\000\000\000\0075\001\185\001\185\000\000\018\194\001\029\000\000\002\198\000\000\000\000\002\146\000\000\000\000\000\000\000\000\002\254\001\029\001\185\000\000\000\000\0075\001\185\000\000\000\000\000\000\001\210\000\000\000\000\000\000\003\002\005\198\001\185\001\185\000\000\000\000\001\185\001\185\000\000\003\006\000\000\003\166\000\000\000\000\000\000\000\000\000\000\001\185\003\226\003\230\000\000\000\000\003\246\001\190\001\185\000\000\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\001\185\b\218\b\222\b\234\000\000\000\000\005\182\000\000\006\002\000\000\000\000\000\000\000\000\000\000\003\022\002\198\000\000\000\000\002\146\000\000\007>\000\000\000\000\002\254\000\000\000\000\005\194\005\198\006\006\000\000\004\022\000\000\000\000\001\210\000\000\007^\000\000\000\000\000\000\000\000\003\026\000\000\000\000\t\162\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\202\b\242\003&\000\000\000\000\t\n\004\138\000\000\0032\001\190\000\000\000\000\000\000\000\000\000\000\002\186\000\000\000\000\004\014\000\000\000\000\000\000\004\018\000\000\004\026\005\170\t\222\005\182\000\000\000\000\nY\000\000\000\000\000\000\000\000\000\000\003\022\002\198\000\000\005\186\002\146\000\000\007>\000\000\000\000\002\254\000\000\005\194\005\198\000\000\006\n\025\206\nY\000\000\000\000\001\210\006\022\007^\000\000\000\000\000\000\000\000\003\026\000\000\000\000\t\162\000\000\000\000\000\000\006\214\028*\000\000\005\202\027^\007*\003&\t\138\000\000\004\138\000\000\000\000\0032\001\190\000\000\000\000\000\000\000\000\000\000\002\186\000\000\000\000\004\014\000\000\000\000\000\000\004\018\000\000\004\026\005\170\t\222\005\182\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\000\000\000\000\002\001\005\186\000\000\000\000\000\000\002\001\000\000\000\000\000\000\005\194\005\198\000\000\006\n\000\000\000\000\002\001\000\000\000\000\006\022\000\000\000\000\000\000\002\001\000\n\000\000\005%\000\000\000\000\000\000\000\000\005%\000\000\000\000\005%\005\202\002\001\nY\000\000\000\000\000\000\004\138\002\001\002\001\005%\000\000\000\000\000\000\005%\002\001\005%\000\000\002\001\000\000\000\000\002\001\002\001\000\000\002\001\002\001\000\000\002\001\005%\000\000\000\000\000\000\000\000\000\000\005%\000\000\000\000\000\000\005%\002\001\000\000\000\000\000\000\000\000\000\000\000\000\005%\002\001\002\001\005%\002\001\000\000\000\000\000\000\005%\002\234\002\001\000\000\000\000\000\000\000\000\000\000\000\000\005%\005%\000\000\000\000\000\000\000\000\000\000\005%\005%\002\001\000\000\005%\000\000\002\001\000\000\002\001\000\000\007]\000\000\000\000\000\000\005%\005%\000\000\002\198\005%\005%\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\005%\007]\000\000\000\000\000\000\000\000\001\210\005%\000\000\000\000\003\002\000\000\029R\000\000\000\000\000\000\000\000\000\000\005%\003\006\000\000\003\166\000\000\000\000\000\000\000\000\000\000\000\000\003\226\003\230\000\000\000\000\003\246\001\190\000\000\000\000\000\000\000\000\000\000\002\186\000\000\000\000\003\254\000\000\000\000\000\000\b\218\b\222\b\234\000\000\000\000\005\182\t%\000\000\000\000\000\000\000\000\t%\000\000\000\000\t%\000\000\000\000\000\000\000\000\000\000\000\000\001\202\001\206\000\000\t%\005\194\005\198\000\000\t%\000\000\t%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\210\001\250\t%\000\000\000\000\000\000\000\000\000\000\t%\000\000\005\202\b\242\t%\000\000\000\000\t\n\004\138\000\000\000\000\000\000\t%\000\000\000\000\t%\000\000\000\000\001\246\002\170\t%\t%\000\238\002\174\000\000\002\186\0046\004B\000\000\t%\t%\000\000\004N\000\000\018\206\000\000\t%\000\000\t!\000\000\t%\000\000\000\000\t!\000\000\000\000\t!\000\000\000\000\004R\t%\t%\t%\000\000\t%\t%\t!\000\000\000\000\000\000\t!\003\233\t!\000\000\000\000\t%\003\233\000\000\000\000\003\233\000\000\000\000\t%\000\000\t!\000\000\000\000\000\000\000\000\003\233\t!\000\000\000\000\003\233\t!\003\233\000\000\000\000\000\000\000\000\000\000\000\000\t!\000\000\000\000\t!\000\000\003\233\018\202\000\000\t!\t!\000\238\003\233\000\000\000\000\000\000\000\000\000\000\t!\t!\000\000\000\000\000\000\000\000\003\233\t!\000\000\003\233\000\000\t!\000\000\000\000\003\233\003\233\003\233\000\000\000\000\000\000\000\000\t!\t!\t!\000\000\t!\t!\000\000\000\000\000\000\003\233\000\000\000\000\000\000\003\233\000\000\t!\000\000\000\000\000\000\000\000\000\000\000\000\t!\003\233\003\233\029Z\000\000\003\233\003\233\000\000\000\000\000\000\000\000\003\022\002\198\000\000\000\000\002\146\003\233\007>\000\000\000\000\002\254\000\000\019*\003\233\000\000\000\000\000\000\000\000\003\233\000\000\001\210\000\000\007^\000\000\003\233\000\000\000\000\003\026\000\000\000\000\t\162\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003&\000\000\000\000\000\000\000\000\000\000\t\206\001\190\000\000\000\000\007\185\007\185\000\000\002\186\000\000\000\000\004\014\000\000\000\000\000\000\004\018\000\000\004\026\000\000\t\222\005\182\004F\000\000\000\000\007\185\007\185\007\185\003\022\002\198\000\000\000\000\002\146\005\186\007>\007\185\000\000\002\254\000\000\000\000\000\000\005\194\005\198\000\000\000\000\r\150\000\000\001\210\000\000\007^\000\000\007\185\007\185\000\000\003\026\000\000\007\185\t\162\007\185\007\185\007\185\000\000\000\000\000\000\026f\007\185\005\202\003&\000\000\000\000\000\000\000\000\004\138\t\206\001\190\000\000\000\000\000\000\000\000\000\000\002\186\000\000\007\185\004\014\000\000\000\000\000\000\004\018\000\000\004\026\000\000\t\222\005\182\000\000\000\000\000\000\000\000\000\000\000\000\005\r\005\r\000\000\000\000\005\r\005\186\000\000\000\000\000\000\005\r\000\000\000\000\000\000\005\194\005\198\005\r\000\000\r\150\000\000\005\r\004:\000\000\007\185\000\000\000\000\000\000\005\r\027\022\000\000\000\000\027.\000\000\000\000\000\000\000\000\000\000\026\198\000\000\005\202\005\r\000\000\000\000\000\000\000\000\004\138\005\r\005\r\000\000\007\181\007\181\000\000\000\000\005\r\000\000\000\000\005\r\000\000\000\000\000\238\005\r\000\000\005\r\005\r\000\000\005\r\0292\000\000\007\181\007\181\007\181\000\000\003\022\002\198\000\000\000\000\002\146\005\r\007\181\000\000\000\000\002\254\000\000\000\000\000\000\005\r\005\r\000\000\006\238\000\000\000\000\001\210\000\000\000\000\007\181\007\181\000\000\000\000\003\026\007\181\000\000\007\181\007\181\007\181\003\233\000\000\000\000\000\000\007\181\003\233\005\r\003&\003\233\000\000\000\000\000\000\005\r\0032\001\190\000\000\000\000\000\000\003\233\000\000\002\186\007\181\003\233\004\014\003\233\000\000\000\000\004\018\000\000\004\026\005\170\000\000\005\182\000\000\000\000\000\000\003\233\018\202\000\000\000\000\000\000\000\000\003\233\000\000\005\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\194\005\198\003\233\006\n\000\000\003\233\000\000\000\000\000\000\006\022\003\233\003\233\003\233\005>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\202\003\233\000\000\r\225\t\138\003\233\004\138\000\000\r\225\000\000\000\000\r\225\000\000\000\000\000\000\003\233\003\233\029\138\000\000\003\233\003\233\r\225\000\000\000\000\006\162\r\225\000\000\r\225\000\000\000\000\001\202\001\206\000\000\005\201\000\000\000\000\019*\003\233\000\000\r\225\000\000\000\000\003\233\000\000\000\000\r\225\000\000\000\000\000\000\001\210\001\250\001\230\000\000\000\000\000\000\000\000\000\000\r\225\000\000\001\242\r\225\000\000\006N\000\000\000\000\r\225\r\225\000\000\003\022\002\198\000\000\000\000\002\146\000\000\000\000\001\246\002\162\002\254\000\000\000\000\002\174\r\225\002\186\0046\004B\r\225\000\000\001\210\000\000\004N\000\000\000\000\000\000\000\000\003\026\r\225\r\225\002\138\000\000\r\225\r\225\000\000\000\000\000\000\000\000\000\000\004R\003&\000\000\000\000\r\225\000\000\000\000\0032\001\190\000\000\000\000\r\225\000\000\000\000\002\186\000\000\000\000\004\014\000\000\000\000\000\000\004\018\r\225\004\026\005\170\000\000\005\182\006\150\000\000\000\000\000\000\000\000\000\000\003\022\002\198\000\000\000\000\002\146\005\186\000\000\000\000\000\000\002\254\000\000\000\000\000\000\005\194\005\198\000\000\006\n\000\000\000\000\001\210\000\000\000\000\006\022\000\000\000\000\000\000\003\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\202\003&\000\000\000\000\000\000\006\182\004\138\0032\001\190\000\000\000\000\003\022\002\198\000\000\002\186\002\146\000\000\004\014\000\000\000\000\002\254\004\018\000\000\004\026\005\170\000\000\005\182\000\000\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\026\005\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\194\005\198\000\000\006\n\003&\000\000\000\000\000\000\014&\006\022\0032\001\190\000\000\000\000\003\022\002\198\000\000\002\186\002\146\000\000\004\014\000\000\000\000\002\254\004\018\005\202\004\026\005\170\000\000\005\182\000\000\004\138\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\026\005\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\194\005\198\000\000\006\n\003&\000\000\000\000\000\000\0142\006\022\0032\001\190\000\000\000\000\003\022\002\198\000\000\002\186\002\146\000\000\004\014\000\000\000\000\002\254\004\018\005\202\004\026\005\170\000\000\005\182\000\000\004\138\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\026\005\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\194\005\198\000\000\006\n\003&\000\000\000\000\000\000\014>\006\022\0032\001\190\000\000\000\000\003\022\002\198\000\000\002\186\002\146\000\000\004\014\000\000\000\000\002\254\004\018\005\202\004\026\005\170\000\000\005\182\000\000\004\138\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\026\005\186\000\000\000\000\000\000\000\000\006!\000\000\000\000\005\194\005\198\006!\006\n\003&\006!\000\000\000\000\000\000\006\022\0032\001\190\000\000\000\000\000\000\006!\000\000\002\186\000\000\006!\004\014\006!\000\000\000\000\004\018\005\202\004\026\005\170\000\000\005\182\000\000\004\138\000\000\006!\000\000\000\000\000\000\000\000\000\000\006!\000\000\005\186\000\000\000\000\000\000\000\000\000\000\000\000\b\158\005\194\005\198\006!\006\n\000\000\006!\000\000\000\000\000\000\006\022\006!\006!\000\238\000\000\006)\000\000\000\000\000\000\000\000\006)\000\000\000\000\006)\000\000\000\000\005\202\006!\006!\000\000\000\000\006!\004\138\006)\000\000\000\000\000\000\006)\000\000\006)\000\000\006!\006!\000\000\000\000\006!\006!\000\000\000\000\000\000\000\000\006)\000\000\000\000\000\000\000\000\000\000\006)\000\000\000\000\000\000\000\000\000\000\006!\000\000\000\000\b\158\000\000\003\233\006)\000\000\000\000\006)\003\233\006!\000\000\003\233\006)\006)\000\238\000\000\000\000\000\000\000\000\000\000\000\000\003\233\000\000\000\000\000\000\003\233\006\229\003\233\006)\006)\000\000\006\229\006)\000\000\006\229\000\000\000\000\000\000\000\000\003\233\018\202\000\000\006)\006)\006\229\003\233\006)\006)\006\229\000\000\006\229\000\000\000\000\000\000\000\000\000\000\000\000\003\233\000\000\000\000\003\233\000\000\006\229\000\000\006)\003\233\003\233\003\233\006\229\000\000\000\000\000\000\000\000\000\000\000\000\006)\000\000\000\000\000\000\000\000\006\229\003\233\000\000\006\229\000\000\003\233\000\000\000\000\006\229\006\229\000\238\000\000\000\000\000\000\000\000\003\233\003\233\021\134\000\000\003\233\003\233\000\000\000\000\000\000\006\229\000\000\r\225\000\000\006\229\000\000\000\000\r\225\000\000\000\000\r\225\000\000\019*\003\233\006\229\006\229\025Z\000\000\006\229\006\229\r\225\000\000\000\000\000\000\r\225\000\000\r\225\000\000\000\000\006\229\000\000\000\000\005\201\000\000\000\000\000\000\006\229\000\000\r\225\000\000\000\000\000\000\000\000\000\000\r\225\000\000\000\000\006\229\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0079\000\000\000\000\r\225\000\000\000\000\003\022\002\198\r\225\r\225\002\146\000\000\000\000\000\000\000\000\002\254\000\000\000\000\000\000\000\000\0079\000\000\000\000\000\000\r\225\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003\026\000\000\000\000\000\000\000\000\000\000\r\225\r\225\002\138\000\000\r\225\r\225\000\000\003&\000\000\000\000\000\000\000\000\000\000\0032\001\190\r\225\000\000\000\000\000\000\030F\002\186\000\000\r\225\004\014\000\000\000\000\000\000\004\018\000\000\004\026\005\170\000\000\005\182\r\225\000\000\000\000\000\000\007\241\007\194\000\000\000\000\000\000\007\241\000\000\005\186\007\241\000\000\000\000\000\000\000\000\000\000\000\000\005\194\005\198\000\000\007\241\000\000\000\000\000\000\007\241\001\189\007\241\000\000\000\000\000\000\001\189\000\000\000\000\001\189\000\000\000\000\000\000\000\000\007\241\000\000\000\000\000\000\005\202\001\189\007\241\bB\000\000\001\189\004\138\001\189\000\000\000\000\000\000\000\000\000\000\000\000\007\241\000\000\000\000\007\241\000\000\001\189\000\000\000\000\007\241\007\241\000\238\001\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\225\001\189\007\241\000\000\001\189\r\225\007\241\000\000\r\225\001\189\001\189\000\000\000\000\000\000\000\000\000\000\007\241\007\241\r\225\000\000\007\241\007\241\r\225\006\233\r\225\001\189\000\000\000\000\006\233\001\189\005\201\006\233\000\000\000\000\000\000\000\000\r\225\000\000\007\241\001\189\001\189\006\233\r\225\001\189\001\189\006\233\000\000\006\233\000\000\000\000\000\000\000\000\000\000\000\000\001\189\000\000\000\000\r\225\000\000\006\233\000\000\001\189\r\225\r\225\000\000\006\233\0256\000\000\000\000\000\000\000\000\000\000\001\189\000\000\000\000\000\000\000\000\006\233\r\225\000\000\006\233\000\000\000\000\000\000\000\000\006\233\006\233\000\238\000\000\000\000\000\000\000\000\r\225\r\225\002\138\000\000\r\225\r\225\000\000\000\000\000\000\006\233\000\000\000\000\000\000\006\233\000\000\r\225\000\000\000\000\000\000\030~\000\000\000\000\r\225\006\233\006\233\000\000\000\000\006\233\006\233\r\153\000\000\002\198\r\153\r\225\031\246\000\000\000\000\000\000\006\233\031\250\000\000\000\000\r\153\000\000\000\000\006\233\000\000\005%\r\153\000\000\000\000\000\000\005%\000\000\000\000\005%\006\233\000\000\000\000\000\000\r\153\000\000\000\000\000\000\000\000\005%\r\153\000\000\000\000\005%\000\000\005%\000\000\000\000\000\000\001\002\001\190\000\000\r\153\000\000\000\000\r\153\000\000\005%\000\000\000\000\r\153\000\000\005%\005%\000\000\005%\000\000\000\000\031\254\000\000\000\000\000\000\b\158\000\000\000\000\005%\r\153\000\000\005%\005%\r\153\005%\000\000\005%\002\234\000\238\000\000\000\000\000\000 \002\r\153\r\153\000\000\005%\r\153\000\000\000\000\000\000\000\000\005%\005%\007\194\000\000\005%\000\000\005%\tU\tU\005%\000\000\tU\000\000\r\153\005%\005%\tU\000\000\005%\005%\005%\002\234\019r\005%\000\000\005%\tU\000\000\000\000\007\238\000\000\000\000\000\000\tU\000\000\000\000\005%\005%\000\000\000\000\000\000\000\000\000\000\005%\bB\000\000\tU\005%\000\000\000\000\005%\005%\tU\tU\005%\005%\000\000\000\000\005%\tU\000\000\bV\tU\005%\002\234\000\238\tU\000\000\tU\tU\000\000\tU\005%\000\000\000\000\000\000\000\000\000\000\000\000\005%\000\000\001U\000\000\tU\000\000\000\000\001U\000\000\000\000\001U\000\000\tU\tU\005%\005%\000\000\000\000\005%\005%\001U\000\000\001U\000\000\001U\000\000\001U\000\209\000\000\000\000\000\000\000\000\000\209\000\000\000\000\000\209\005%\tU\001U\000\000\000\000\000\000\000\000\tU\001U\000\209\000\000\005%\000\000\000\209\000\213\000\209\000\000\000\000\000\000\000\213\000\000\000\000\000\213\001U\000\000\000\000\000\000\000\209\001U\001U\000\238\000\000\000\213\000\209\000\000\000\000\000\213\000\000\000\213\000\000\000\000\000\000\000\000\000\000\001U\000\209\000\000\000\000\000\209\000\000\000\213\000\000\000\000\000\209\000\209\000\238\000\213\000\000\001U\001U\001U\000\000\001U\001U\000\000\000\000\000\000\000\000\000\213\000\209\000\000\000\213\000\000\000\209\000\000\000\000\000\213\000\213\000\238\000\000\001U\000\000\000\000\000\209\000\209\000\000\000\000\000\209\000\209\000\000\000\000\001U\000\213\000\000\000\000\000\000\000\213\000\000\001\202\002\142\000\000\000\000\002\146\000\000\000\000\000\209\000\213\000\213\000\000\000\000\000\213\000\213\000\000\000\000\000\000\000\000\000\209\001\210\001\250\001\230\002\150\000\000\000\000\000\000\000\000\000\000\000\000\001\242\000\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\213\000\000\000\000\000\000\002\154\002\162\000\000\001\202\001\206\002\174\000\000\002\186\0046\004B\007\237\000\000\000\000\000\000\025\014\007\237\025\018\000\000\007\237\000\000\000\000\000\000\001\210\001\250\000\000\000\000\000\000\000\000\007\237\000\000\000\000\004R\007\237\000\000\007\237\000\000\000\000\000\000\000\000\000\000\005\198\000\000\000\000\000\000\000\000\000\000\007\237\000\000\001\246\002\178\000\000\025\030\007\237\002\174\000\000\002\186\0046\004B\000\000\000\000\000\000\000\000\004N\000\000\007\237\000\000\000\000\007\237\025\"\006\221\000\000\000\000\007\237\007\237\006\221\000\000\000\000\006\221\000\000\004R\000\000\000\000\029\234\000\000\021b\000\000\000\000\006\221\007\237\000\000\000\000\006\221\007\237\006\221\000\000\000\000\000\000\000\000\000\000\029\214\000\000\000\000\007\237\007\237\020\182\006\221\007\237\007\237\000\000\000\000\000\000\006\221\0061\007\194\000\000\000\000\000\000\0061\000\000\000\000\0061\000\000\000\000\006\221\007\237\000\000\006\221\000\000\000\000\000\000\0061\006\221\006\221\000\000\0061\000\000\0061\000\000\000\000\001\202\002\142\000\000\000\000\002\146\000\000\000\000\000\000\006\221\0061\000\000\000\000\006\221\000\000\000\000\0061\bB\000\000\000\000\001\210\001\250\001\230\006\221\006\221\000\000\000\000\006\221\006\221\000\000\001\242\0061\000\000\000\000\000\000\000\000\0061\0061\000\238\000\000\000\000\000\000\000\000\000\000\000\000\006\221\002\154\002\162\000\000\001\202\001\206\002\174\0061\002\186\0046\004B\004\229\000\000\000\000\000\000\025\014\004\229\030*\000\000\004\229\000\000\0061\0061\001\210\001\250\0061\0061\000\000\000\000\004\229\000\000\000\000\004R\004\229\000\000\004\229\000\000\000\000\000\000\000\000\000\000\005\198\000\000\0061\000\000\000\000\000\000\004\229\000\000\001\246\002\178\000\000\0306\004\229\002\174\000\000\002\186\0046\004B\000\000\000\000\000\000\000\000\004N\000\000\004\229\000\000\000\000\004\229\025\"\n\170\000\000\000\000\004\229\000\000\000\000\001\202\001\206\000\000\000\000\004R\000\000\000\000\005\153\000\000\000\000\000\000\000\000\000\000\004\229\002\158\000\000\000\000\004\229\000\000\001\210\001\250\001\230\000\000\000\000\029\214\000\000\000\000\004\229\004\229\001\242\000\000\004\229\004\229\005\005\000\000\000\000\002\002\000\000\005\005\000\000\000\000\005\005\000\000\000\000\000\000\001\246\002\162\000\000\000\000\004\229\002\174\005\005\002\186\0046\004B\005\005\004\237\005\005\000\000\004N\028J\004\237\000\000\000\000\004\237\000\000\000\000\000\000\000\000\005\005\000\000\000\000\000\000\000\000\004\237\005\005\004R\000\000\004\237\005\029\004\237\000\000\000\000\000\000\005\029\000\000\000\000\005\029\000\000\000\000\005\005\000\000\004\237\000\000\000\000\005\005\000\000\005\029\004\237\000\000\000\000\005\029\000\000\005\029\000\000\000\000\018\186\000\000\000\000\000\000\000\000\005\005\000\000\004\237\000\000\005\029\000\000\000\000\004\237\000\000\000\000\005\029\000\000\000\000\000\000\005\005\005\005\000\000\000\000\005\005\005\005\000\000\000\000\000\000\004\237\000\000\005\029\000\000\n\182\000\000\000\000\005\029\000\000\000\000\001\202\001\206\000\000\005\005\004\237\004\237\000\000\000\000\004\237\004\237\000\000\000\000\000\000\005\029\0222\000\000\004\022\000\000\000\000\001\210\001\250\001\230\000\000\000\000\000\000\000\000\004\237\005\029\005\029\001\242\000\000\005\029\005\029\0059\000\000\000\000\000\000\024z\000\246\000\000\000\000\002\202\000\000\000\000\000\000\001\246\002\162\000\000\000\000\005\029\002\174\003r\002\186\0046\004B\0059\000\000\003v\b\181\004N\024\250\b\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\130\000\000\000\000\000\000\000\000\000\000\020\162\004R\b\181\b\181\000\000\b\181\b\181\000\000\000\000\000\000\000\000\000\000\028v\000\000\000\000\021\006\000\000\000\000\000\000\000\000\021\030\000\000\b\137\000\000\000\000\b\137\b\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021&\000\000\004\134\000\000\004\138\b\137\b\137\000\000\b\137\b\137\000\000\000\238\000\000\000\000\021:\021v\000\000\000\000\0059\0059\000\000\000\000\000\000\000\000\000\000\b\185\000\000\000\000\b\185\b\137\000\000\000\000\000\000\000\000\000\000\000\000\025\182\000\000\000\000\000\000\000\000\b\181\000\000\b\181\b\185\b\185\000\000\b\185\b\185\000\000\b\137\000\000\000\000\000\000\000\000\000\000\b\181\000\000\000\000\006J\b\181\000\000\000\000\000\000\b\181\000\000\b\181\000\000\b\185\000\000\b\181\b\165\000\000\000\000\b\165\000\000\000\000\001\202\001\206\000\000\b\137\000\000\b\137\000\000\000\000\000\000\000\000\000\000\000\000\000\238\b\165\b\165\000\000\b\165\b\165\b\137\001\210\001\250\006J\b\137\000\000\000\000\000\000\b\137\000\000\b\137\000\000\000\000\000\000\b\137\000\000\000\000\000\000\000\000\b\165\000\000\000\000\000\000\000\000\b\185\000\000\b\185\001\246\002\178\000\000\000\000\000\000\002\174\000\000\002\186\0046\004B\000\000\000\000\b\185\000\238\004N\006J\b\185\000\000\000\000\000\000\b\185\000\000\b\185\000\000\000\000\000\000\b\185\000\000\001\202\001\206\000\000\004R\000\000\000\000\005\157\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\165\000\000\b\165\000\000\001\210\001\250\001\230\000\000\029\214\000\000\000\000\000\000\000\000\000\000\001\242\006\146\000\000\022\214\006J\b\165\000\000\014\161\014\161\b\165\000\000\b\165\000\000\000\000\000\000\b\165\001\246\024.\000\000\023N\000\000\002\174\000\000\002\186\0046\004B\014\161\014\161\014\161\007\214\024>\000\000\000\000\000\000\000\000\000\000\014\161\000\000\000\000\000\000\000\000\000\000\000\000\001\202\001\206\026j\000\000\004R\000\000\000\000\000\000\000\000\014\161\014\161\000\000\000\000\000\000\014\161\000\000\014\161\014\161\014\161\001\210\001\214\001\230\000\000\014\161\000\000\000\000\000\000\000\000\000\000\001\242\000\000\000\000\000\000\000\000\000\000\000\000\001\202\001\206\026\202\000\000\014\161\000\000\000\000\000\000\000\000\001\246\002\162\001\202\001\206\000\000\002\174\000\000\002\186\0046\004B\001\210\001\214\001\230\000\000\004N\000\000\000\000\000\000\000\000\000\000\001\242\001\210\001\214\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004R\000\000\000\000\000\000\000\000\001\246\002\162\000\000\000\000\000\000\002\174\000\000\002\186\0046\004B\000\000\001\246\002\170\000\000\004N\000\000\002\174\000\000\002\186\0046\004B\000\000\000\000\000\000\000\000\004N\000\000\018\206\000\000\000\000\000\000\004R\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004R"))
   
   and lhs =
-    (8, "\014\r\012\011\n\t\b\007\006\005\004\003\002\001\000\231\231\230\230\229\228\228\227\227\227\227\227\227\227\227\227\227\226\226\225\224\223\223\223\223\223\223\223\223\222\222\222\222\222\222\222\222\221\221\221\220\220\219\218\218\218\217\217\216\216\216\216\216\216\215\215\215\215\215\215\215\215\214\214\214\214\214\214\214\214\213\213\213\213\212\211\210\210\210\210\209\209\209\209\208\208\208\207\207\207\207\206\205\205\205\204\204\203\203\202\202\202\201\201\201\201\201\201\201\201\201\200\200\199\199\198\198\197\196\195\194\193\193\192\192\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\190\190\189\188\188\188\188\187\187\187\187\186\186\185\185\185\185\185\185\184\183\182\182\181\181\180\180\179\178\178\177\176\176\175\174\173\173\173\172\172\171\170\170\170\170\170\170\169\169\169\169\169\169\169\169\168\168\167\167\167\167\167\167\166\166\165\165\165\164\164\163\163\163\163\162\162\161\161\160\160\159\159\158\158\157\157\156\156\155\155\154\154\153\153\152\152\152\151\151\151\151\150\150\149\149\148\148\147\147\147\147\147\146\146\146\146\145\145\145\144\144\144\144\144\144\144\143\143\143\143\143\143\143\142\142\141\141\140\140\140\140\140\140\139\139\138\138\137\137\136\136\135\135\135\134\133\133\133\133\132\132\132\131\131\131\131\131\131\131\131\131\131\130\130\129\129\128\128\128\128\128\128\128\128\128\128\128\128\128\127~}||{{{{{zyyxxwwwwwwwwwwwwwwvvuuttsssssssssssssssssssssssssssssssrrqqppoonnmmlllkkjjiihhggffffffffffffffffffedcba`_^]\\[ZZZZZZZZZZYYYXXXWWWWWVVVVVVVVVUUTTTTTSSRRQPOONNNNNMMLLKKKJJJJJJIIIHHGGFFEEDDCCBBBAA@@??>>==<<;;::::::998877777766655544433210000000000000000000/////.......-----------------------------------------------------------------,,++++++++++++++++++++++***************************************************))((''&&&&&&&&&&&&&&&&%%$$#######\"\"\"\"!!     \031\031\030\029\028\028\028\027\027\026\026\026\026\026\026\026\026\026\026\025\025\024\024\024\024\023\023\022\021\021\021\021\021\020\019\019\018\018\018\017\017\017\016\016\016\016\016\016\015\015")
+    (8, "\014\r\012\011\n\t\b\007\006\005\004\003\002\001\000\231\231\230\230\229\228\228\227\227\227\227\227\227\227\227\227\227\226\226\225\224\223\223\223\223\223\223\223\223\222\222\222\222\222\222\222\222\221\221\221\220\220\219\218\218\218\217\217\216\216\216\216\216\216\215\215\215\215\215\215\215\215\214\214\214\214\214\214\214\214\213\213\213\213\212\211\210\210\210\210\209\209\209\209\208\208\208\207\207\207\207\206\205\205\205\204\204\203\203\202\202\202\201\201\201\201\201\201\201\201\201\200\200\199\199\198\198\197\196\195\194\193\193\192\192\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\191\190\190\189\188\188\188\188\187\187\187\187\186\186\185\185\185\185\185\185\184\183\182\182\181\181\180\180\179\178\178\177\176\176\175\174\173\173\173\172\172\171\170\170\170\170\170\170\169\169\169\169\169\169\169\169\168\168\167\167\167\167\167\167\166\166\165\165\165\164\164\163\163\163\163\162\162\161\161\160\160\159\159\158\158\157\157\156\156\155\155\154\154\153\153\152\152\152\151\151\151\151\150\150\149\149\148\148\147\147\147\147\147\146\146\146\146\145\145\145\144\144\144\144\144\144\144\143\143\143\143\143\143\143\142\142\141\141\140\140\140\140\140\140\139\139\138\138\137\137\136\136\135\135\135\134\133\133\133\133\132\132\132\131\131\131\131\131\131\131\131\131\131\130\130\129\129\128\128\128\128\128\128\128\128\128\128\128\128\128\127~}||{{{{{zyyxxwwwwwwwwwwwwwwvvuuttsssssssssssssssssssssssssssssssrrqqppoonnmmlllkkjjiihhggffffffffffffffffffedcba`_^]\\[ZZZZZZZZZZZYYYXXXWWWWWVVVVVVVVVUUTTTTTSSRRQPOONNNNNMMLLKKKJJJJJJIIIHHGGFFEEDDCCBBBAA@@??>>==<<;;::::::998877777766655544433210000000000000000000/////.......-------------------------------------------------------------------,,++++++++++++++++++++++***************************************************))((''&&&&&&&&&&&&&&&&%%$$#######\"\"\"\"!!     \031\031\030\029\028\028\028\027\027\026\026\026\026\026\026\026\026\026\026\025\025\024\024\024\024\023\023\022\021\021\021\021\021\020\019\019\018\018\018\017\017\017\016\016\016\016\016\016\015\015")
   
   and goto =
-    ((16, "\001\164\001\141\000G\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\000\000\000\000\000\239\000\006\000)\001{\000\219\001X\000w\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000?\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\029\022\000\000\000\000\000\000\000v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022N\001p\000\000\001\244\000\145\001|\000\000\000\000\000\000\001\006Vj\002\016\0018\001\238\000\000\000\000\000\000\002(\000\000\000\000\000\222\000\000\000\000\000\000\000\000\003\154\000\000\002\130\000\000\000\000\000\000\000\000\000\000\000(\000\000\002\184\003\228\b\184\000\000\000\000\n6\022N\000\000\000\000\016N\000\000\017\210\000\0008&\001\246\003\006\000\000\000\000\002\192\001\182\004\194\005\150\003\002\003\228\004`\000\t\001\248\0008\003~\002L\r\174\000\000\007\200\003\212\002\150\004\bID\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\176\000\000\0042\002\220\005(\000\000\000\000\000\000\000\000\005(\000\000\000\000\002\244\001n\003\b\0064\007\160\000\000\000\000\000\000\004\166\004\174\003n\001\172\000\000\000\000\003b\003\1683\234\004\204\003\170\001\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\022\000\000\000\000\000\000\004\234\004R\014\002\004\210\007\200 d\000\0008r\001\184909\164\000\000\001\024\000\000\000\000\000\000\000\000\005\178I\014\005\200\000\000\011\004\005\228\000\000\0110\r\170\000\203\000\000\000\165\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\190\005\136\000\000\000\000\000\000I\004\000\000\nb\000\000\000\000\005\142I\156\018$\000\000Xr\000\000\000\000\000\000\000\000\000\000\000\000\003P\030\024\003P\000y\000\000\000\000\000\000\005n\000\000\000\000\000\000\000\000\005\228\000\000\000\000\003P\000\000\000\000\000\000\000\000\000\000\014\166\000\000\004\212\006p\000\000I\254\004\228V\012\000\000\000\000\000\000\000\000\005n\000\000\000\000\000\000\011\234\000\000\000\000\000\000\000\000\000\000\000\000\003\244\006~\000\000\000\000\000\000\005n\006\166J\152\006\000\004\238#\238\000\000\003l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000T\000\000\000\000\000\000\000\000\007\132J\168\000\000\000\000\006\128\006\nJ\230\000\000\000\000\000\000K \006zK\168\000\000\006z\000\000K\180\006z\000\000L \015\176\007T\007\196\000\000\000\000-\022\000\000\000\000\000\000\000\000\000\000\000\000\006z\000\000\000\000L<\000\000\006zK\238\000\000\005n\000\000\000\000L\136\000\000\006z\001\152\000\000\000\000\006z\006z\000\000\000\000\006z\000\000\000\0009\164\000\000\000\000\000\000\000\000\006z9\220\000\000\000\000\006z\000\000\001F\007\218\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\018\000\000\007p\000\000L\184\005n\000\000\000\000\000\000\000\000\007\140\bf\014V\007\190\007\212\007\226\006l\004t\006\162\002\028\b\132\000\000\000\000\005\178\007\016\000\000\007\232\006\208\002j\b:\011H\000\000\004,\003*\006\222\000\174\t\156\000\000\000\000V\148\000\000V\192\t@\000\000L\226\005nL\252\005n\000\000\002\026\000\239\000\000\011\134\004,\000\000\000\000\b\182\000\000\000\000\000\000\000\000\000\000\012\016\004,\0122\004,\000\000\000G\000\000\000\000\000\r\000\000\000\000\000\000\n<\000\000\000\000\000\000\004,\004,\000\000\000\000\004,\000\000\b:\005B\000\000\000\133\003b\000\000\000\133\000\000\000\000\r@\004,\000\000\000\000\000\000\000\000\000\000\000\000\000\133\015\130 n\n\000\t\2029f\006\210\000\000\t*\007L\015\140\t6\007V/\1449v\000\000\000\000\000\000\000\000\000\000\005\002\012\n\000\000\000\000\000\000\tL\007|\005\202\000\133\r\152\000\000\004,\000\000\000\000\000\000\001\184\000\000M&\005n\015\192\t~\007\152\016z\t\152\007\158\006\178:L\006z\016\174\t\154\007\178:>\n\142\000\000:\224\006zM\190\005n\n\148\000\000\000\000\000\000\000\000\015\176\nv\000\000\000\000E\210\000\000\000\000W\024\000\000\000\000\n\188\"\250\003P\000\000\016\184\n\016\007\196!f\000\000:\146\n$\b\b!p\000\000;h\000\000\000\000\nF\b\014Nh\006z\017x\nN\b\030J\026\000\000T\156\000\000\000\000\"\018\nR\bZ\"\n\000\000\"l;\184\nv\br\"\210\000\0001\234\000\000\000\000\011\200N\"\000\000\005nC^\000\000\005nN\162\005n\000\000\000\000\000\000\000\000\000\000Y\154\000\000\000\000\000\000\001\202\017\130\000\000\000\000\000\000\000\000<\012\n\130\b\158#\014\000\000Z6\000\000\000\000\000\000\000\000\000\000\nX\018B\000\000\000\000\nj<\020\n\166\b\162#v\000\000\nj<`\n\182\t6#\168\000\000\nj\000\000ZV\000\000<\180\n\192\tt$\016\000\000\nj\018v\0024\018\128\000\000\000\000=\026\n\194\t\130$J\000\000\nj=\158\n\196\t\150$\136\000\000\nj=\198\n\210\t\210%\018\000\000\nj>\134\n\224\t\218%H\000\000\nj>\154\n\232\t\220%\180\000\000\nj>\174\n\238\t\246%\232\000\000\nj?T\n\250\n\004&\028\000\000\nj?\168\011\000\n\006&N\000\000\nj?\188\011\030\n\016&\176\000\000\nj@\\\0110\n\"&\238\000\000\nj@h\011:\n&'T\000\000\nj@\144\011N\nL'\182\000\000\njAP\011V\nV'\232\000\000\njAd\011t\nX(P\000\000\njB\016\011z\n\128(Z\000\000\njB$\011\128\n\134(\140\000\000\njB8\011\134\n\166(\244\000\000\njB\134\011\146\n\172)`\000\000\njB\228\011\216\n\178)l\000\000\njC\012\012.\n\180*\006\000\000\nj\n\210*\018\019J\019\254\000\000C^\012\214\000\000N\186\005n\020\006\000\000\000\000\012d\000\000N\228\005n\020Z\000\000\000\000\020\208\000\000\000\000\004\198\000\000\000\000\021\014\000\000\000\000\000\000\000\000N\246\005n\021\216\000\000\012(\021\224\000\000O\230\000\000\006zPb\000\000\006zPn\000\000\006z\005\204\000\000\000\000\000\000\000\000\000\000P\166\006z\000\000\004\230\005\020\000\000\000\000\000\000\nj\022:\000\000\000\000\000\000\022\170\000\000\000\000\000\000\000\000\000\000*r\000\000\000\000\000\000\nj*z\000\000+\026\000\000\000\000\000\000+&\000\000\000\000\000\000\000\000Zf\000\000\000\000,\014\000\000\000\000\000\000C\204\012f\n\226+\158\000\000\nj,\022\000\000\000\000\000\000Dn\012\130\011 ,\182\000\000\nj-\002\000\000\000\000\000\000Dx\012\136\011@-\"\000\000\nj\002\208\022\222\000\000\000\000D\204\012\138\011L-\194\000\000\nj\023\158\000\000\000\000D\212\012\144\011p..\000\000\nj\023\210\000\000\000\000Et\012\154\011v.:\000\000\nj\000\000\000\000.\156\000\000\000\000E\128\012\156\011\154.\206\000\000\nj/<\000\000\000\000E\218\012\166\011\170/D\000\000\nj00\000\000\000\000Fz\012\210\011\1740P\000\000\nj\000\000F\134\012\216\011\1800\158\000\000\nj\000\000)\160\000\000\000\000\nj\000\000\000\000\000\0000\146\000\000\000\0000\252\000\000\000\000\012\222\000\000\000\000\024B\000\000\024\140\000\000\000\000\000\000\nj\000\000\000\000\024\192\000\000\024\202\000\000\000\000\000\000\000\000\000\000F\142\r\002\011\2241\202\000\000Gv\r\014\012\0001\254\000\000\nj\njG~\r4\012\00226\000\000\nj\000\000\012(\025\246\000\000\000\000\026J\000\000G\138\000\000\000\0009v\000\000\000\000\000\0002\164\000\000\000\000\000\000\000\0002\216\000\000\000\000\000\000\000\000\014\140\000\000\000\000\000\000.\240\000\000\000N\000\000\005\242\014.\000\000\003\132\000\000\000\000\000\000\000\000\000\000\000\000\005\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\144\012\n3\174\000\000\nj\000\000\014\188\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\022\b\176\000\133\026R\000\000\r\156\012 \0144\006\166\t\138\000\133\0202\000\000\004,\t\148\000\133\000\000\026\158\000\000\006\222\000\000\r\186\012$\006\000\000\000\000\000\000\000\000\000\000\000\r\228\002b\001(\000\000\000\000\000\000G\204\000\000Wv\000\000\012*\000\000\0120\000\000\000\000\000\000\000\000\002\n\000\000\000\000\000\000*>\003P\000\000\003P\012\182\000\000\005`\000\000*\208\003P\003P\000\000+r\003P\003P\012:\000\000\026\242\000\000\000\000\012B\014\198\000\0003\160\006\022\000\000\000\000\000\000\000\000\000\000\000\000\r\220\012`4R\000\000\nj\000\000\000\000\000\000\000\000\000\000\r\224\012f\t\204\000\133\000\000\021<\000\000\004,\000\000\015>\000\000\000\000\000\000\000\000\000\0004`\000\000\r\246\012l4n\000\000\000\000\000\000\022\146\000\000\004,\000\000\023&\000\000\004,\000\000\024\248\004,\000\000\nj\000\000\000\000\025\140\000\000\004,\000\000\025\224\000\000\004,\000\000\027\176\004,\000\000\000\133\000\000\012\170\t\226\002\b\000\000\014\014\014\016\012\190\014D\015J\027\206\004,\007v\000\000\012\200\015\030\015@\006\228\007\154\015\012\012\206\015F\007\232\b\152\015\024\000\000\000\000\b\168\t\014\000\000\003\234\003fP\222\006z\027\222\000\000\007\190\001D\014\200\012\218\n$\004\252\000\000\014\202\r\014\tl\000\0005\012\000\000P\168\005n\000\000\015v\015\128\000\000\tT\000\000\005n\014\230\r\026\007\254\015\006\000\223\000\000\000\000\000\000\000\000\r \t\206\000\000\r&\t\230\000\000\b|X\176\014\238\014\240\r*\004\152\n.\000\000\r<\005\234\nx\000\000\014\244\014\250\rH\0152\015J\031\182\004,\000\000\r\\\015\156\000\000\007\022\000\000\n\130\000\000\015\168\000\000  \006\234\015t\rr\015\210\000\000 x\007\018\015\176\000\000\000\000\003\194\002\212\000\000\n\168\000\000!6\004,\011P\000\000\004\b\000\000\000\000\015d\r\152$\022\007N\000\000\015f\r\154\bt\015\006\015n\015p\r\156\016\224\000\000\015\142\0014\000\000\000\000\000\000\000\000\001\254\r\158\015dQj\005n\000\000\002\020\r\164\016$\000\000\000\000\000\000\000\000\000\000\000\000Q\132\b\000\000\000\r\172\016\128\000\000\000\000\000\000\000\000\000\000\000\0005H\011l\000\000\r\184\003F\000\000\r\212\r\216\004\226\000\000\007l\030\134\000\000\000\230\000\000Q\234\005n\005n\000\000\000\000\b \000\000\007`\000\000\br\b \b \000\000\r\234!\188\005nR&\005n\011r\000\000\000\000\000\000\000\000\011\200\000\000\000\000\003,\000\000\bb\015\224\014\n\017\002\015\178\000\000\000\000\t\174\b\134\015\248\000\000\000\000\014P\017\026\015\192\000\000\000\000RN\000\000\021\142\000\000Rx\012x\005n\000\000S\022PB\000\000SN\000\000\000\000\000\000\b \000\000\000\000\012,\016\004\014R\017 \015\214\000\000\000\000S^\012\128\016 \000\000\000\000\000\000X\244\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\130\000\000\0160\014T\007J\000\000\017.\016\224\012\134\016<\000\000\000\000\016@\014X\b^\000\000\000\000\t\030\r\170\004\172\000\000\000\000\000\000\b\200\016\004\014^\000\000\016\b\b\200\000\000\016\234\012\156\016H\000\000\000\000\000\000\005n\003\176\006\200\005\012\000\000\000\000\000\000\000\000\016\012\014p\000\000\005\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005n\015\242\014~\017\\\016\002\000\000\b\216\000\221\014\134\015\212\000q\000\212\014\140\016\152\000\000\017R\028\000\000\000\000\000\028(\000\000\r\004\000\000\001\"\000\000\000\000\000\000\000\000\000\000\000\000T\000\005n\000\000\017T\028\\\000\000\000\000\028\204\000\000\000\161\014\142\016\248\000\000\000\0005z5\246\016\166\000\000TB\005n\029\192\000\000\000\000\029\226\000\000\000\000\rZ\000\000\001\192\000\000\000\000\000\000\000\000\000\000\000\0006\134\000\000\000\0006\"6\222\016\168\000\000TT\005n\0300\000\000\000\000\030\138\000\000\000\000\014\144\031\\\r\150\000\000\014\154\014\160\000\191\000\161\014\196\t\"\014\198\017\0027x\r\194\000\000\014\204\014\240\b\178\000\000\000\133G\242\000\000\002\246\000\000\014\242\004\230W\142\0014\015\212\002t\000\000@|)\160\000\000\005\252\000\000\000\000\005\252\000\000\000\000\005\252\b\232\000\000\002\142\005\252\017\0067\130\r\216\000\000\005\252\000\000\000\000T\214\000\000\000\000\000\000\005\252\000\000\000\000\r\232\000\000\003\174\t\232\014\002\000\000\014\246H:\014\018\000\000\000\000\000\000\000\000\014\020\000\000\000\000\004d\000\000\005\252U\002\000\000\004\022\005\252W\214\000\000\014P\016h\014\254\017\142\0164\000\000X@\014\178\016v\000\000\000\000\000\000\000T\007\190\000\000\000\000\000\000\000\000\000\000\000\000\nX\014\208\000\000\016\134\000\000\000\000\000\000\000\000\014\228Y \000\000\000\000\000\000\nX\000\000\000\000\000\000\000\000\0158Y\176\000\000\000\000\000\000\000\000\000\000\000\133\004,\000\000\000\000\006z\000\000U(\005n\000\000\005x\000\000\000\000\000\000\000\0008*\000\000\000\000\000\000\000\000\000\000\000\000\0170\006\b\t|\016\004\005\250\015\b\000\000\002,\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\012\006\024\015\n\000\000\b\006\017\146\017F\015H\000\000\000\000\017:\006\220\002\192\000\000\000\000\000\000\0150\000\000\0156\019\202\000\000\000\000\003P D\000\000\000\000\000\000\000\000\000\000X\180\000\000\000\000\b\212\007@\000\000\000\000U\184\005n\005nU\202\005n\006\162\000\000\000\000\000\000\005n\000\000\000\000\tf\017T\015\176\000\000\000\000\017H\003\170\000\028\000\000\000\000\000\000\000\000\b\234\017\146\t\244\017Z\015\186\000\000\000\000\017P\003\182\000z\000\000\000\000\000\000\000\000\004,\000\000\016\000\000\000\000\000\000\000\031\154\000\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\031\138\000\000\000\000\000\000\001\004\000w\000\000\000\000\000\000\000\000\000\000\002\006\000w\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\024\000\000\000\000\000\000H\160\000\000\005n\000\000\r`\000\000\000\000\000\000\003t\000\000\000\000\000\000\001\142\000\000\000\000\000\000\000\003\000\000\000\133\000\000\006\"\000\000\004,\000\000\004\154\000\000\000\000\000\000>>\006z\000\000\000\000\002\004\000\000\000\000\000\000\000\000\005\002\004r\016\136\000\023\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\025>\000\000\016\022\000\000\000\000\000\000\000\000\005F\007\"\000\r\002\216\000\000\000\000\016\024\0278\000\000\000\000\000\000\016$X\198\000\000\000\000\000\000\000\000"), (16, "\007\018\000;\002=\002>\001s\000\238\001\252\0007\000\242\000\243\000?\007\248\002>\001s\007\018\003\149\002\000\002\154\007\019\007\"\002\004\007\021\001\027\005Z\000\238\002\159\000\242\000\242\000\243\b\007\007\022\007#\b\b\0007\001\020\007\021\002*\007\168\002\185\000\238\001\027\001\030\000\242\000\243\007\022\0007\000\151\000@\007\018\000\160\002=\002>\001s\001\023\000\238\006\207\000m\000\242\000\243\001\027\007\023\002\005\007\018\006\155\007&\002\154\007\019\007\"\000\238\007\021\006\207\000\242\000\243\002\159\007\023\001\020\006\157\003\149\007\022\007#\007\019\001\027\001\030\007\021\000\131\006\207\002\185\005\026\006\209\001y\000\244\004h\007\022\006\248\007\220\003\149\005]\007\024\001\153\006\207\002\r\002\031\002\191\006\209\006\210\000\245\001\027\007\025\007\023\006\212\001\031\007\024\007&\007\000\002A\000\245\002\193\000\242\006\209\006\210\006\251\007\025\007\023\007\249\006\212\002\193\000\242\006x\006\235\002\016\007\221\007'\006\209\002,\006\210\001\027\000\242\000\151\006\253\006\212\000\156\b\n\003\149\006\228\000\245\007\024\007(\000\\\006\210\007G\002\191\0019\000\245\006\212\007\185\007\025\007\028\006\219\002+\007\024\007\027\007\030\002A\006\127\002\193\000\242\006\254\007\144\002\200\007\025\007\028\002\201\000\157\000\238\007 \007\030\000\242\001\006\002\194\007'\000\151\000`\007\018\000\156\002=\002>\001s\002\215\007 \001\153\002\196\000:\007!\007\026\007(\000q\001s\002-\007\145\002\154\007\019\007\"\000d\007\021\007\028\007\166\007!\002\159\007\027\007\030\004i\002\217\007\022\007#\007\158\005\167\002\200\0009\007\028\002\201\002\185\000\238\007 \007\030\000\242\001\006\002\194\001\173\001s\000=\007\018\007\186\002=\002>\001s\002\215\007 \001\153\002\196\000y\007!\006\162\007\023\001\201\001s\007\145\007&\002\154\007\019\007\174\001\020\007\021\001z\007E\007!\002\159\001\027\001\030\001\237\002\217\007\022\007#\006z\001t\002R\007\187\001v\001w\002\185\006\131\007\194\001\027\004\175\000\151\000\238\007\148\001\249\000\242\001\006\007\024\007\236\002>\001s\007\192\002\191\002\031\001\007\000\136\000\238\007\025\007\023\000\242\000\243\0007\0007\007\216\002A\000\238\002\193\000\242\000\242\001\006\000\151\006\166\000\161\001\249\004J\003\143\003\144\001\196\007\195\001\n\000\139\007'\0074\001\232\002\031\002,\007\162\006\207\000\242\004\186\004\188\004\190\0007\002\000\005\211\007\024\007(\002\004\000\245\001\027\002\191\007\217\001\n\001#\000\242\007\025\007\028\007\196\002\029\003\149\001\141\007\030\002A\005\025\002\193\000\242\002,\007\238\002\200\000\242\006\209\002\201\001|\000\245\007 \000\242\007\197\003\149\002\194\007'\002*\003\162\000\128\004\191\000\242\001\006\006\210\002\215\002\005\001\153\002\196\006\212\007!\000\181\007(\006\216\007\140\001\230\000\245\002-\004M\004R\007\018\004\175\007\028\007)\002\006\007\176\001\020\007\030\007\239\002\217\002\193\000\242\001\027\001\030\002\200\b\007\003\179\002\201\b\b\002\011\007 \007\021\000\242\007\018\002\194\002=\002>\001s\002-\005\030\007\022\007H\005\232\002\215\001\143\001\153\002\196\002\017\007!\001(\002\154\007\019\007\"\001\144\007\021\001\153\001z\007Q\002\159\003\149\004\189\004\188\004\190\007\022\007#\007\193\001)\002\217\005\235\000\245\007\023\002\185\001\027\001/\000\238\000\130\000\191\000\242\000\243\005\215\001:\007\018\002\022\002=\002>\001s\005\237\000\238\007R\000\138\000\242\000\243\005\216\007\023\001n\002\018\005\240\007f\002\154\007\019\007\"\007S\007\021\000\176\000\188\006\207\002\159\007\024\005\238\001\020\002+\007\022\007#\000\196\000\155\001\027\001/\007\025\006\207\002\185\003\241\002\022\005\142\000\242\001\006\000\242\0011\000\154\004m\0012\007\024\007e\0013\0014\002\225\002\191\004\194\b\t\006\209\000\238\007\025\007\023\000\242\000\243\000\245\007+\001\020\002A\000\209\002\193\000\242\006\209\001\027\001/\006\210\000\185\007\027\004\014\004\195\006\212\000\218\002\031\007R\006\213\007'\007\212\007\028\006\210\007\143\0007\000\220\007\030\006\212\006C\007\157\007S\006\223\000\180\007\024\007(\001\020\000\245\005\239\002\191\007 \001\020\001\027\001\030\007\025\007\028\002#\001\027\001/\002,\007\030\002A\000\242\002\193\000\242\001\020\001b\002\200\007!\007\213\002\201\001\027\001/\007 \005\235\001\027\000\238\002\194\007'\000\242\001\006\007\018\000\245\002=\002>\001s\002\215\000\228\001\153\002\196\006\202\007!\005\237\007(\000\245\007\251\007\252\000\238\002\154\007\254\000\242\000\243\007\021\007\028\000\245\005\146\002\159\003\149\007\030\005\215\002\217\007\022\b\000\004i\005\238\002\200\000\233\000\236\002\201\002\185\001e\007 \005\216\002-\000\186\002\194\005\223\000\151\006\207\007\\\001\249\002=\002>\001s\002\215\003t\001\153\002\196\000\190\007!\005\150\007\023\001r\001s\007\146\007\147\002\154\006J\006K\000\238\007\146\007\147\000\242\000\243\002\159\000\245\004u\001s\002\217\005\148\004\242\006\209\001t\002s\002\031\001v\001w\002\185\006[\006T\004\211\000\246\006T\004\211\007\228\006T\004\211\006\210\007\024\005v\006\207\000\195\006\212\002\191\000\245\000\245\006\241\007\018\007\025\002=\002>\001s\b\015\002.\005\148\002A\002,\002\193\000\242\000\242\003\149\000\251\b\007\006\255\002\154\b\b\007\229\003u\007\021\b\003\001#\003\149\002\159\006\209\004\175\005i\002\000\007\022\b\016\0059\002\004\001\027\001\027\003\149\000m\002\185\007=\007(\000\208\006\210\006\251\002\191\002*\000\151\006\212\000\183\001\249\007\028\007\004\000\245\004\191\001{\007\030\002A\007\200\002\193\000\242\007\023\006\253\002\200\001\255\005\206\002\201\001|\000\242\007 \000\242\003\141\001s\002\194\002-\002\005\004\175\006<\004\188\004\190\001U\002\031\002\215\000\245\001\153\002\196\003\151\007!\001S\002\197\006\254\001\232\005Z\001k\0075\000\242\000\212\005D\007\024\003t\005\027\002\000\006\205\002\191\000\227\002\004\002\217\001\027\007\025\003\150\002 \002\200\001(\002,\002\201\002A\000\242\002\193\000\242\000\235\007\018\002\194\002=\002>\001s\006P\004\188\004\190\b\020\001)\002\215\001\143\001\153\002\196\000\250\001\027\001/\002\154\007\019\0071\001\152\007\021\001\153\001z\001g\002\159\002\005\007(\000\245\002\031\007\022\007#\007P\006\218\002\217\007>\000\245\007\028\002\185\001\014\001\232\000\245\007\030\002\027\002\006\007\201\003\149\001\153\002+\002\200\002\000\004j\002\201\001\017\002\004\007 \001\027\002-\002J\002\194\007\023\002,\006\251\006\238\000\242\007\224\001r\001s\002\215\0011\001\153\002\196\0012\007!\001\"\0013\0014\004\175\005m\004\199\006\253\002=\002>\001s\001\027\005Z\001t\001\132\000\242\001v\001w\000\151\002\217\001\236\001\249\002\005\001\232\007\024\001C\007\225\005Z\004\202\002\191\000\242\004f\001>\002\000\007\025\006\254\0045\002\004\004n\001\027\002\006\002A\001\131\002\193\000\242\004\217\007\018\001B\002=\002>\001s\001O\002-\006X\004\188\004\190\006C\001\133\007'\001\134\002]\b\007\004{\002\154\b\b\007d\001d\007\021\007T\007U\001\191\002\159\000\151\007(\006-\001\249\007\022\b\011\002\005\003\149\001j\007V\007W\007\028\002\185\007N\004\175\001\153\007\030\004\171\004\211\001\218\001\141\007X\004\211\002\200\002\006\004\158\002\201\003\149\007Z\007 \001\153\006\214\001|\002\194\007\023\000\242\002@\007\018\000\245\002=\002>\001s\002\215\002\135\001\153\002\196\001\220\007!\004r\001\189\002\193\000\242\001\006\004\162\002\154\007\019\005,\003\149\007\021\002=\002>\001s\002\159\007\130\004\188\004\190\002\217\007\022\007-\001\229\001\232\007\024\001\130\002\024\0007\002\185\002\191\003\149\004\161\005\130\002\000\007\025\004\232\005|\002\004\004i\001\027\000\245\002A\001\027\002\193\000\242\006J\006K\001\140\003\149\001\143\007\023\007a\005\136\001\149\b\014\007T\007U\001\020\001\144\004\161\001\153\001z\004\161\001\027\001\030\002\194\006S\000\245\007V\007W\006T\004\211\005\220\007(\002\195\000\242\001\153\002\196\002\005\001\020\007X\004\211\005\155\007\028\0028\001\027\001\030\007\024\007\030\002;\000\245\000\151\002\191\0067\001\249\002\200\002\006\007\025\002\201\003\149\006\031\007 \005'\001\255\002A\002\194\002\193\000\242\002I\001\148\001#\001\195\002@\001$\002\215\003\149\001\153\002\196\001\207\007!\005-\0070\002X\001\255\002A\002[\002\193\000\242\006 \006a\006!\001\232\001\212\007z\002\023\002a\007(\001&\002\217\0051\001#\002\000\005\215\001$\002~\002\004\007\028\001\027\003\149\001r\001s\007\030\000\245\001\255\007{\005\216\001\020\000\245\002\200\005\217\006\"\002\201\001\027\001/\007 \007\154\003\149\001&\002\194\001t\002s\005\188\001v\001w\004\219\003\149\000\245\002\215\002\131\001\153\002\196\002\138\007!\001,\004\212\006C\002\005\005\224\002\194\002\143\000\245\001#\004\161\000\245\001$\004\142\006#\002\195\001(\001\153\002\196\002\217\001\217\000\245\002\006\0007\006$\006%\002\031\006&\001\020\005?\000\245\001,\001\223\001)\001\027\001\030\001&\002\151\005\241\001\027\001/\005H\001s\005W\004\211\001#\001(\007\135\001$\002\157\006b\002\021\003\149\0056\006C\004\144\005\249\001\242\002,\006\197\001>\000\242\000\242\001)\000\245\0052\001{\000\245\001\244\001\027\001/\002\189\001&\002\205\006(\000\245\005\218\001\020\001|\006*\0064\000\242\001,\001\027\001/\001;\006\221\003\149\001\020\000\242\006C\005\215\006^\0011\001\027\001/\0012\001(\006F\0013\0014\006c\005\159\004\211\005\216\000\245\004\161\002\003\005\222\005\218\006_\006J\006K\007\005\001)\001;\001#\000\245\001,\001$\001\027\001/\002-\0011\0057\0015\0012\005\218\001?\0013\0014\006L\006\\\001(\007\137\002\031\006T\004\211\002\020\000\245\002\031\000\245\001\143\001&\006@\004\211\004\135\002\211\003\149\001#\001)\001\152\001$\001\153\001z\0015\001\027\001/\001?\005R\003\149\006C\006J\006K\004\152\007\007\001;\002,\002\031\004\157\000\242\001#\002,\004\131\0011\000\242\001&\0012\002\220\002\031\0013\0014\006L\006\\\0027\002\231\001\020\006T\004\211\001,\002:\006\242\001\027\001\030\006C\002\237\003\149\004\236\006J\006K\002,\002H\001;\000\242\001(\007\151\0015\006\189\005\029\001?\0011\002,\002\031\0012\000\242\000\245\0013\0014\006L\006\\\005_\001)\001,\006T\004\211\002\243\002W\001\027\001/\002\249\002\255\002-\005b\003\149\007L\004\211\002-\001(\003\149\002Z\002`\005C\0015\003\005\002,\001?\000\245\000\242\002l\005\215\003\011\003\017\001#\000\245\001)\001$\003\023\003\149\001F\001(\001\027\001/\005\216\000\245\002-\003\029\005\248\003#\005j\006J\006K\002i\002o\001;\001#\002-\001)\001$\001G\001&\001F\0011\001\027\001/\0012\001_\003)\0013\0014\006L\006\\\003/\0035\000\245\006T\004\211\002z\000\245\000\245\002}\001G\001&\006J\006K\006\214\005n\001;\001]\002-\002\130\005}\000\245\003;\0015\0011\003A\001?\0012\000\245\000\245\0013\0014\007\133\007\134\000\245\001,\002\137\006T\004\211\005\143\002\142\003G\002\150\000\245\003M\000\245\0011\003S\003Y\0012\001(\003\149\0013\0014\001L\001#\0015\001,\001$\001?\002\156\001F\002\171\003]\000\245\003\149\002\188\001)\003\149\000\245\000\245\003\190\001(\001\027\001/\003\152\001L\001#\001D\002\214\001$\001G\001&\001F\002\204\002=\002>\001s\001H\001)\000\245\001\232\002\210\000\245\001\233\001\027\001/\002\219\002\230\002\236\002\154\002\000\003\200\001G\001&\002\004\002\242\001\027\002\159\000\245\001[\003\149\000\245\002\248\004T\000\245\000\245\002\254\003\210\001;\003\004\002\185\001\232\005\147\003\220\001\254\003\n\0011\001,\003\016\0012\000\245\002\000\0013\0014\001V\002\004\005\199\001\027\000\245\005\231\001;\003\229\001(\003\022\003\238\002\005\001L\001#\0011\001,\001$\0012\003\028\001W\0013\0014\001V\003\"\0015\001)\003\149\001?\003\249\002\006\001(\001\027\001/\003(\001L\000\245\004\002\003.\004\011\001Y\001&\004\018\002\005\000m\001#\005\209\0015\001)\005\236\001?\002\191\000\245\0034\001\027\001/\003:\001\232\000\245\003@\002\b\002\006\003F\002A\004:\002\193\000\242\002\000\003L\003\149\003\149\002\004\003\149\001\027\001\232\004\191\000\245\002\n\001;\000\245\004?\004F\004\197\003\149\002\000\004\128\0011\001,\002\004\0012\001\027\004\143\0013\0014\001V\002\197\004\149\000\245\004\165\006\020\001;\004\182\001(\003R\004\184\000\245\001L\000\245\0011\004\208\000\245\0012\002\005\004\213\0013\0014\001V\002\200\0015\001)\002\201\001?\002=\002>\001s\001\027\001/\002\194\004\225\002\005\002\006\004\235\000\245\001(\004\252\003\149\002\215\002\154\001\153\002\196\0015\006\028\006)\001?\0061\002\159\003X\002\006\000\245\000\245\001)\007\208\003c\000\245\003j\006H\001\027\001/\002\185\000\245\002\217\002=\002>\001s\000\245\005\028\000\245\001#\003\142\000\245\001$\001;\000\245\001W\003\189\005\"\002\154\000\245\003\149\0011\005)\000\245\0012\005/\002\159\0013\0014\006\007\003\199\005B\007A\003\209\003\219\001Y\001&\003\228\000\245\002\185\007\210\000\245\003\237\003\248\000\245\002=\002>\001s\004\001\006y\003\149\001\232\0011\0015\002'\0012\001?\005G\0013\0014\002\154\002\000\004\203\005V\002\191\002\004\005^\001\027\002\159\005a\004\n\005h\003\149\004\017\004\247\000\245\002A\004&\002\193\000\242\005l\002\185\001,\003\149\004\206\000\245\005r\002=\002>\001s\000\245\003\149\006\156\000\245\0049\001\232\005x\001(\002M\000\245\004>\001L\002\154\002\191\003\149\002\000\002\005\005\132\002\197\002\004\002\159\001\027\003\149\003\149\001)\002A\004\218\002\193\000\242\004E\001\027\001/\006\182\002\185\002\006\000\245\005\153\005\158\005\163\005\173\002\200\000\245\005\179\002\201\000\245\001#\005\190\000\245\001$\000\245\002\194\001F\005\201\003\149\006\193\002\191\004b\002\197\000\245\002\215\002\005\001\153\002\196\004k\000\245\006\227\005\219\002A\005\205\002\193\000\242\001K\001&\006\239\000\245\004\127\001;\005\226\002\006\002\200\004\133\004\148\002\201\002\217\0011\000\245\006\243\0012\004\150\002\194\0013\0014\001V\005\243\006\247\006\252\004\164\002\191\002\215\002\197\001\153\002\196\003\149\004\207\000\245\000\245\000\245\000\245\004\215\002A\000\245\002\193\000\242\004\224\000\245\004\234\0015\003\149\001,\001?\000\245\002\200\002\217\004\245\002\201\007\b\004\251\003\149\005\253\006\022\006,\002\194\0066\001(\000\245\006B\000\245\001L\005(\005!\002\215\002\197\001\153\002\196\006V\000\245\005#\002=\002>\001s\001)\006f\002=\002>\001s\006l\001\027\001/\006p\006\140\006\180\000\245\002\154\002\200\002\217\006\240\002\201\002\154\006\185\003\149\002\159\001r\001s\002\194\007\015\002\159\004\141\003\149\002=\002>\001s\004x\002\215\002\185\001\153\002\196\006\224\006\190\002\185\007\029\006\220\001t\001\132\002\154\001v\001w\000\245\000\245\000\245\007$\000\245\002\159\001;\000\245\005&\0055\002\217\004I\006\196\006\204\0011\006\245\000\245\0012\002\185\007\n\0013\0014\001V\000\245\007O\007[\005+\000\245\0054\0050\000\245\000\245\000\245\003\149\0053\005A\005F\000\245\003\149\001\133\000\245\001\134\001\157\005Q\007i\007.\0015\007k\005P\001?\005U\002\191\005`\007`\005k\005g\002\191\005w\000\245\000\245\005q\001#\000\245\002A\007t\002\193\000\242\000m\002A\005s\002\193\000\242\005\139\003\149\001\141\002=\002>\001s\005\127\005\138\000\245\000\245\002\191\000\245\003\149\003\149\001|\000\245\001&\000\242\002\154\003\149\000\245\000\245\002A\002\197\002\193\000\242\002\159\005\133\002\197\002=\002>\001s\0046\007\139\002=\002>\001s\005\137\007\153\002\185\000\245\005\152\005\157\000\245\002\154\002\200\005\252\005\162\002\201\002\154\002\200\005\165\002\159\002\201\002\197\002\194\005\169\002\159\004.\005\177\002\194\005\184\005\195\005\251\002\215\002\185\001\153\002\196\005\244\002\215\002\185\001\153\002\196\007\165\005\245\005\250\002\200\001(\001\143\002\201\005\254\005\255\006\030\006\023\b\001\b\012\002\194\001\144\002\217\001\153\001z\b\017\006\024\002\217\001)\002\215\006\029\001\153\002\196\0063\001\027\001/\006/\002\191\0060\0062\006]\006A\006E\006G\006I\006U\006e\006g\006h\002A\006m\002\193\000\242\002\217\006q\006u\006\135\006\142\006\146\006\170\006\191\006\215\006\225\002\191\002=\002>\001s\007\017\002\191\002=\002>\001s\007\011\007\012\007\016\002A\007\031\002\193\000\242\002\154\002A\002\197\002\193\000\242\002\154\007J\007^\002\159\0011\007_\007c\0012\002\159\004#\0013\0014\007\138\007\142\002\182\007\152\002\185\007\156\007\243\002\200\000\000\002\185\002\201\002\197\000\000\000\000\000\000\000\000\002\197\002\194\000\000\000\000\000\000\001#\000\000\000\000\0015\000\000\002\215\000\000\001\153\002\196\000\000\000\000\000\000\002\200\000\000\000\000\002\201\000\000\003w\000\000\000\000\002\201\004-\002\194\000\000\000\000\000\000\000\000\002\194\000\000\002\217\000\000\002\215\000\000\001\153\002\196\000\000\002\215\000\000\001\153\002\196\000\000\001#\000\000\000\000\001-\000\000\000\000\002\191\002=\002>\001s\000\000\002\191\000\000\000\000\002\217\000\000\000\000\000\000\002A\002\217\002\193\000\242\002\154\002A\000\000\002\193\000\242\001&\000\000\000\000\002\159\000\000\000\000\002=\002>\001s\002\199\000\000\002=\002>\001s\000\000\000\000\002\185\000\000\000\000\000\000\001(\002\154\000\000\002\197\000\000\000\000\002\154\000\000\002\197\002\159\000\000\000\000\000\000\000\000\002\159\002\227\000\000\001)\000\000\000\000\002\226\000\000\002\185\001\027\001/\002\200\007r\002\185\002\201\000\000\002\200\000\000\000\000\002\201\000\000\002\194\000\000\000\000\000\000\000\000\002\194\001(\000\000\000\000\002\215\000\000\001\153\002\196\000\000\002\215\000\000\001\153\002\196\000\000\000\000\000\000\000\000\000\000\001)\000\000\002\191\000\000\000\000\000\000\001\027\001/\000\000\000\000\002\217\000\000\000\000\000\000\002A\002\217\002\193\000\242\000\000\0011\000\000\000\000\0012\000\000\000\000\0013\0014\000\000\002\191\000\000\000\000\000\000\000\000\002\191\000\000\001r\001s\000\000\000\000\000\000\002A\000\000\002\193\000\242\003o\002A\002\197\002\193\000\242\000\000\000\000\007n\003r\000\000\000\000\001t\002s\000\000\001v\001w\0011\000\000\000\000\0012\000\000\000\000\0013\0014\002\200\000\000\000\000\002\201\002\197\000\000\000\000\000\000\000\000\002\197\002\194\000\000\000\000\000\000\000\000\002t\000\000\000\000\000\000\002\215\000\000\001\153\002\196\000\000\0015\000\000\002\200\000\000\000\000\002\201\000\000\002\200\000\000\000\000\002\201\000\000\002\194\000\000\001#\000\000\000\000\002\194\000\000\002\217\000\000\002\215\000\000\001\153\002\196\000\000\002\215\000\000\001\153\002\196\000\000\000\000\002=\002>\001s\000\000\002=\002>\001s\000\000\000\000\000\000\001{\001r\001s\002\217\000\000\002\154\000\000\000\000\002\217\002\154\000\000\000\000\001|\002\159\000\000\000\242\000\000\002\159\004\222\003`\000\000\001t\002s\003g\001v\001w\002\185\000\000\000\000\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002u\000\000\002t\000\000\002\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\159\001(\000\000\000\000\000\000\000\000\003n\000\000\003s\003y\000\000\000\000\000\000\002\185\000\000\000\000\000\000\001\143\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\001\152\007m\001\153\001z\000\000\002\191\000\000\000\000\000\000\002\191\002=\002>\001s\000\000\000\000\001{\000\000\002A\000\000\002\193\000\242\002A\000\000\002\193\000\242\002\154\000\000\001|\000\000\000\000\000\242\000\000\000\000\002\159\001\232\000\000\000\000\004\155\000\000\003q\000\000\002=\002>\001s\002\000\000\000\002\185\000\000\002\004\002\197\001\027\002\191\0011\002\197\000\000\0012\002\154\000\000\0013\0014\000\000\000\000\002u\002A\002\159\002\193\000\242\000\000\000\000\000\000\000\000\002\200\000\000\000\000\002\201\002\200\000\000\002\185\002\201\000\000\000\000\002\194\003s\003y\007n\002\194\000\000\000\000\000\000\002\005\002\215\001\143\001\153\002\196\002\215\002\197\001\153\002\196\000\000\000\000\001\152\000\000\001\153\001z\000\000\000\000\000\000\002\006\000\000\000\000\002\191\000\000\000\000\001#\002\217\000\000\006\004\002\200\002\217\000\000\002\201\000\000\002A\000\000\002\193\000\242\000\000\002\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\215\000\000\001\153\002\196\001&\002\191\002=\002>\001s\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\002A\002\197\002\193\000\242\002\154\000\000\000\000\002\217\002\154\000\000\000\000\000\000\002\159\000\000\001\232\000\000\002\159\004\240\003~\000\000\000\000\000\000\003\129\002\200\002\000\002\185\002\201\000\000\002\004\002\185\001\027\000\000\002\197\002\194\000\000\000\000\000\000\000\000\002=\002>\001s\000\000\002\215\000\000\001\153\002\196\000\000\000\000\001(\000\000\000\000\000\000\000\000\002\154\003w\000\000\001#\002\201\003x\001$\000\000\002\159\000\000\000\000\002\194\001)\002\217\003\155\000\000\002\005\000\000\001\027\001/\002\215\002\185\001\153\002\196\000\000\000\000\000\000\000\000\000\000\000\000\001&\000\000\007w\000\000\002\006\000\000\002\191\000\000\000\000\000\000\002\191\002=\002>\001s\002\217\000\000\000\000\000\000\002A\000\000\002\193\000\242\002A\000\000\002\193\000\242\002\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\159\000\000\000\000\002=\002>\001s\003\159\000\000\0011\000\000\000\000\0012\001,\002\185\0013\0014\002\197\000\000\002\154\000\000\002\197\002\191\000\000\000\000\000\000\000\000\002\159\001(\000\000\000\000\000\000\000\000\003\215\002A\000\000\002\193\000\242\000\000\002\200\002\185\0015\002\201\002\200\000\000\001)\002\201\000\000\000\000\002\194\000\000\001\027\001/\002\194\000\000\000\000\000\000\000\000\002\215\000\000\001\153\002\196\002\215\000\000\001\153\002\196\002\197\000\000\000\000\001\232\000\000\000\000\005\002\000\000\000\000\000\000\000\000\000\000\002\191\002\000\000\000\000\000\002\217\002\004\000\000\001\027\002\217\000\000\002\200\000\000\002A\002\201\002\193\000\242\000\000\000\000\000\000\001;\002\194\000\000\002=\002>\001s\000\000\002\191\0011\000\000\002\215\0012\001\153\002\196\0013\0014\007~\000\000\002\154\002A\000\000\002\193\000\242\000\000\000\000\002\197\002\159\002\005\000\000\002=\002>\001s\003\224\000\000\002\217\000\000\000\000\000\000\000\000\002\185\0015\000\000\000\000\001?\002\154\002\006\001\232\002\200\000\000\005\006\002\201\002\197\002\159\000\000\000\000\000\000\002\000\002\194\003\233\000\000\002\004\000\000\001\027\000\000\000\000\002\185\002\215\000\000\001\153\002\196\000\000\000\000\000\000\002\200\000\000\000\000\002\201\000\000\000\000\000\000\000\000\000\000\000\000\002\194\000\000\002=\002>\001s\000\000\000\000\002\217\000\000\002\215\000\000\001\153\002\196\000\000\000\000\000\000\000\000\002\154\002\005\000\000\002\191\000\000\000\000\000\000\000\000\002\159\000\000\000\000\000\000\000\000\000\000\004'\002A\002\217\002\193\000\242\002\006\000\000\002\185\002=\002>\001s\000\000\000\000\000\000\000\000\002\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\154\000\000\000\000\000\000\002A\000\000\002\193\000\242\002\159\000\000\002\197\002=\002>\001s\004)\000\000\002=\002>\001s\000\000\000\000\002\185\000\000\000\000\000\000\000\000\002\154\000\000\000\000\000\000\000\000\002\154\002\200\000\000\002\159\002\201\002\197\000\000\000\000\002\159\0040\000\000\002\194\000\000\000\000\0043\000\000\002\185\002\191\000\000\000\000\002\215\002\185\001\153\002\196\000\000\000\000\000\000\002\200\000\000\002A\002\201\002\193\000\242\000\000\000\000\000\000\000\000\002\194\000\000\000\000\000\000\007\018\000\000\000\000\002\217\000\000\002\215\000\000\001\153\002\196\000\000\000\000\000\000\000\000\002\191\000\000\000\000\000\000\000\000\007\254\000\000\002\197\007\021\000\000\000\000\000\000\002A\000\000\002\193\000\242\002\217\007\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\191\000\000\000\000\002\200\000\000\002\191\002\201\000\000\000\000\000\000\000\000\000\000\002A\002\194\002\193\000\242\000\000\002A\002\197\002\193\000\242\007\023\002\215\000\000\001\153\002\196\000\000\000\000\000\000\000\000\000\000\001\232\000\000\000\000\005\t\000\000\000\000\000\000\000\000\000\000\002\200\002\000\000\000\002\201\002\197\002\004\002\217\001\027\000\000\002\197\002\194\000\000\000\000\000\000\000\000\002=\002>\001s\007\024\002\215\000\000\001\153\002\196\000\000\000\000\000\000\002\200\000\000\007\025\002\201\002\154\002\200\000\000\000\000\002\201\000\000\002\194\000\000\002\159\000\000\000\000\002\194\000\000\002\217\004L\002\215\002\005\001\153\002\196\007\255\002\215\002\185\001\153\002\196\000\000\000\000\000\000\002=\002>\001s\000\000\002=\002>\001s\002\006\001\232\000\000\007\027\005\016\002\217\000\000\000\000\002\154\000\000\002\217\002\000\002\154\007\028\000\000\002\004\002\159\001\027\007\030\000\000\002\159\000\000\004O\000\000\000\000\000\000\004\146\000\000\000\000\002\185\000\000\007 \000\000\002\185\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\001\232\000\000\000\000\005\020\000\000\000\000\007!\002\154\002\191\000\000\002\000\000\000\000\000\002\005\002\004\002\159\001\027\000\000\000\000\000\000\002A\004\160\002\193\000\242\000\000\000\000\000\000\000\000\002\185\000\000\000\000\002\006\000\000\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\154\002\191\000\000\002\197\000\000\002\191\002\005\000\000\002\159\000\000\000\000\000\000\000\000\002A\004\210\002\193\000\242\002A\007\018\002\193\000\242\002\185\000\000\000\000\002\006\002\200\000\000\000\000\002\201\000\000\000\000\000\000\000\000\b\007\000\000\002\194\b\b\000\000\000\000\007\021\000\000\000\000\000\000\002\191\002\215\002\197\001\153\002\196\007\022\002\197\000\000\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\200\002\217\000\000\002\201\002\200\000\000\000\000\002\201\000\000\000\000\002\194\007\023\000\000\000\000\002\194\000\000\000\000\000\000\002\191\002\215\002\197\001\153\002\196\002\215\000\000\001\153\002\196\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\002=\002>\001s\000\000\000\000\000\000\002\200\002\217\000\000\002\201\000\000\002\217\007\024\000\000\000\000\002\154\002\194\002=\002>\001s\000\000\000\000\007\025\002\159\000\000\002\215\002\197\001\153\002\196\005=\000\000\000\000\002\154\000\000\000\000\000\000\002\185\002=\002>\001s\002\159\000\000\b\r\000\000\000\000\000\000\006t\000\000\002\200\002\217\000\000\002\201\002\154\002\185\000\000\000\000\000\000\000\000\002\194\000\000\002\159\007\027\000\000\002=\002>\001s\006w\002\215\000\000\001\153\002\196\007\028\000\000\002\185\000\000\000\000\007\030\000\000\002\154\000\000\001\232\000\000\000\000\005\023\000\000\000\000\002\159\000\000\000\000\007 \002\000\002\217\006\134\000\000\002\004\001\232\001\027\000\000\005%\002\185\002\191\000\000\000\000\000\000\000\000\002\000\000\000\007!\000\000\002\004\000\000\001\027\002A\000\000\002\193\000\242\000\000\002\191\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\002\154\002\005\000\000\002\191\000\000\000\000\000\000\000\000\002\159\000\000\002\197\000\000\000\000\000\000\006\137\002A\002\005\002\193\000\242\002\006\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\197\000\000\002\191\001#\000\000\002\200\001$\002\006\002\201\000\000\000\000\000\000\000\000\000\000\002A\002\194\002\193\000\242\000\000\000\000\002\197\000\000\002\200\000\000\002\215\002\201\001\153\002\196\000\000\000\000\001&\000\000\002\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005J\002\215\002\200\001\153\002\196\002\201\002\197\000\000\002\217\000\000\000\000\000\000\002\194\000\000\000\000\000\000\007\164\000\000\002\191\000\000\000\000\002\215\000\000\001\153\002\196\002\217\000\000\000\000\002\200\000\000\002A\002\201\002\193\000\242\000\000\000\000\001,\000\000\002\194\000\000\002=\002>\001s\000\000\000\000\002\217\000\000\002\215\000\000\001\153\002\196\001(\000\000\000\000\000\000\002\154\000\000\002=\002>\001s\000\000\000\000\002\197\002\159\000\000\000\000\000\000\000\000\001)\006\150\000\000\002\217\002\154\000\000\001\027\001/\002\185\000\000\000\000\000\000\002\159\000\000\000\000\000\000\002\200\000\000\006\153\002\201\000\000\000\000\000\000\000\000\001#\002\185\002\194\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\002\215\000\000\001\153\002\196\000\000\000\000\000\000\000\000\002\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\159\001;\000\000\000\000\000\000\000\000\006\174\000\000\002\217\0011\000\000\000\000\0012\002\185\000\000\0013\0014\005S\000\000\000\000\000\000\002\191\002=\002>\001s\000\000\000\000\000\000\001#\000\000\000\000\001$\000\000\002A\000\000\002\193\000\242\002\154\002\191\000\000\000\000\0015\000\000\000\000\001?\002\159\000\000\000\000\000\000\000\000\002A\006\177\002\193\000\242\000\000\001&\000\000\000\000\002\185\000\000\005\209\001(\000\000\000\000\000\000\002\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\191\001)\000\000\000\000\000\000\002\197\000\000\001\027\001/\000\000\002\200\000\000\002A\002\201\002\193\000\242\000\000\000\000\000\000\000\000\002\194\000\000\000\000\000\000\001,\000\000\000\000\002\200\000\000\002\215\002\201\001\153\002\196\000\000\000\000\000\000\000\000\002\194\000\000\001(\000\000\000\000\000\000\000\000\002\197\002\191\002\215\000\000\001\153\002\196\002=\002>\001s\002\217\000\000\000\000\001)\002A\000\000\002\193\000\242\0011\001\027\001/\0012\002\154\002\200\0013\0014\002\201\002\217\006\031\000\000\002\159\000\000\000\000\002\194\000\000\000\000\006\181\000\000\002=\002>\001s\000\000\002\215\002\185\001\153\002\196\002\197\000\000\000\000\000\000\0017\000\000\000\000\002\154\000\000\000\000\006 \007\178\006!\000\000\000\000\002\159\000\000\000\000\000\000\001;\002\217\007\169\002\200\000\000\000\000\002\201\000\000\0011\002\185\000\000\0012\000\000\002\194\0013\0014\005\214\000\000\000\000\000\000\000\000\000\000\002\215\006\"\001\153\002\196\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0015\002\154\002\191\001?\000\000\000\000\002\217\000\000\000\000\002\159\000\000\000\000\000\000\000\000\002A\007\171\002\193\000\242\000\000\006#\000\000\000\000\002\185\000\000\000\000\000\000\001#\000\000\000\000\006$\006%\000\000\006&\002\191\002=\002>\001s\000\000\000\000\002=\002>\001s\000\000\000\000\000\000\002A\002\197\002\193\000\242\002\154\001\232\000\000\000\000\005u\002\154\006b\000\000\002\159\000\000\000\000\002\000\000\000\002\159\000\000\002\004\000\000\001\027\004\229\002\200\000\000\002\185\002\201\004\138\000\000\000\000\002\185\000\000\002\197\002\194\006(\007\180\000\000\000\000\000\000\006*\0064\002\191\002\215\000\000\001\153\002\196\000\000\000\000\000\000\000\000\000\000\000\000\006^\002A\002\200\002\193\000\242\002\201\001\232\000\000\002\005\005\129\000\000\000\000\002\194\000\000\002\217\000\000\002\000\001(\006_\000\000\002\004\002\215\001\027\001\153\002\196\000\000\002\006\000\000\000\000\000\000\000\000\000\000\000\000\002\197\001)\000\000\000\000\002\191\000\000\000\000\001\027\001/\002\191\007p\000\000\002\217\000\000\000\000\000\000\002A\001\232\002\193\000\242\005\135\002A\002\200\002\193\000\242\002\201\000\000\002\000\002\005\000\000\000\000\002\004\002\194\001\027\001r\001s\000\000\000\000\000\000\001r\001s\002\215\000\000\001\153\002\196\000\000\002\006\000\000\002\197\000\000\000\000\000\000\000\000\002\197\001t\001\132\000\000\001v\001w\001t\001\132\0011\001v\001w\0012\002\217\000\000\0013\0014\000\000\000\000\000\000\002\005\003\168\000\000\000\000\000\000\002\127\003\168\000\000\002\194\000\000\002\132\000\000\001#\002\194\000\000\001$\000\000\002\215\002\006\001\153\002\196\007n\002\215\000\000\001\153\002\196\001\133\000\000\001\134\002]\000\000\001\133\000\000\001\134\002]\000\000\000\000\000\000\000\000\001&\001\232\002\217\000\000\005\145\001r\001s\002\217\002=\002>\001s\002\000\000\000\000\000\000\000\002\004\000\000\001\027\000\000\000\000\000\000\000\000\001\141\002\154\000\000\001t\001\132\001\141\001v\001w\000\000\002\159\000\000\000\000\001|\000\000\000\000\000\242\000\000\001|\000\000\004\027\000\242\000\000\002\185\002\135\001,\000\000\002\152\000\000\002\135\000\000\000\000\002=\002>\001s\002\005\000\000\000\000\000\000\000\000\001(\000\000\000\000\000\000\000\000\000\000\000\000\002\154\001\133\000\000\001\134\002]\000\000\002\006\000\000\002\159\000\000\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\004\026\000\000\000\000\002\185\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\143\000\000\000\000\000\000\000\000\001\143\001\141\001r\001s\001\144\002\191\001\153\001z\000\000\001\144\000\000\001\153\001z\001|\000\000\000\000\000\242\002A\000\000\002\193\000\242\000\000\001t\001\132\002\135\001v\001w\001;\000\000\001#\000\000\000\000\001r\001s\000\000\0011\000\000\000\000\0012\000\000\000\000\0013\0014\005\227\000\000\002\158\005\230\000\000\000\000\002\197\002\191\000\000\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\001\133\0015\001\134\002]\001?\000\000\000\000\000\000\003\168\002\190\000\000\001\143\000\000\000\000\000\000\002\194\000\000\000\000\001r\001s\001\144\000\000\001\153\001z\002\215\000\000\001\153\002\196\002\197\000\000\001\133\000\000\001\134\002]\000\000\001\141\000\000\000\000\001t\001\132\000\000\001v\001w\001r\001s\000\000\000\000\001|\002\217\000\000\000\242\001(\000\000\003\168\000\000\000\000\000\000\000\000\002\135\000\000\002\194\002\206\000\000\001t\001\132\001\141\001v\001w\001)\002\215\000\000\001\153\002\196\000\000\001\027\001/\000\000\001|\001r\001s\000\242\000\000\001\133\000\000\001\134\002]\002\212\000\000\002\135\000\000\000\000\000\000\000\000\002\217\000\000\001r\001s\000\000\001t\001u\000\000\001v\001w\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002]\001\143\000\000\000\000\000\000\001t\001\132\001\141\001v\001w\001\144\000\000\001\153\001z\001r\001s\000\000\000\000\0011\001|\000\000\0012\000\242\000\000\0013\0014\000\000\000\000\002\221\000\000\002\135\001\143\001\141\000\000\001t\001\132\000\000\001v\001w\000\000\001\144\000\000\001\153\001z\001|\001r\001s\000\242\000\000\001\133\002y\001\134\002]\000\000\000\000\002\135\000\000\002\232\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001t\001\132\001{\001v\001w\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\133\001|\001\134\002]\000\242\001\143\001\141\000\000\000\000\000\000\002\238\000\000\001\232\000\000\001\144\005\154\001\153\001z\001|\000\000\000\000\000\242\002\000\000\000\000\000\000\000\002\004\000\000\001\027\002\135\001\143\001\133\000\000\001\134\002]\001\141\001r\001s\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\000\000\000\000\000\000\001t\001\132\002\135\001v\001w\000\000\000\000\001r\001s\001\143\001\141\002\005\000\000\000\000\000\000\000\000\000\000\000\000\001\152\000\000\001\153\001z\001|\002\244\000\000\000\242\001\143\001t\001\132\002\006\001v\001w\000\000\002\135\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002]\000\000\000\000\002\250\000\000\000\000\000\000\000\000\001\143\000\000\000\000\000\000\000\000\000\000\001r\001s\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\001\133\000\000\001\134\002]\000\000\000\000\000\000\000\000\001\141\000\000\001t\001\132\000\000\001v\001w\001\143\001r\001s\000\000\000\000\001|\000\000\000\000\000\242\001\144\000\000\001\153\001z\000\000\000\000\000\000\002\135\000\000\003\000\000\000\001\141\001t\001\132\000\000\001v\001w\000\000\001r\001s\000\000\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\000\000\001\133\000\000\001\134\002]\002\135\003\006\000\000\000\000\001t\001\132\000\000\001v\001w\001r\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002]\001\143\003\012\000\000\001t\001\132\001\141\001v\001w\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\000\000\001|\000\000\000\000\000\242\000\000\001\133\000\000\001\134\002]\003\018\001\143\002\135\000\000\000\000\001\141\001r\001s\000\000\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\001|\000\000\000\000\000\242\001\133\000\000\001\134\002]\000\000\001t\001\132\002\135\001v\001w\001\141\000\000\000\000\000\000\000\000\000\000\001r\001s\000\000\000\000\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\003\024\000\000\000\000\000\000\000\000\002\135\001\143\001\141\001t\001\132\000\000\001v\001w\000\000\000\000\001\144\000\000\001\153\001z\001|\000\000\001\133\000\242\001\134\002]\000\000\000\000\000\000\000\000\000\000\002\135\003\030\001\143\000\000\000\000\000\000\000\000\000\000\000\000\001r\001s\001\144\000\000\001\153\001z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002]\001\141\000\000\001\143\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\001\144\001|\001\153\001z\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\135\000\000\000\000\003$\001\143\000\000\000\000\000\000\001\141\001r\001s\000\000\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\001|\000\000\000\000\000\242\001\133\000\000\001\134\002]\000\000\001t\001\132\002\135\001v\001w\001r\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003*\001\143\001t\001\132\000\000\001v\001w\001\141\000\000\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\000\000\000\000\001|\000\000\001\133\000\242\001\134\002]\0030\000\000\000\000\000\000\000\000\002\135\000\000\001\143\000\000\001r\001s\000\000\000\000\000\000\001r\001s\001\144\000\000\001\153\001z\000\000\001\133\000\000\001\134\002]\000\000\000\000\000\000\000\000\001t\001\132\001\141\001v\001w\001t\001\132\000\000\001v\001w\001r\001s\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\000\000\000\000\000\000\0036\000\000\002\135\000\000\001\141\003<\001\143\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\001\144\001|\001\153\001z\000\242\000\000\001\133\000\000\001\134\002]\000\000\001\133\002\135\001\134\002]\003B\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001r\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002]\001\143\001\141\000\000\000\000\001t\001\132\001\141\001v\001w\001\144\000\000\001\153\001z\001|\000\000\000\000\000\242\000\000\001|\000\000\000\000\000\242\000\000\000\000\002\135\001\143\000\000\003H\000\000\002\135\000\000\001\141\000\000\000\000\001\144\000\000\001\153\001z\001r\001s\000\000\000\000\000\000\001|\001r\001s\000\242\000\000\001\133\000\000\001\134\002]\000\000\000\000\002\135\000\000\000\000\000\000\001t\001\132\000\000\001v\001w\000\000\001t\001\132\000\000\001v\001w\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\001\143\000\000\000\000\000\000\003N\001\143\001\141\000\000\000\000\001\144\003T\001\153\001z\000\000\001\144\004\021\001\153\001z\001|\000\000\000\000\000\242\000\000\000\000\000\000\001\133\000\000\001\134\002]\002\135\001\143\001\133\000\000\001\134\002]\000\000\000\000\000\000\000\000\001\144\000\000\001\153\001z\000\000\001r\001s\000\000\000\000\000\000\000\000\003^\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\141\000\000\000\000\000\000\001t\001\132\001\141\001v\001w\000\000\003z\001\132\001|\001v\001w\000\242\000\000\000\000\001|\001#\000\000\000\242\001\143\002\135\000\000\000\000\000\000\003Z\000\000\002\135\000\000\001\144\002@\001\153\001z\000\000\000\000\002=\002>\001s\000\000\002=\002>\001s\002A\000\000\002\193\000\242\001\133\000\000\001\134\002]\002\154\003\127\003\143\003\144\002\154\000\000\000\000\000\000\002\159\000\000\000\000\000\000\002\159\000\000\000\000\000\000\000\000\000\000\003\165\000\000\000\000\002\185\003\170\000\000\001\143\002\185\000\000\000\000\004\023\000\000\001\143\001\141\000\000\001\144\000\000\001\153\001z\001\141\000\000\001\144\001#\001\153\001z\001|\000\000\000\000\000\242\000\000\000\000\001|\000\000\000\000\000\242\000\000\002\135\001(\002\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\195\000\000\001\153\002\196\002=\002>\001s\001)\000\000\000\000\002=\002>\001s\001\027\001/\000\000\000\000\003\147\003\148\002\154\002\191\000\000\000\000\000\000\002\191\002\154\000\000\002\159\000\000\000\000\000\000\000\000\002A\002\159\002\193\000\242\002A\003\172\002\193\000\242\002\185\000\000\001\143\003\176\000\000\000\000\002\185\000\000\001\143\000\000\000\000\001\144\000\000\001\153\001z\000\000\001#\001\144\000\000\001\153\001z\000\000\000\000\001(\002\197\000\000\000\000\0011\002\197\000\000\0012\001r\001s\0013\0014\000\000\000\000\000\000\000\000\000\000\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\000\000\003\168\000\000\001t\001\132\003\168\001v\001w\002\194\000\000\000\000\004\193\002\194\000\000\000\000\000\000\002\191\002\215\000\000\001\153\002\196\002\215\002\191\001\153\002\196\000\000\003\191\000\000\002A\000\000\002\193\000\242\000\000\000\000\002A\000\000\002\193\000\242\002=\002>\001s\002\217\002=\002>\001s\002\217\000\000\001\133\000\000\001\134\002]\000\000\0011\002\154\000\000\0012\001(\002\154\0013\0014\002\197\002\159\000\000\000\000\000\000\002\159\002\197\000\000\000\000\000\000\000\000\003\184\000\000\001)\002\185\003\194\000\000\000\000\002\185\001\027\001/\000\000\001\141\000\000\004\201\003\168\000\000\000\000\000\000\000\000\000\000\003\168\002\194\000\000\001|\000\000\000\000\000\242\002\194\000\000\000\000\002\215\000\000\001\153\002\196\002\135\000\000\002\215\000\000\001\153\002\196\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001r\001s\002\217\000\000\000\000\000\000\000\000\000\000\002\217\000\000\0011\000\000\000\000\0012\000\000\002\191\0013\0014\000\000\002\191\001t\001\132\000\000\001v\001w\000\000\000\000\002A\000\000\002\193\000\242\002A\000\000\002\193\000\242\001\143\000\000\002=\002>\001s\000\000\000\000\004\205\003\201\001\144\000\000\001\153\001z\001r\001s\000\000\000\000\002\154\000\000\001r\001s\000\000\000\000\000\000\002\197\002\159\000\000\000\000\002\197\001\133\000\000\001\134\002]\001t\001\151\003\204\001v\001w\002\185\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\000\000\000\000\003\168\000\000\000\000\000\000\003\168\000\000\000\000\002\194\000\000\000\000\000\000\002\194\000\000\003\211\000\000\001\141\002\215\000\000\001\153\002\196\002\215\000\000\001\153\002\196\000\000\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\000\000\001\133\000\000\001\134\002]\002\135\000\000\002\217\000\000\000\000\000\000\002\217\000\000\000\000\000\000\000\000\000\000\001r\001s\000\000\002\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001{\000\000\002A\000\000\002\193\000\242\001\141\001t\001\132\000\000\001v\001w\001|\000\000\000\000\000\242\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\000\000\000\000\000\000\000\000\001\143\002\135\003\221\000\000\000\000\000\000\002\197\000\000\000\000\001\144\000\000\001\153\001z\001r\001s\000\000\000\000\000\000\000\000\001r\001s\000\000\000\000\001\133\000\000\001\134\002]\000\000\000\000\000\000\000\000\003\168\000\000\001t\001\132\000\000\001v\001w\002\194\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\002\215\001\143\001\153\002\196\000\000\000\000\000\000\001\143\000\000\003\230\001\152\001\141\001\153\001z\000\000\003\239\001\144\000\000\001\153\001z\002=\002>\001s\001|\002\217\000\000\000\242\000\000\000\000\000\000\001\133\000\000\001\134\002]\002\135\002\154\001\133\000\000\001\134\002]\000\000\000\000\000\000\002\159\000\000\000\000\001r\001s\000\000\000\000\000\000\000\000\000\000\003\244\000\000\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002=\002>\001s\001\141\001t\001\132\000\000\001v\001w\001\141\000\000\000\000\000\000\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\001|\000\000\004f\000\242\001\143\002\135\003\250\000\000\000\000\004n\000\000\002\135\000\000\001\144\000\000\001\153\001z\002=\002>\001s\000\000\000\000\001r\001s\000\000\000\000\000\000\001\133\000\000\001\134\002]\000\000\002\154\004o\000\000\000\000\000\000\002\191\000\000\000\000\002\159\000\000\001t\001\132\000\000\001v\001w\000\000\000\000\002A\003\253\002\193\000\242\002\185\000\000\000\000\000\000\000\000\001\143\002=\002>\001s\001\141\000\000\001\143\004\003\000\000\001\144\000\000\001\153\001z\000\000\000\000\001\144\001|\001\153\001z\000\242\000\000\002@\000\000\002\197\004v\000\000\000\000\002\135\001\133\000\000\001\134\002]\000\000\004r\000\000\002\193\000\242\001\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\168\000\000\000\000\000\000\000\000\000\000\000\000\002\194\000\000\000\000\000\000\002\191\000\000\000\000\000\000\001\141\002\215\000\000\001\153\002\196\000\000\000\000\004i\002A\000\000\002\193\000\242\001|\000\000\000\000\000\242\000\000\001\143\002=\002>\001s\000\000\000\000\002\135\000\000\002\217\001\144\000\000\001\153\001z\000\000\000\000\000\000\002\154\002\194\001r\001s\000\000\002@\000\000\002\197\002\159\000\000\002\195\000\000\001\153\002\196\000\000\000\000\000\000\002A\004\006\002\193\000\242\002\185\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\000\000\000\000\003\168\000\000\002=\002>\001s\000\000\000\000\002\194\000\000\001r\001s\001\143\000\000\004\012\000\000\000\000\002\215\002\154\001\153\002\196\001\144\000\000\001\153\001z\000\000\002\159\000\000\000\000\000\000\001t\001\132\000\000\001v\001w\001\133\004\030\001\134\002]\002\185\000\000\002\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\194\000\000\000\000\004\019\002\191\000\000\002=\002>\001s\002\195\000\000\001\153\002\196\000\000\000\000\000\000\002A\000\000\002\193\000\242\001\141\002\154\000\000\000\000\001\133\000\000\001\134\002]\000\000\002\159\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\000\000\004!\000\000\000\000\002\185\002\135\000\000\000\000\000\000\000\000\002\197\000\000\000\000\000\000\000\000\002\191\000\000\000\000\000\000\000\000\000\000\001\141\000\000\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\001|\000\000\003\168\000\242\000\000\000\000\000\000\000\000\000\000\002\194\000\000\002\135\000\000\000\000\000\000\000\000\000\000\000\000\002\215\000\000\001\153\002\196\000\000\000\000\000\000\001\143\002\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\144\002\191\001\153\001z\000\000\001r\001s\000\000\002\217\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\003\168\000\000\000\000\002=\002>\001s\000\000\002\194\001t\001\132\000\000\001v\001w\001\143\001r\001s\002\215\000\000\001\153\002\196\000\000\000\000\001\144\000\000\001\153\001z\004\021\000\000\002\197\000\000\000\000\004;\000\000\000\000\001t\001\132\000\000\001v\001w\000\000\002\217\000\000\001r\001s\000\000\000\000\000\000\000\000\000\000\000\000\004\022\000\000\001\133\003\168\001\134\002]\000\000\004@\000\000\000\000\002\194\000\000\001t\001\132\000\000\001v\001w\000\000\000\000\002\215\000\000\001\153\002\196\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\134\002]\000\000\000\000\000\000\004G\000\000\001\141\000\000\000\000\000\000\000\000\000\000\002\217\000\000\000\000\002=\002>\001s\001|\000\000\000\000\000\242\002@\000\000\000\000\001\133\000\000\001\134\002]\002\135\002\154\000\000\001\141\000\000\002A\000\000\002\193\000\242\002\159\000\000\000\000\002=\002>\001s\001|\000\000\000\000\000\242\004Y\000\000\000\000\002\185\000\000\000\000\000\000\002\135\002\154\000\000\000\000\000\000\001\141\000\000\000\000\000\000\002\159\000\000\000\000\000\000\000\000\000\000\004\024\000\000\001|\000\000\004^\000\242\000\000\002\185\000\000\000\000\000\000\000\000\001\143\002\135\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\002\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\195\001\143\001\153\002\196\000\000\000\000\000\000\000\000\002\191\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\000\000\000\000\001\143\000\000\000\000\000\000\000\000\002\191\003^\001s\000\000\001\144\000\000\001\153\001z\001r\001s\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\002\197\000\000\000\000\003z\001\132\000\000\001v\001w\000\000\000\000\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\000\000\002=\002>\001s\000\000\000\000\000\000\003\168\002\197\000\000\000\000\000\000\000\000\000\000\002\194\004\129\002\154\000\000\000\000\000\000\000\000\000\000\000\000\002\215\002\159\001\153\002\196\000\000\003\127\003\143\003\144\000\000\000\000\003\168\000\000\000\000\001\133\002\185\001\134\002]\002\194\000\000\000\000\000\000\000\000\000\000\000\000\002\217\000\000\002\215\000\000\001\153\002\196\000\000\001r\001s\000\000\000\000\000\000\000\000\000\000\001r\001s\000\000\001\141\000\000\000\000\000\000\001r\001s\000\000\001\141\000\000\002\217\001t\001\132\001|\001v\001w\000\242\000\000\001t\001\132\001|\001v\001w\000\242\000\000\001t\001\132\000\000\001v\001w\000\000\002\135\000\000\000\000\004\226\000\000\000\000\000\000\002\191\000\000\000\000\004\249\000\000\000\000\000\000\000\000\003\147\004\216\004\253\000\000\002A\000\000\002\193\000\242\000\000\001\133\000\000\001\134\002]\000\000\000\000\000\000\001\133\000\000\001\134\002]\000\000\000\000\000\000\001\133\000\000\001\134\002]\000\000\000\000\000\000\000\000\001\143\000\000\000\000\000\000\000\000\002\197\000\000\001\143\000\000\001\144\000\000\001\153\001z\001\141\001#\000\000\001\144\001$\001\153\001z\001\141\000\000\000\000\000\000\000\000\001|\000\000\001\141\000\242\000\000\005\011\000\000\001|\000\000\000\000\000\242\002\135\002\194\000\000\001|\000\000\001&\000\242\002\135\001#\000\000\002\215\001$\001\153\002\196\002\135\005J\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001r\001s\000\000\000\000\000\000\005M\000\000\000\000\002\217\001&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\154\000\000\005J\001t\002s\000\000\001v\001w\001,\000\000\001\143\000\000\000\000\000\000\000\000\000\000\000\000\001\143\005\198\001\144\000\000\001\153\001z\001(\001\143\000\000\001\144\000\000\001\153\001z\000\000\002t\000\000\001\144\000\000\001\153\001z\000\000\001,\000\000\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\000\000\000\000\000\000\000\000\001#\001(\000\000\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001r\001s\000\000\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\000\000\001&\000\000\000\000\001{\000\000\006\178\000\000\000\000\001t\002s\005J\001v\001w\001;\000\000\001|\000\000\000\000\000\242\000\000\000\000\0011\000\000\000\000\0012\000\000\006\151\0013\0014\005S\000\000\000\000\000\000\000\000\000\000\000\000\002t\000\000\000\000\000\000\000\000\000\000\000\000\001;\000\000\001#\001,\000\000\001$\000\000\002u\0011\000\000\0015\0012\000\000\001?\0013\0014\005S\000\000\001(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003s\003y\001&\000\000\000\000\000\000\000\000\000\000\001)\001\143\000\000\000\000\005J\0015\001\027\001/\001?\001{\001\152\001#\001\153\001z\001$\000\000\000\000\000\000\000\000\000\000\006\165\001|\000\000\000\000\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001&\000\000\001,\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005J\000\000\000\000\000\000\001;\000\000\000\000\001(\002u\000\000\000\000\000\000\0011\000\000\000\000\0012\006\175\000\000\0013\0014\005S\000\000\000\000\000\000\001)\000\000\000\000\000\000\003s\003y\001\027\001/\000\000\003^\001s\000\000\001,\001\143\003^\001s\000\000\000\000\000\000\000\000\0015\000\000\001\152\001?\001\153\001z\000\000\001(\000\000\003z\001\132\000\000\001v\001w\003z\001\132\000\000\001v\001w\000\000\000\000\000\000\000\000\000\000\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\001;\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0011\000\000\000\000\0012\000\000\000\000\0013\0014\005S\000\000\000\000\000\000\003\127\003\143\003\144\000\000\000\000\003\127\003\143\003\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0015\000\000\000\000\001?\001;\000\000\001r\001s\000\000\000\000\000\000\001#\0011\000\000\001$\0012\001\141\000\000\0013\0014\005S\001\141\000\000\000\000\000\000\000\000\001t\001\132\001|\001v\001w\000\242\000\000\001|\000\000\000\000\000\242\000\000\001&\000\000\000\000\002=\002>\001s\0015\000\000\000\000\001?\004\178\007D\000\000\000\000\000\000\000\000\000\000\000\000\002\154\000\000\000\000\000\000\000\000\003\147\006\192\007h\002\159\000\000\003\147\006\226\000\000\000\000\001\133\000\000\001\134\002]\000\000\000\000\000\000\002\185\000\000\000\000\000\000\000\000\000\000\000\000\001,\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\143\000\000\000\000\000\000\000\000\001\143\000\000\001(\000\000\001\144\000\000\001\153\001z\001\141\001\144\000\000\001\153\001z\000\000\000\000\000\000\000\000\000\000\000\000\001)\001|\000\000\000\000\000\242\000\000\001\027\001/\000\000\000\000\000\000\000\000\002\135\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001r\001s\000\000\000\000\002\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\001t\001\132\000\000\001v\001w\000\000\002=\002>\001s\000\000\001\198\001;\000\000\000\000\002=\002>\001s\000\000\000\000\0011\000\000\002\154\0012\000\000\001\143\0013\0014\000\000\002\197\002\159\000\000\000\000\000\000\001\144\000\000\001\153\001z\002?\001r\001s\000\000\000\000\002\185\000\000\001\133\000\000\001\134\001\186\000\000\000\000\000\000\0015\000\000\004\227\004\185\000\000\000\000\000\000\001t\001\132\002\194\001v\001w\000\000\000\000\000\000\001r\001s\001\183\002\215\000\000\001\153\002\196\000\000\000\000\000\000\000\000\000\000\000\000\001\141\000\000\000\000\000\000\000\000\000\000\000\000\001t\001\132\000\000\001v\001w\001|\000\000\002\217\000\242\000\000\001\188\000\000\000\000\000\000\000\000\000\000\001\133\000\000\001\134\001\186\002\191\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002@\001r\001s\000\000\002A\000\000\002\193\000\242\001r\001s\000\000\000\000\002A\000\000\002\193\000\242\001\133\000\000\001\134\001\186\000\000\001t\002s\001\141\001v\001w\000\000\000\000\001t\001\132\000\000\001v\001w\000\000\000\000\001|\002\197\000\000\000\242\000\000\000\000\001\143\002=\002>\001s\000\000\000\000\000\000\000\000\002t\001\144\001\141\001\153\001z\000\000\000\000\000\000\002\154\000\000\000\000\000\000\004\130\000\000\001|\000\000\002\159\000\242\000\000\002\194\000\000\000\000\000\000\001\133\000\000\001\134\002]\002\194\002\215\002\185\001\153\002\196\000\000\001r\001s\000\000\002\195\000\000\001\153\002\196\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\143\001{\002\217\001t\001\132\000\000\001v\001w\001\141\001\144\000\000\001\153\001z\001|\000\000\000\000\000\242\000\000\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\000\000\000\000\001\143\000\000\000\000\0044\000\000\000\000\000\000\000\000\000\000\001\144\000\000\001\153\001z\000\000\000\000\002\191\000\000\000\000\000\000\001\133\002u\001\134\002e\001r\001s\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002w\003y\000\000\001t\001\132\000\000\001v\001w\000\000\001\143\000\000\000\000\000\000\000\000\001\141\000\000\001\143\000\000\001\152\002\197\001\153\001z\002=\002>\001s\001\144\001|\001\153\001z\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\154\000\000\000\000\000\000\000\000\000\000\000\000\004,\002\159\000\000\001\133\000\000\001\134\002]\002\194\000\000\000\000\000\000\000\000\002h\000\000\002\185\000\000\002\215\000\000\001\153\002\196\002=\002>\001s\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\154\000\000\000\000\001\141\002\154\002\217\000\000\000\000\002\159\000\000\000\000\001\143\002\159\000\000\000\000\001|\000\000\000\000\000\242\000\000\001\144\002\185\001\153\001z\000\000\002\185\002\134\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\154\002\191\000\000\000\000\000\000\000\000\000\000\000\000\002\159\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\143\000\000\000\000\000\000\000\000\002\154\002\191\000\000\002\197\001\144\002\191\001\153\001z\002\159\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\002A\000\000\002\193\000\242\002\185\000\000\000\000\000\000\000\000\000\000\000\000\004\025\000\000\000\000\000\000\000\000\000\000\000\000\002\194\002=\002>\001s\000\000\000\000\000\000\000\000\002\191\002\215\002\197\001\153\002\196\000\000\002\197\000\000\002\154\000\000\000\000\000\000\002A\000\000\002\193\000\242\002\159\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\217\000\000\003\153\000\000\002\185\000\000\002\207\000\000\000\000\002\194\000\000\000\000\000\000\002\194\000\000\000\000\000\000\002\191\002\215\002\197\001\153\002\196\002\215\000\000\001\153\002\196\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\002\217\000\000\002\213\000\000\002\217\000\000\000\000\002\154\000\000\002\194\000\000\000\000\002=\002>\001s\002\159\000\000\000\000\002\215\002\197\001\153\002\196\000\000\000\000\000\000\000\000\002\191\002\154\002\185\000\000\000\000\000\000\000\000\000\000\000\000\002\159\000\000\000\000\002A\000\000\002\193\000\242\002\217\000\000\002\222\000\000\000\000\000\000\002\185\000\000\000\000\002\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\215\000\000\001\153\002\196\000\000\000\000\000\000\000\000\000\000\000\000\002\197\000\000\000\000\001r\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\191\001t\001\132\002\233\001v\001w\000\000\000\000\000\000\000\000\002\194\000\000\002A\000\000\002\193\000\242\002=\002>\001s\002\215\002\191\001\153\002\196\000\000\000\000\000\000\002=\002>\001s\000\000\000\000\002\154\002A\000\000\002\193\000\242\002=\002>\001s\002\159\000\000\002\154\000\000\002\217\002\197\001\133\000\000\001\134\007\232\002\159\007\234\002\154\002\185\000\000\000\000\000\000\000\000\000\000\000\000\002\159\000\000\000\000\002\185\000\000\002\197\000\000\000\000\000\000\000\000\002\239\000\000\000\000\002\185\000\000\000\000\000\000\002\194\000\000\000\000\000\000\001\141\000\000\000\000\000\000\000\000\002\215\000\000\001\153\002\196\002\245\000\000\000\000\001|\000\000\000\000\000\242\002\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\215\000\000\001\153\002\196\002\217\000\000\000\000\000\000\000\000\000\000\000\000\002\191\000\000\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\002\191\000\000\002A\002\217\002\193\000\242\000\000\000\000\002\154\000\000\002\191\000\000\002A\000\000\002\193\000\242\002\159\000\000\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\002\185\001\143\000\000\000\000\000\000\002\197\002=\002>\001s\000\000\001\144\000\000\001\153\001z\000\000\002\197\002=\002>\001s\000\000\000\000\002\154\000\000\000\000\000\000\002\197\000\000\000\000\000\000\002\159\002\251\002\154\000\000\000\000\000\000\000\000\000\000\002\194\000\000\002\159\003\001\000\000\002\185\000\000\000\000\000\000\002\215\002\194\001\153\002\196\003\007\000\000\002\185\000\000\000\000\000\000\002\215\002\194\001\153\002\196\000\000\000\000\000\000\000\000\002\191\000\000\002\215\000\000\001\153\002\196\002\217\000\000\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\002\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\217\000\000\000\000\000\000\000\000\000\000\002=\002>\001s\000\000\000\000\000\000\002=\002>\001s\000\000\002\191\000\000\002\197\000\000\000\000\002\154\002=\002>\001s\000\000\002\191\002\154\002A\002\159\002\193\000\242\002=\002>\001s\002\159\000\000\000\000\002A\000\000\002\193\000\242\002\185\003\r\000\000\004\021\000\000\002\154\002\185\000\000\002\194\000\000\000\000\000\000\000\000\002\159\000\000\000\000\000\000\002\215\002\197\001\153\002\196\000\000\000\000\000\000\000\000\000\000\002\185\006\211\002\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\217\000\000\003\019\000\000\000\000\000\000\000\000\000\000\000\000\002\194\000\000\000\000\003\025\000\000\000\000\000\000\000\000\000\000\002\215\002\194\001\153\002\196\000\000\002\191\000\000\000\000\000\000\000\000\002\215\002\191\001\153\002\196\000\000\000\000\000\000\002A\000\000\002\193\000\242\002@\000\000\002A\002\217\002\193\000\242\002=\002>\001s\000\000\002\191\000\000\002A\002\217\002\193\000\242\002=\002>\001s\000\000\000\000\002\154\002A\000\000\002\193\000\242\000\000\000\000\002\197\002\159\000\000\002\154\000\000\000\000\002\197\000\000\000\000\000\000\000\000\002\159\000\000\000\000\002\185\000\000\000\000\000\000\000\000\000\000\004\024\000\000\000\000\000\000\002\185\003\031\002\197\000\000\000\000\000\000\000\000\003%\002\194\000\000\000\000\000\000\000\000\000\000\002\194\000\000\000\000\002\215\000\000\001\153\002\196\000\000\000\000\002\215\002\194\001\153\002\196\003+\000\000\000\000\000\000\000\000\000\000\002\195\002\194\001\153\002\196\000\000\000\000\000\000\000\000\002\217\000\000\002\215\000\000\001\153\002\196\002\217\000\000\000\000\002=\002>\001s\000\000\002\191\000\000\000\000\000\000\000\000\000\000\002=\002>\001s\000\000\002\191\002\154\002A\002\217\002\193\000\242\002=\002>\001s\002\159\000\000\002\154\002A\000\000\002\193\000\242\000\000\000\000\000\000\002\159\000\000\002\154\002\185\000\000\000\000\000\000\000\000\000\000\000\000\002\159\000\000\000\000\002\185\000\000\002\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\185\000\000\002\197\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0031\002\154\000\000\000\000\000\000\000\000\000\000\002\194\000\000\002\159\0037\000\000\000\000\000\000\000\000\000\000\002\215\002\194\001\153\002\196\000\000\000\000\002\185\000\000\000\000\000\000\002\215\002\191\001\153\002\196\000\000\000\000\000\000\002=\002>\001s\000\000\002\191\000\000\002A\002\217\002\193\000\242\000\000\000\000\000\000\000\000\002\191\002\154\002A\002\217\002\193\000\242\002=\002>\001s\002\159\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\000\000\000\000\002\154\002\185\000\000\002\197\000\000\000\000\000\000\000\000\002\159\000\000\000\000\000\000\000\000\002\197\000\000\000\000\000\000\000\000\002\191\000\000\000\000\002\185\000\000\002\197\000\000\000\000\000\000\000\000\003=\000\000\002A\000\000\002\193\000\242\001#\002\194\000\000\001$\003C\000\000\000\000\000\000\000\000\000\000\002\215\002\194\001\153\002\196\003I\000\000\000\000\000\000\000\000\000\000\002\215\002\194\001\153\002\196\000\000\000\000\000\000\001&\002\197\000\000\002\215\002\191\001\153\002\196\002\217\000\000\000\000\003h\000\000\000\000\000\000\000\000\000\000\002A\002\217\002\193\000\242\002=\002>\001s\000\000\002\191\000\000\003O\002\217\000\000\000\000\000\000\000\000\000\000\002\194\000\000\002\154\002A\000\000\002\193\000\242\000\000\000\000\002\215\002\159\001\153\002\196\001,\000\000\002\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\185\000\000\000\000\000\000\000\000\001(\000\000\000\000\000\000\000\000\002\217\000\000\002\197\000\000\000\000\000\000\000\000\003U\000\000\000\000\000\000\000\000\001)\000\000\002\194\000\000\000\000\000\000\001\027\001/\000\000\000\000\000\000\002\215\000\000\001\153\002\196\003[\000\000\000\000\000\000\000\000\000\000\000\000\002\194\002=\002>\001s\000\000\000\000\002=\002>\001s\002\215\000\000\001\153\002\196\002\217\000\000\000\000\002\154\000\000\000\000\000\000\002\191\002\154\000\000\000\000\002\159\000\000\000\000\000\000\000\000\002\159\001;\000\000\002A\002\217\002\193\000\242\000\000\002\185\0011\000\000\000\000\0012\002\185\000\000\0013\0014\002\168\000\000\002=\002>\001s\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\154\002\197\000\000\000\000\002\154\000\000\000\000\0015\002\159\000\000\001?\000\000\002\159\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\185\000\000\000\000\000\000\002\185\003\192\000\000\000\000\000\000\000\000\000\000\000\000\002\194\000\000\000\000\000\000\000\000\002\191\000\000\000\000\000\000\002\215\002\191\001\153\002\196\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\217\000\000\000\000\002=\002>\001s\000\000\000\000\000\000\002=\002>\001s\000\000\000\000\000\000\000\000\002\197\000\000\002\154\002\191\000\000\002\197\000\000\002\191\002\154\000\000\002\159\000\000\000\000\000\000\000\000\002A\002\159\002\193\000\242\002A\000\000\002\193\000\242\002\185\000\000\003\202\000\000\000\000\000\000\002\185\003\212\000\000\002\194\000\000\000\000\001r\001s\002\194\002=\002>\001s\002\215\000\000\001\153\002\196\000\000\002\215\002\197\001\153\002\196\000\000\002\197\000\000\002\154\000\000\001t\002r\000\000\001v\001w\000\000\002\159\000\000\000\000\000\000\002\217\000\000\000\000\000\000\000\000\002\217\000\000\003\222\000\000\002\185\000\000\003\231\000\000\000\000\002\194\000\000\000\000\000\000\002\194\000\000\000\000\000\000\002\191\002\215\000\000\001\153\002\196\002\215\002\191\001\153\002\196\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\002\217\000\000\000\000\000\000\002\217\000\000\002=\002>\001s\000\000\000\000\000\000\002=\002>\001s\000\000\002=\002>\001s\002\197\000\000\002\154\001{\000\000\000\000\002\197\002\191\002\154\000\000\002\159\000\000\002\154\000\000\000\000\001|\002\159\000\000\000\242\002A\002\159\002\193\000\242\002\185\000\000\003\240\000\000\000\000\000\000\002\185\000\000\003\251\002\194\002\185\000\000\000\000\000\000\000\000\002\194\000\000\000\000\002\215\000\000\001\153\002\196\000\000\000\000\002\215\000\000\001\153\002\196\002\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\217\000\000\000\000\000\000\000\000\000\000\002\217\000\000\000\000\000\000\000\000\004\004\000\000\000\000\001\143\000\000\000\000\000\000\002\194\000\000\000\000\000\000\002\191\001\152\000\000\001\153\001z\002\215\002\191\001\153\002\196\000\000\002\191\000\000\002A\000\000\002\193\000\242\000\000\000\000\002A\000\000\002\193\000\242\002A\000\000\002\193\000\242\002=\002>\001s\002\217\002=\002>\001s\000\000\000\000\000\000\000\000\001\201\001s\000\000\000\000\002\154\000\000\000\000\002\197\002\154\000\000\000\000\000\000\002\159\002\197\000\000\000\000\002\159\002\197\000\000\000\000\001t\002R\000\000\001v\001w\002\185\000\000\000\000\000\000\002\185\000\000\000\000\004\r\000\000\000\000\000\000\000\000\000\000\004\020\002\194\001#\000\000\004B\001$\000\000\002\194\000\000\000\000\002\215\002\194\001\153\002\196\000\000\000\000\002\215\000\000\001\153\002\196\002\215\001#\001\153\002\196\001$\004J\003\143\003\144\000\000\001&\000\000\000\000\000\000\000\000\002\217\000\000\000\000\000\000\000\000\004\178\002\217\000\000\000\000\000\000\002\217\000\000\000\000\000\000\001&\000\000\000\000\002\191\000\000\006\200\004\181\002\191\000\000\001#\000\000\000\000\001$\001\141\000\000\002A\000\000\002\193\000\242\002A\000\000\002\193\000\242\000\000\000\000\001|\000\000\001,\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001&\000\000\000\000\000\000\000\000\000\000\001(\000\000\000\000\000\000\001,\002\197\000\000\000\000\000\000\002\197\000\000\000\000\004Q\000\000\000\000\000\000\000\000\001)\001#\001(\000\000\001$\000\000\001\027\001/\000\000\000\000\000\000\000\000\000\000\004A\000\000\000\000\000\000\004H\000\000\001)\002\194\000\000\000\000\001,\002\194\001\027\001/\000\000\001&\002\215\001\143\001\153\002\196\002\215\000\000\001\153\002\196\000\000\001(\001\144\000\000\001\153\001z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001#\001;\002\217\001$\001)\001#\002\217\000\000\001$\0011\001\027\001/\0012\000\000\000\000\0013\0014\000\000\000\000\007\204\001;\000\000\000\000\001,\000\000\001r\001s\001&\0011\000\000\000\000\0012\001&\000\000\0013\0014\005\214\000\000\001(\000\000\000\000\0015\000\000\000\000\004\185\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\000\000\000\000\001)\001;\000\000\000\000\000\000\0015\001\027\001/\001?\0011\000\000\000\000\0012\000\000\000\000\0013\0014\005\227\001,\000\000\006\246\001#\000\000\001,\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001(\001\133\000\000\001\134\0078\001(\000\000\000\000\0015\000\000\000\000\001?\000\000\000\000\000\000\001&\000\000\001)\000\000\001;\000\000\000\000\001)\001\027\001/\000\000\000\000\0011\001\027\001/\0012\000\000\000\000\0013\0014\007\205\001\141\001#\000\000\000\000\001$\000\000\000\000\002=\002>\001s\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0015\000\000\001,\001?\000\000\001&\000\000\002\144\000\000\000\000\001E\000\000\000\000\001P\000\000\001;\000\000\001(\0011\000\000\000\000\0012\000\000\0011\0013\0014\0012\000\000\000\000\0013\0014\001f\000\000\000\000\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\000\000\000\000\000\000\000\000\000\000\000\000\001r\001s\0015\001,\000\000\001\143\000\000\0015\001r\001s\001?\000\000\000\000\000\000\001\144\000\000\001\153\001z\001(\000\000\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\001t\001\132\000\000\001v\001w\000\000\000\000\001)\002@\000\000\001;\001r\001s\001\027\001/\000\000\000\000\000\000\0011\000\000\002A\0012\002\193\000\242\0013\0014\001<\000\000\000\000\000\000\000\000\001t\001\132\000\000\001v\001w\001\133\000\000\001\134\001\190\001r\001s\000\000\000\000\001\133\000\000\001\134\001\178\000\000\000\000\0015\000\000\000\000\001?\000\000\000\000\000\000\000\000\000\000\001;\001t\001\132\000\000\001v\001w\000\000\000\000\0011\000\000\000\000\0012\001\141\000\000\0013\0014\001\133\000\000\001\134\001\175\001\141\000\000\000\000\000\000\001|\002\194\000\000\000\242\000\000\000\000\000\000\000\000\001|\000\000\002\195\000\242\001\153\002\196\000\000\000\000\0015\000\000\000\000\001T\000\000\001\133\000\000\001\134\001\136\001r\001s\001\141\000\000\000\000\000\000\001r\001s\000\000\000\000\000\000\000\000\000\000\000\000\001|\000\000\000\000\000\242\000\000\000\000\001t\001\132\000\000\001v\001w\000\000\001t\001\132\000\000\001v\001w\001\141\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\143\000\000\000\000\001#\001|\000\000\001$\000\242\001\143\001\144\000\000\001\153\001z\000\000\000\000\000\000\000\000\001\144\000\000\001\153\001z\001r\001s\000\000\000\000\001\133\000\000\001\134\001\139\000\000\001&\001\133\000\000\001\134\001\142\001r\001s\000\000\000\000\001\143\000\000\001t\001\132\000\000\001v\001w\000\000\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\001t\001\132\000\000\001v\001w\001\141\000\000\000\000\000\000\000\000\000\000\001\141\000\000\001\143\000\000\000\000\000\000\001|\001r\001s\000\242\001,\001\144\001|\001\153\001z\000\242\000\000\000\000\000\000\001\133\000\000\001\134\001\174\000\000\000\000\001(\000\000\001t\001\132\000\000\001v\001w\000\000\001\133\000\000\001\134\001\162\000\000\001#\000\000\000\000\001$\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\000\000\000\000\000\000\000\000\001\141\000\000\000\000\000\000\000\000\001#\000\000\000\000\001$\000\000\000\000\001&\001|\000\000\001\141\000\242\001\143\001\133\001#\001\134\001\170\001$\001\143\000\000\000\000\001\144\001|\001\153\001z\000\242\000\000\001\144\001&\001\153\001z\000\000\000\000\000\000\000\000\001#\001;\000\000\001$\000\000\000\000\001&\000\000\000\000\0011\000\000\000\000\0012\001\141\000\000\0013\0014\001\165\001,\000\000\000\000\000\000\000\000\000\000\000\000\001|\000\000\001&\000\242\000\000\000\000\000\000\000\000\001(\000\000\000\000\000\000\001\143\000\000\001,\000\000\0015\000\000\000\000\001?\000\000\001\144\000\000\001\153\001z\001)\001\143\001,\000\000\001(\000\000\001\027\001/\000\000\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\001(\000\000\000\000\000\000\001)\000\000\001,\000\000\000\000\001#\001\027\001/\001$\000\000\000\000\000\000\000\000\001)\000\000\000\000\000\000\001(\001\143\001\027\001/\000\000\000\000\000\000\000\000\000\000\000\000\001\144\000\000\001\153\001z\001;\001&\000\000\001)\000\000\000\000\000\000\000\000\0011\001\027\001/\0012\000\000\000\000\0013\0014\001\206\000\000\000\000\000\000\000\000\001;\000\000\000\000\001#\000\000\000\000\001$\000\000\0011\000\000\000\000\0012\000\000\001;\0013\0014\001\246\000\000\000\000\0015\000\000\0011\001?\000\000\0012\000\000\001,\0013\0014\001\248\001&\001r\001s\000\000\001;\000\000\000\000\000\000\000\000\000\000\0015\001(\0011\001?\000\000\0012\000\000\000\000\0013\0014\002T\001t\001\132\0015\001v\001w\001?\000\000\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\000\000\001#\000\000\000\000\001$\000\000\000\000\000\000\0015\000\000\001,\001?\000\000\001#\000\000\000\000\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001(\000\000\000\000\001&\001\133\000\000\001\134\002\139\000\000\001#\000\000\000\000\001$\000\000\000\000\001&\000\000\001)\001#\001;\000\000\001$\000\000\001\027\001/\000\000\000\000\0011\000\000\000\000\0012\000\000\000\000\0013\0014\002g\001&\000\000\000\000\001\141\000\000\000\000\000\000\000\000\000\000\001&\000\000\000\000\000\000\001,\000\000\001|\000\000\000\000\000\242\000\000\000\000\000\000\000\000\0015\000\000\001,\001?\000\000\001(\000\000\000\000\000\000\000\000\001;\000\000\000\000\000\000\000\000\000\000\000\000\001(\0011\000\000\000\000\0012\001)\001,\0013\0014\002\165\000\000\001\027\001/\000\000\000\000\001,\000\000\001)\000\000\000\000\000\000\001(\000\000\001\027\001/\000\000\000\000\000\000\000\000\000\000\001(\000\000\000\000\0015\000\000\000\000\001?\000\000\001)\001\143\000\000\000\000\000\000\000\000\001\027\001/\000\000\001)\001\144\000\000\001\153\001z\000\000\001\027\001/\001r\001s\001;\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0011\000\000\000\000\0012\001;\000\000\0013\0014\002\170\000\000\001t\001\132\0011\001v\001w\0012\000\000\000\000\0013\0014\003e\000\000\000\000\000\000\000\000\001;\000\000\000\000\000\000\000\000\000\000\000\000\0015\0011\001;\001?\0012\000\000\000\000\0013\0014\003l\0011\001#\0015\0012\006\011\001?\0013\0014\003|\000\000\001r\001s\001\133\000\000\001\134\003\132\001r\001s\000\000\000\000\000\000\000\000\000\000\0015\000\000\000\000\001?\000\000\001&\000\000\001t\001\132\0015\001v\001w\001?\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\001r\001s\000\000\001\141\000\000\000\000\000\000\000\000\001#\000\000\000\000\001$\000\000\000\000\000\000\001|\000\000\000\000\000\242\000\000\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\001r\001s\001\133\000\000\001\134\003\135\000\000\001&\001\133\000\000\001\134\003\138\000\000\000\000\000\000\000\000\000\000\001(\000\000\000\000\001t\001\132\000\000\001v\001w\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001)\000\000\001\133\001\141\001\134\003\146\001\027\001/\000\000\001\141\000\000\000\000\000\000\000\000\000\000\001|\000\000\001\143\000\242\001,\000\000\001|\000\000\000\000\000\242\000\000\001\144\000\000\001\153\001z\001\133\000\000\001\134\005;\001(\000\000\000\000\001\141\000\000\000\000\000\000\000\000\000\000\001#\000\000\000\000\001$\000\000\000\000\001|\000\000\001)\000\242\000\000\000\000\000\000\001#\001\027\001/\001$\0011\000\000\000\000\0012\000\000\001\141\0013\0014\000\000\000\000\001&\000\000\000\000\000\000\000\000\000\000\000\000\001|\000\000\001\143\000\242\000\000\000\000\001&\000\000\001\143\000\000\000\000\001\144\000\000\001\153\001z\0015\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\000\000\000\000\001;\000\000\000\000\000\000\001#\000\000\000\000\001$\0011\000\000\001\143\0012\000\000\001,\0013\0014\005L\000\000\000\000\001\144\000\000\001\153\001z\000\000\000\000\000\000\001,\000\000\001(\000\000\000\000\001&\000\000\000\000\001#\000\000\000\000\001$\001\143\000\000\0015\001(\000\000\001?\000\000\001)\000\000\001\144\000\000\001\153\001z\001\027\001/\000\000\001#\000\000\000\000\006\b\001)\000\000\000\000\001&\000\000\000\000\001\027\001/\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001#\000\000\001,\006\b\000\000\000\000\001&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001(\000\000\000\000\000\000\000\000\001;\000\000\000\000\000\000\000\000\001&\000\000\000\000\0011\000\000\001,\0012\001)\001;\0013\0014\005\175\000\000\001\027\001/\000\000\0011\000\000\000\000\0012\001(\000\000\0013\0014\005\187\006\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0015\000\000\001)\001?\000\000\001(\000\000\000\000\001\027\001/\000\000\006\n\000\000\0015\000\000\000\000\001?\001#\000\000\000\000\006\b\000\000\001)\000\000\001;\000\000\001(\000\000\001\027\006\r\000\000\000\000\0011\000\000\000\000\0012\000\000\000\000\0013\0014\005\213\000\000\000\000\001)\001&\001#\000\000\000\000\006\b\001\027\006\r\000\000\000\000\001#\001;\000\000\006\b\000\000\000\000\000\000\000\000\000\000\0011\000\000\0015\0012\000\000\001?\0013\0014\005\229\000\000\001&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001&\000\000\0011\000\000\000\000\006\014\000\000\000\000\0013\0014\006\n\000\000\000\000\000\000\0015\000\000\000\000\001?\005\216\000\000\006\019\000\000\006\016\0011\000\000\001(\006\014\000\000\000\000\0013\0014\000\000\000\000\000\000\0015\000\000\000\000\000\000\006\n\005\216\000\000\006\018\001)\006\016\000\000\000\000\006\n\000\000\001\027\006\r\000\000\000\000\000\000\001(\001#\0015\000\000\001$\000\000\000\000\000\000\001(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001)\000\000\000\000\000\000\000\000\000\000\001\027\006\r\001)\000\000\000\000\001&\000\000\000\000\001\027\006\r\000\000\001#\000\000\000\000\001$\000\000\000\000\000\000\000\000\000\000\001#\000\000\000\000\001$\000\000\000\000\0011\000\000\000\000\006\014\000\000\000\000\0013\0014\000\000\000\000\000\000\000\000\001&\000\000\000\000\000\000\005\216\000\000\006\017\000\000\006\016\001&\002=\002>\001s\001,\000\000\000\000\0011\000\000\000\000\006\014\0015\000\000\0013\0014\0011\000\000\000\000\006\014\001(\000\000\0013\0014\005\216\002\146\006\015\000\000\006\016\000\000\000\000\000\000\005\216\000\000\006\027\000\000\006\016\001)\001,\001#\0015\000\000\006\b\001\027\001/\000\000\000\000\001,\0015\000\000\000\000\000\000\000\000\001(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001#\001(\000\000\006\b\000\000\001&\000\000\000\000\000\000\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\000\000\001)\001#\000\000\000\000\001$\000\000\001\027\001/\000\000\001&\001;\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0011\000\000\000\000\0012\000\000\002@\0013\0014\006\130\000\000\001&\000\000\000\000\000\000\000\000\006\n\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\000\000\001;\000\000\000\000\000\000\000\000\001(\000\000\0015\0011\001;\001?\0012\006\n\000\000\0013\0014\006\148\0011\000\000\000\000\0012\000\000\001)\0013\0014\006\172\000\000\001(\001\027\006\r\001#\001,\000\000\001$\000\000\000\000\000\000\000\000\000\000\001#\0015\000\000\001$\001?\001)\000\000\001(\000\000\000\000\0015\001\027\006\r\001?\000\000\000\000\000\000\002\194\001&\000\000\000\000\000\000\000\000\000\000\001)\000\000\002\195\001&\001\153\002\196\001\027\001/\000\000\001#\000\000\000\000\001$\000\000\000\000\000\000\000\000\000\000\000\000\0011\000\000\000\000\006\014\000\000\000\000\0013\0014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\216\001&\006\232\000\000\006\016\001,\0011\000\000\000\000\006\014\000\000\006\031\0013\0014\001,\000\000\0015\001;\000\000\000\000\001(\000\000\005\216\000\000\007\002\0011\006\016\000\000\0012\001(\000\000\0013\0014\007;\000\000\000\000\000\000\001)\0015\006 \007\159\006!\001#\001\027\001/\001$\001)\001,\000\000\000\000\000\000\000\000\001\027\001/\000\000\000\000\000\000\0015\000\000\000\000\001?\000\000\001(\000\000\001#\000\000\000\000\001$\000\000\001&\000\000\006\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001)\000\000\000\000\000\000\000\000\000\000\001\027\001/\000\000\000\000\001;\000\000\001&\000\000\000\000\000\000\000\000\000\000\0011\001;\000\000\0012\001r\001s\0013\0014\007}\0011\006#\000\000\0012\000\000\000\000\0013\0014\007\128\001,\000\000\006$\006%\000\000\006&\001t\002s\000\000\001v\001w\000\000\000\000\000\000\0015\001(\001;\001?\000\000\000\000\000\000\000\000\001,\0015\0011\000\000\001?\0012\006b\000\000\0013\0014\001)\000\000\000\000\000\000\000\000\001(\001\027\001/\001#\000\000\000\000\001$\000\000\001r\001s\000\000\000\000\000\000\000\000\000\000\006(\000\000\001)\000\000\0015\006*\0064\001R\001\027\001/\000\000\000\000\000\000\001t\002s\001&\001v\001w\006^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001r\001s\000\000\001;\001{\000\000\000\000\006_\000\000\000\000\000\000\0011\000\000\000\000\0012\000\000\001|\0013\0014\000\242\001t\002s\000\000\001v\001w\001;\000\000\000\000\000\000\000\000\000\000\000\000\001,\0011\000\000\000\000\0012\000\000\000\000\0013\0014\000\000\000\000\0015\000\000\000\000\001\241\001(\000\000\000\000\000\000\002u\000\000\001r\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001{\001)\0015\000\000\000\000\001\243\000\000\001\027\001/\002v\001t\002s\001|\001v\001w\000\242\000\000\001\143\000\000\000\000\000\000\000\000\001#\000\000\000\000\001$\001\152\000\000\001\153\001z\000\000\000\000\000\000\000\000\000\000\000\000\001{\000\000\000\000\000\000\000\000\000\000\000\000\006\031\000\000\000\000\000\000\006\205\001|\001&\000\000\000\242\000\000\001;\007\018\001#\000\000\000\000\001$\000\000\000\000\0011\000\000\000\000\0012\000\000\000\000\0013\0014\b\007\000\000\006 \b\b\006!\000\000\007\021\001\143\006\031\000\000\000\000\000\000\000\000\001&\007\005\007\022\001\152\000\000\001\153\001z\001{\000\000\000\000\000\000\0015\000\000\001,\004\180\000\000\006\217\007\018\000\000\001|\000\000\006\"\000\242\006 \000\000\006!\000\000\000\000\001(\000\000\001\143\000\000\007\023\000\000\000\000\007\019\000\000\000\000\007\021\001\152\000\000\001\153\001z\000\000\000\000\001)\001,\007\022\000\000\000\000\000\000\001\027\001/\007\006\007\005\006\"\000\000\006#\000\000\000\000\000\000\001(\000\000\000\000\000\000\000\000\000\000\006$\006%\007\024\006&\000\000\000\000\000\000\000\000\000\000\000\000\007\023\001)\007\025\002=\002>\001s\001\143\001\027\001/\000\000\000\000\000\000\007\018\000\000\006#\001\152\006`\001\153\001z\000\000\0010\000\000\b\018\000\000\006$\006%\002\177\006&\0011\007\014\007\019\0012\000\000\007\021\0013\0014\000\000\007\024\000\000\000\000\006(\007\027\007\022\000\000\000\000\006*\0064\007\025\000\000\000\000\006'\007\028\000\000\007v\000\000\000\000\007\030\000\000\006^\000\000\0015\0011\000\000\000\000\0012\000\000\000\000\0013\0014\007 \000\000\007%\007\023\000\000\006(\000\000\006_\000\000\000\000\006*\0064\002=\002>\001s\000\000\000\000\007\027\007!\000\000\000\000\000\000\000\000\006^\0015\000\000\000\000\007\028\002=\002>\001s\000\000\007\030\000\000\002@\002\192\002=\002>\001s\000\000\007\024\006_\000\000\000\000\000\000\007 \002A\000\000\002\193\000\242\007\025\002\216\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\181\000\000\000\000\000\000\007!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007/\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\027\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\028\000\000\000\000\000\000\000\000\007\030\000\000\000\000\000\000\000\000\000\000\002\194\000\000\002@\000\000\000\000\000\000\000\000\007 \000\000\002\195\000\000\001\153\002\196\000\000\002A\000\000\002\193\000\242\002@\000\000\000\000\000\000\000\000\000\000\000\000\007!\002@\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\000\000\002A\000\000\002\193\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\195\000\000\001\153\002\196\000\000\000\000\000\000\002\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\194\002\195\000\000\001\153\002\196\000\000\000\000\000\000\000\000\002\195\000\000\001\153\002\196"))
+    ((16, "\001\164\001{\000G\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\000\000\000\000\000\239\000\006\000)\000\199\000\219\000j\000\028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\000\000\000~\000\000\000\000\000\000\000\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 R\000\000\000\000\000\000\000\226\000\000\000\000\000\000\000\000\000\000\000\000\000\0009p\0018\000\000\001\026\000\145\007\016\000\000\000\000\000\000\000{.\150\001*\000\200\005\150\000\000\000\000\000\000\007\"\000\000\000\000\000\222\000\000\000\000\000\000\000\000\002\174\000\000\001\142\000\000\000\000\000\000\000\000\000\000\0006\000\000\001p\002\218\b\184\000\000\000\000\n69p\000\000\000\000\019F\000\000\016\238\000\0009\186\000\214\003\006\000\000\000\000\002t\001\208\007p\b\002\001\230\002\218\003\132\000%\002\216\0008\002\200\002*\r\174\000\000\007\200\003\002\002@\003:L\180\000\000\000\000\000\000\000\000\000\000\000\000\000\000:F\000\000\003\140\002\158\004.\000\000\000\000\000\000\000\000\015\234\000\000\000\000\003\168\003 \004H\0064\007\160\000\000\000\000\000\000\003\168\0042\004\228\004\130\000\000\000\000\004\176\004\236:V\004F\005\014\001\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\136\000\000\000\000\000\000\027\018\014\002\004\146\005\224\0146\004\210\007\200 \246\000\000:\190\001\184;\020;b\000\000\001F\000\000\000\000\000\000\000\000\005\188L\150\005\200\000\000\011\004\005\204\000\000\0110\r\170\000\203\000\000\000\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\190\005J\000\000\000\000\000\000\027\180\000\000\nb\000\000\000\000\005DM`U\248\000\000ZR\000\000\000\000\000\000\000\000\000\000\000\000\002\182\028j\002\182\000y\000\000\000\000\000\000\005D\000\000\000\000\000\000\000\000\005\174\000\000\000\000\002\182\000\000\000\000\000\000\000\000\000\000\015\026\000\000\006\n\0066\000\000Mx\006x,\128\000\000\000\000\000\000\000\000\005D\000\000\000\000\000\000\011\234\000\000\000\000\000\000\000\000\000\000\000\000\001\004\0066\000\000\000\000\000\000\005D\006\158M\172\005\232\006\168\rD\000\000\004\150\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\220\000\000\000\000\000\000\000\000\007<NT\000\000\000\000\006&\007\012Nn\002\024\000\000\000\000I\198\000\000\000\000\000\000\000\000N\186\000\000\000\000O&\006(Or\000\000\006(\000\000O\140:F\006\254\007\028\000\000\000\000R\228\000\000\000\000\000\000\000\000\006(\000\000\000\000O\192\000\000\006(Ot\000\000\005D\000\000\000\000P\138\000\000\006(\001\152\000\000\000\000\006(\006(\006(\000\000\000\000\006(\000\000\000\000;b\000\000\000\000\000\000\000\000\006(;\212\000\000\000\000\006(\000\000\001\202\007P\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \254\000\000\006\244\000\000P4\005D\000\000\000\000\000\000\000\000\007\004\007\154\014\166\006\240\007(\007:\007(\005\000\007\152\001v\005(\000\000\000\000\017\212\005(\000\000\007\212\0024\007\234\018*\007\234\020\196\000\000\003\028\000\031\b^\000\174\tD\000\000\000\000Y\132\000\000Y\176\t4\000\000P^\005DQ\024\005D\000\000\002x\000\239\000\000\023n\003\028\000\000\000\000\bf\000\000\000\000\000\000\000\000\000\000\000\000\025x\003\028#4\003\028\000\000\004P\000\000\000\000\004\218\000\000\000\000\000\000\t\190\000\000\000\000\003\028\003\028\000\000\000\000\003\028\000\000\007\234\006\000\000\000\000\133\004\176\000\000\000\133\000\000\000\000'\146\003\028\000\000\000\000\000\000\000\000\000\000\000\000\000\133\015|!\200\t\136\t\132<\n\006\210\000\000\b\220\b:\015\200\b\222\bZ1\154C\192\000\000\000\000\000\000\000\000\000\000\003\238\012\n\000\000\000\000\000\000\t*\br\006r\000\133)\030\000\000\003\028\000\000\000\000\000\000\001\184\000\000QD\005D\016$\t8\b\162\016\136\tL\t\b\006\178<x\006(\017\014\tX\t0<<\nb\000\000<\140\006(Qj\005D\nJ\000\000\000\000\000\000\000\000:F\n,\000\000\000\000Z\254\000\000\000\000\016n\000\000\000\000\nJ&\232\002\182\000\000\017Z\t\170\t6!\252\000\000<\174\t\172\tj\"0\000\000=\148\000\000\000\000\t\188\ttR\014\006(\018\002\t\216\t\130EH\000\000W\214\000\000\000\000\"\156\t\218\t\150\"\196\000\000#\000=\158\n\n\t\210#\132\000\0002\\\000\000\000\000\011^Q\216\000\000\005DD\248\000\000\005DR>\005D\000\000\000\000\000\000\000\000\000\000[\192\000\000\000\000\000\000\001*\018$\000\000\000\000\000\000\000\000>@\n\026\t\218#\192\000\000[\208\000\000\000\000\000\000\000\000\000\000\n\n\018\216\000\000\000\000\n >J\nd\t\220#\206\000\000\n >\148\nz\t\240$\128\000\000\n \000\000\\\000\000\000>\158\n\128\t\246$\142\000\000\n \019$\005\182\019\170\000\000\000\000?\202\n\130\t\248%\"\000\000\n ?\212\n\148\t\254%V\000\000\n @\030\n\156\n\004%`\000\000\n @(\n\166\n\006%\148\000\000\n @\202\n\182\n\016&\030\000\000\n A\138\n\186\n\028&(\000\000\n A\178\n\192\n\"&\\\000\000\n A\240\n\194\n$&\230\000\000\n BT\n\196\n&'$\000\000\n B\176\n\200\nL'.\000\000\n B\196\n\210\nV'\230\000\000\n Cj\n\222\nX(\134\000\000\n C\184\n\224\n\162(\166\000\000\n C\240\n\232\n\166(\186\000\000\n D>\n\238\n\178(\242\000\000\n D`\011\000\n\180)\140\000\000\n D\228\011\030\n\210*D\000\000\n ET\0110\n\220*^\000\000\n E\204\011N\n\226*\144\000\000\n E\244\011V\011\b+\006\000\000\n \011\014+H\019\190\020\014\000\000D\248\011\250\000\000R|\005D\020\176\000\000\000\000\011\134\000\000R\224\005D\021\020\000\000\000\000\021p\000\000\000\000\001T\000\000\000\000\021\188\000\000\000\000\000\000\000\000S8\005D\022v\000\000\011:\022\170\000\000S\136\000\000\006(T\004\000\000\006(T:\000\000\006(\004h\000\000\000\000\000\000\000\000\000\000T\164\006(\000\000\003\n\003\130\000\000\000\000\000\000\n \022\210\000\000\000\000\000\000\023\030\000\000\000\000\000\000\000\000\000\000+d\000\000\000\000\000\000\n ,\024\000\000,\204\000\000\000\000\000\000,\238\000\000\000\000\000\000\000\000\\\026\000\000\000\000-\022\000\000\000\000\000\000F\154\011t\011 -\"\000\000\n -\154\000\000\000\000\000\000F\238\011\132\011&. \000\000\n .\188\000\000\000\000\000\000F\248\011\134\0112.\196\000\000\n \002,\024\012\000\000\000\000G\002\011\138\011@/*\000\000\n \0244\000\000\000\000G\194\011\146\011H/^\000\000\n \024\128\000\000\000\000H\000\011\148\011J/\202\000\000\n \000\000\000\000/\"\000\000\000\000H\172\011\156\011L0\130\000\000\n 0\164\000\000\000\000H\192\011\160\011N0\198\000\000\n 1P\000\000\000\000H\212\011\164\011P1\166\000\000\n \000\000Iz\011\190\011f2\030\000\000\n \000\000\023\216\000\000\000\000\n \000\000\000\000\000\0002f\000\000\000\0002\142\000\000\000\000\011\206\000\000\000\000\024\220\000\000\025\150\000\000\000\000\000\000\n \000\000\000\000\025\226\000\000\025\234\000\000\000\000\000\000\000\000\000\000I\206\011\216\011h2\178\000\000I\226\012\n\011l3t\000\000\n \n J\130\012\016\011p3\152\000\000\n \000\000\011:\026>\000\000\000\000\026\138\000\000J\142\000\000\000\000C\192\000\000\000\000\000\00044\000\000\000\000\000\000\000\0004>\000\000\000\000\000\000\000\000\rL\000\000\000\000\000\000T\176\000\000\000N\000\000\004 \012\228\000\000\003$\000\000\000\000\000\000\000\000\000\000\000\000\003\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012>\011v4l\000\000\n \000\000\rx\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011x\bJ\000\133\027t\000\000\012Z\011\154\r\002\000Y\b\176\000\133+P\000\000\003\028\t\138\000\133\000\000\027~\000\000\004\006\000\000\012\132\011\156\004\198\000\000\000\000\000\000\000\000\000\000\012\164\002b\001(\000\000\000\000\000\000J\208\000\000Y\242\000\000\011\170\000\000\011\230\000\000\000\000\000\000\000\000\005\\\000\000\000\000\000\0006\178\002\182\000\000\002\182(D\000\000\005`\000\000A&\002\182\002\182\000\000G8\002\182\002\182\012\002\000\000\028>\000\000\000\000\012\004\r\144\000\0004\172\003\218\000\000\000\000\000\000\000\000\000\000\000\000\012\168\012\b5@\000\000\n \000\000\000\000\000\000\000\000\000\000\012\188\012\n\t\148\000\133\000\000+R\000\000\003\028\000\000\014\014\000\000\000\000\000\000\000\000\000\0005\228\000\000\000\000\000\000\000\000\012\210\012\0165\254\000\000\000\000\000\0003*\000\000\003\028\000\0005\028\000\000\003\028\000\0007\b\003\028\000\000\n \000\000\000\0007\\\000\000\003\028\000\000=\246\000\000\003\028\000\000>f\003\028\000\000\000\133\000\000\012\022\t\204\002\b\000\000\012\224\012\252\012 \r$\r\216?\242\003\028\005\242\000\000\012*\r\176\r\178\006\136\006\224\r\188\0120\014\020\006\254\0078\r\226\000\000\000\000\007\026\b\226\000\000\007:\003fT\196\006(\028H\000\000\007\246\001D\r\150\0126\t\226\004\252\000\000\r\210\012@\006\242\000\0005\230\000\000T\250\005D\000\000\014x\014\142\000\000\tT\000\000\005D\014\b\012B\007\b\014N\000\223\000\000\000\000\000\000\000\000\012l\t\206\000\000\012\134\t\230\000\000\b|\023\244\0146\014X\012\136\007\232\n.\000\000\012\154\b\164\nx\000\000\014z\014~\012\188\014\208\r\216D\182\003\028\000\000\012\194\0156\000\000\t\b\000\000\n\130\000\000\015<\000\000O\222\003\230\015\b\012\196\015B\000\000P\232\004X\015\028\000\000\000\000\001\004\002\230\000\000\011\016\000\000T\134\003\028\011b\000\000\005R\000\000\000\000\014\210\012\216\\ \006\188\000\000\014\212\012\224\b\014\014N\014\220\014\228\012\230\016R\000\000\014\248\0014\000\000\000\000\000\000\000\000\0012\012\240\014\206U\018\005D\000\000\002\222\r\002\015\140\000\000\000\000\000\000\000\000\000\000\000\000U$\b\000\000\000\r\n\015\232\000\000\000\000\000\000\000\000\000\000\000\0006D\012\130\000\000\r\026\003N\000\000\r \r2\0034\000\000\006\160J\212\000\000\001\012\000\000U\146\005D\005D\000\000\000\000\b \000\000\004\156\000\000\007l\b \b \000\000\r<Kh\005DU\230\005D\012\156\000\000\000\000\000\000\000\000\r\188\000\000\000\000\004v\000\000\b\134\015H\rF\016n\015\020\000\000\000\000\br\b\158\015d\000\000\000\000\rP\016\132\0150\000\000\000\000 (\000\000[j\000\000A@\012x\005D\000\000G\144\\L\000\000V0\000\000\000\000\000\000\b \000\000\000\000\r\216\015z\r\\\016\152\015@\000\000\000\000V\136\r\228\015\144\000\000\000\000\000\000[\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\240\000\000\015\160\r\132\t<\000\000\016\158\016N\014\002\015\178\000\000\000\000\015\184\r\148\tf\000\000\000\000\t\030\r\170\006\190\000\000\000\000\000\000\b(\015~\r\164\000\000\015\130\b(\000\000\016f\014\006\015\202\000\000\000\000\000\000\005D\003\180\004\146\007\b\000\000\000\000\000\000\000\000\015\144\r\172\000\000\007\136\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005D\015x\r\178\016\228\015\138\000\000\b\216\000\221\r\208\015Z\000q\001^\r\240\016\024\000\000\016\210\028|\000\000\000\000\0296\000\000\014&\000\000\005\216\000\000\000\000\000\000\000\000\000\000\000\000V\206\005D\000\000\016\214\029j\000\000\000\000\029t\000\000\000\195\r\250\016~\000\000\000\0006\2327\018\0160\000\000W&\005D\0304\000\000\000\000\030>\000\000\000\000\014,\000\000\002\216\000\000\000\000\000\000\000\000\000\000\000\0007\128\000\000\000\0007\1888$\0162\000\000W\138\005D\030\254\000\000\000\000\0312\000\000\000\000\014\018\031<\014R\000\000\014.\014<\000\191\000\161\014@\b\248\014P\016\1408~\014\184\000\000\014Z\014\\\bv\000\000\000\133K\144\000\000\002\208\000\000\014`\004\230@L\002R\015^\002\142\000\000:\n\023\216\000\000\005\140\000\000\000\000\005\140\000\000\000\000\005\140\t\184\000\000\003\174\005\140\016\1468\202\014\200\000\000\005\140\000\000\000\000W\182\000\000\000\000\000\000\005\140\000\000\000\000\014\204\000\000\005\228\007\220\014\228\000\000\014fK\164\014\250\000\000\000\000\000\000\000\000\015\026\000\000\000\000\005x\000\000\005\140X\n\000\000\007F\005\140Z.\000\000\015\028\015\236\014j\017\012\015\182\000\000Z\152\015&\016\000\000\000\000\000\000\000\000T\006\240\000\000\000\000\000\000\000\000\000\000\000\000\n\n\015(\000\000\016\014\000\000\000\000\000\000\000\000\015*\003\130\000\000\000\000\000\000\n\n\000\000\000\000\000\000\000\000\015,\029\208\000\000\000\000\000\000\000\000\000\000\000\133\003\028\000\000\000\000\006(\000\000XL\005D\000\000\007\138\000\000\000\000\000\000\000\0009@\000\000\000\000\000\000\000\000\000\000\000\000\016\170\000\242\b|\015~\002\140\014\164\000\000\002V\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\144\005\182\014\166\000\000\b\006\017\014\016\190\015J\000\000\000\000\016\178\003\192\003\182\000\000\000\000\000\000\014\168\000\000\014\172\027F\000\000\000\000\002\182\030\142\000\000\000\000\000\000\000\000\000\000[R\000\000\000\000\b\212\004\210\000\000\000\000Xr\005D\005DX\138\005D\007\222\000\000\000\000\000\000\005D\000\000\000\000\tf\016\198\015`\000\000\000\000\016\188\000\188\004&\000\000\000\000\000\000\000\000\b\234\017\014\t\244\016\204\015h\000\000\000\000\016\194\003\176\004T\000\000\000\000\000\000\000\000\003\028\000\000\015r\000\000\000\000\000\000\031\252\000\000 \006\000\000\000\000\000\000\000\000\000\000\000\000YJ\000\000\000\000\000\000\001\004\000\028\000\000\000\000\000\000\000\000\000\000\003\012\000\028\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005<\000\000\000\000\000\000LR\000\000\005D\000\000\r`\000\000\000\000\000\000\002\012\000\000\000\000\000\000\000\020\000\000\000\000\000\000\000\003\000\000\000\133\000\000\r&\000\000\003\028\000\000\006\"\000\000\000\000\000\000L\154\006(\000\000\000\000\002\004\000\000\000\000\000\000\000\000\003\238\004r\015\252\000\023\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\130\000\000\015v\000\000\000\000\000\000\000\000\005F\007\"\000\r\003\"\000\000\000\000\015\142\021\172\000\000\000\000\000\000\015\156?f\000\000\000\000\000\000\000\000"), (16, "\007\028\002\025\002D\002E\001u\000\238\002\003\0007\000\242\000\243\000;\b\002\002E\001u\007\028\003\156\002\007\002\161\007\029\007,\002\011\007\031\001\029\005d\000\238\002\166\000\242\000\242\000\243\b\017\007 \007-\b\018\0007\001\022\007\031\0021\007\178\002\192\000\238\001\029\001 \000\242\000\243\007 \0007\006\165\000@\007\028\002\026\002D\002E\001u\000\151\000\238\006\217\000\160\000\242\000\243\006\167\007!\002\012\007\028\003\156\0070\002\161\007\029\007,\000\238\007\031\006\217\000\242\000\243\002\166\007!\001\022\000q\001u\007 \007-\007\029\001\029\001 \007\031\000\131\006\217\002\192\005$\006\219\004\165\000\244\004o\007 \007\002\007\230\000\136\005g\007\"\001\141\006\217\000?\002&\002\198\006\219\006\220\000\245\007\226\007#\007!\006\222\001!\007\"\0070\007\n\002H\000\245\002\200\000\242\006\219\006\220\007\005\007#\007!\b\003\006\222\002\200\000\242\000\245\006\245\000m\007\231\0071\006\219\0023\006\220\007Q\000\242\000\151\007\007\006\222\000\156\b\020\004\168\006\238\007\227\007\"\0072\000\242\006\220\0007\002\198\001;\000\245\006\222\007\195\007#\007&\006\229\0022\007\"\007%\007(\002H\000\245\002\200\000\242\007\b\007\153\002\207\007#\007&\002\208\000\157\000\238\007*\007(\000\242\001\b\002\201\0071\000\151\000\\\007\028\000\156\002D\002E\001u\002\222\007*\001\141\002\203\000:\007+\007$\0072\007Z\006\130\0024\001d\002\161\007\029\007,\003{\007\031\007&\007\176\007+\002\166\007%\007(\004p\002\224\007 \007-\007\150\005\177\002\207\0009\007&\002\208\002\192\000\238\007*\007(\000\242\001\b\002\201\001\178\001u\000=\007\028\007\196\002D\002E\001u\002\222\007*\001\141\002\203\001\025\007+\000`\007!\001\207\001u\001\029\0070\002\161\007\029\007\184\000d\007\031\001g\007O\007+\002\166\000\139\002$\001\244\002\224\007 \007-\005\156\001v\002Y\007\197\001x\001y\002\192\001\022\007\204\001\029\004\182\007R\003|\001\029\001 \007\156\007\157\007\"\007\246\002E\001u\003\169\002\198\001{\000\242\001\b\001\022\007#\007!\001t\001u\000y\001\029\001 \002H\000\238\002\200\000\242\000\242\001\b\006^\004\218\007^\007_\004Q\003\150\003\151\001\t\007\205\001v\001\135\0071\001x\001y\005\158\007`\007a\001\022\003\186\004\193\004\195\004\197\000\245\001\029\0011\007\"\0072\007b\004\218\006\132\002\198\000\176\001\012\001%\000\128\007#\007&\007\206\000\130\003\156\001\142\007(\002H\005\221\002\200\000\242\000\138\007\248\002\207\005\225\001\235\002\208\001~\001\136\007*\000\242\007\207\007\222\002\201\0071\0021\000\238\005\226\004\198\000\242\001\b\005\250\002\222\000\155\001\141\002\203\002\r\007+\001\202\0072\001<\001\022\000\154\003\156\006\172\004T\004Y\001\029\0011\007&\0073\000\181\007\186\001\142\007(\007\249\002\224\002\200\000\242\000\185\007\223\002\207\000\245\001\012\002\208\001~\001\029\007*\000\242\0007\007\028\002\201\002D\002E\001u\003\248\005(\007\202\000\242\001\b\002\222\001\139\001\141\002\203\007\028\007+\001*\002\161\007\029\007,\001\151\007\031\001\141\001|\000\238\002\166\000\191\000\242\000\243\b\017\007 \007-\b\018\001+\002\224\007\031\006\176\000\196\002\192\001\029\0011\001|\004\021\002\019\007 \007[\000\242\004t\007\028\000\245\002D\002E\001u\005d\000\238\006\217\000\242\000\242\000\243\001\139\007!\002\r\007\028\003\156\007p\002\161\007\029\007,\001\151\007\031\001\141\001|\003\156\002\166\007!\001\022\007\\\0022\007 \007-\007\029\001\029\0011\007\031\000\209\006\217\002\192\000\238\006\219\007]\000\242\000\243\007 \0013\000\245\002&\0014\007\"\005\152\0015\0016\000\242\002\198\004\201\006\220\000\245\000\180\007#\007!\006\222\005\242\007\"\0075\006\226\002H\000\186\002\200\000\242\006\219\004|\001u\007#\007!\003\156\007>\004\202\007X\0023\001\141\000\238\000\242\0071\000\242\001\b\006\220\003\158\005\245\005\216\007\167\006\222\000\242\b\019\006M\006\223\005\128\007\"\0072\007n\000\190\003\156\002\198\001\022\000\245\003{\005\247\007#\007&\001\029\001 \007\"\007%\007(\002H\007\203\002\200\000\242\004p\003\156\002\207\007#\007&\002\208\006\212\003\156\007*\007(\005\248\000\195\002\201\0071\003\148\001u\007\028\000\188\002D\002E\001u\002\222\007*\001\141\002\203\0024\007+\007/\0072\003\157\b\005\b\006\000\238\002\161\b\b\000\242\000\243\007\031\007&\003\156\007+\002\166\007%\007(\001p\002\224\007 \b\n\005\225\002\006\002\207\000\218\007&\002\208\002\192\007o\007*\007(\007G\004q\002\201\005\226\003\156\006\217\003\156\005\233\002D\002E\001u\002\222\007*\001\141\002\203\004\224\007+\004\169\007!\001t\001u\005\140\000\208\002\161\007\156\007\157\006T\006U\007\\\006M\007+\002\166\007^\007_\000\212\002\224\005%\004\249\006\219\001v\002z\007]\001x\001y\002\192\007`\007a\006e\002&\006^\004\218\006^\004\218\007\154\006\220\007\"\002\021\007b\004\218\006\222\002\198\000\245\001\029\006\233\007\028\007#\002D\002E\001u\b\025\004\168\002&\002H\000\220\002\200\000\242\007\168\005#\005\146\b\017\0023\002\161\b\018\000\242\007\155\007\031\b\r\001%\003\156\002\166\005\249\001\022\002\006\005\230\007 \b\026\000\242\001\029\0011\001\237\002*\000m\002\192\0023\0072\000\227\000\242\007\155\002\198\0021\000\151\002&\007\158\002\000\007&\000\235\005\245\004\198\001}\007(\002H\001\022\002\200\000\242\007!\002\024\002\207\001\029\001 \002\208\001~\001\029\007*\000\242\005\247\006\137\002\201\006T\006U\007\210\0025\000\245\0007\0023\0024\002\222\000\242\001\141\002\203\002\006\007+\000\228\002\204\000\252\001\239\000\233\005\248\002\031\006]\001\229\005N\007\"\006^\004\218\002\007\006\215\002\198\0024\002\011\002\224\001\029\007#\000\236\005d\002\207\001*\000\242\002\208\002H\004\182\002\200\000\242\005\160\007\028\002\201\002D\002E\001u\004\178\004\218\006\248\b\030\001+\002\222\001\139\001\141\002\203\007\132\001\029\0011\002\161\007\029\007;\001\140\007\031\001\141\001|\0024\002\166\002\012\0072\003\156\001i\007 \007-\002\r\006\228\002\224\007\t\000\245\007&\002\192\001\016\000\245\001\019\007(\001$\002\014\004\196\004\195\004\197\0022\002\207\000\246\005d\002\208\005\158\000\242\007*\002&\000\245\006\141\002\201\007!\001E\007\005\007\211\007\238\001\141\001t\001u\002\222\0013\001\141\002\203\0014\007+\000\238\0015\0016\000\242\000\243\004\206\007\007\002D\002E\001u\001@\002'\001v\001\135\0023\001x\001y\000\242\002\224\001D\000\253\001Q\007\239\007\"\005R\001u\0051\004\209\002\198\001f\004m\006\217\002\007\007#\007\b\004<\002\011\004u\001\029\002&\002H\001W\002\200\000\242\000\245\007\028\006\224\002D\002E\001u\007d\000\151\001\141\000\161\002\000\003\156\001\143\0071\001\144\002d\b\017\004\130\002\161\b\018\006\219\001\197\007\031\001l\002Q\002\232\002\166\0023\0072\003\156\000\242\007 \b\021\002\012\0024\0007\006\220\0056\007&\002\192\001\195\006\222\001\237\007(\000\245\006\251\000\151\001\142\007f\002\000\002\207\001\022\001U\002\208\001\132\004\182\007*\001\029\001 \001~\002\201\007!\000\242\002G\007\028\000\245\002D\002E\001u\002\222\002\142\001\141\002\203\003\156\007+\004y\001m\002\200\000\242\001\b\001\150\002\161\007\029\005\165\001\156\007\031\002D\002E\001u\002\166\004\168\0024\004\182\002\224\007 \0077\005;\001\239\007\"\001\155\007\172\0057\002\192\002\198\006F\004\195\004\197\002\007\007#\004\239\005@\002\011\004p\001\029\005\225\002H\001\201\002\200\000\242\000\151\000\245\000\183\002\000\001\139\007!\007k\001\133\005\226\b\024\0007\001\213\005\227\001\151\000\238\001\141\001|\000\242\000\243\001\218\002\201\001\224\006Z\004\195\004\197\000\245\005<\004\226\0072\002\202\004\168\001\141\002\203\002\012\001\022\002\006\004\219\004\182\007&\002\r\001\029\001 \007\"\007(\004\168\006\217\000\151\002\198\001\243\002\000\002\207\002\014\007#\002\208\003\156\006)\007*\005a\004\218\002H\002\201\002\200\000\242\007H\004\149\001%\006\252\002G\001&\002\222\003\156\001\141\002\203\001\223\007+\000\245\007:\001\226\006\219\002H\004\182\002\200\000\242\006*\006k\006+\006b\004\195\004\197\000\245\007\005\0072\001(\002\224\006\220\001%\005s\005\225\001&\006\222\005C\007&\001\029\007\014\001t\001u\007(\001\234\007\007\007\133\005\226\001\022\002&\002\207\005\232\006,\002\208\001\029\0011\007*\007\164\003\156\001(\002\201\001v\002z\005\198\001x\001y\007\140\004\195\004\197\002\222\003\156\001\141\002\203\007\b\007+\001.\0007\006M\004\151\005\234\002\201\0023\000\245\001%\000\242\002\029\001&\001\249\006-\002\202\001*\001\141\002\203\002\224\000\151\002?\0067\002\000\006.\006/\002&\0060\001\022\006\207\003\156\001.\000\242\001+\001\029\001 \001(\002B\000\245\001\029\0011\000\151\006\224\006A\002\000\001%\001*\007\145\001&\002P\006l\005\169\004\218\005w\006M\004\159\005\251\005I\0023\001\029\001@\000\242\001\251\001+\006J\004\218\001}\002\n\006\003\001\029\0011\0024\001(\002_\0062\002\028\005\228\001\022\001~\0064\006>\000\242\001.\001\029\0011\001=\004\142\003\156\001\022\000\245\006M\005\225\006h\0013\001\029\0011\0014\001*\006P\0015\0016\006m\005A\005\134\005\226\000\245\007V\004\218\006\002\001\029\006i\006T\006U\007\015\001+\001=\001%\000\245\001.\001&\001\029\0011\0024\0013\002b\0017\0014\005\228\001A\0015\0016\006V\006f\001*\007\147\002&\006^\004\218\004\138\005\228\002&\000\245\001\139\001(\002h\002>\002A\002\133\003\156\001%\001+\001\140\001&\001\141\001|\0017\001\029\0011\001A\005\\\003\156\006M\006T\006U\004\164\007\017\001=\0023\002&\004\243\000\242\001%\0023\002\138\0013\000\242\001(\0014\002\145\002&\0015\0016\006V\006f\002O\002\150\006\199\006^\004\218\001.\006\231\002^\000\245\000\242\006M\002\158\003\156\005'\006T\006U\0023\002a\001=\000\242\001*\007\161\0017\002g\005M\001A\0013\0023\000\245\0014\000\242\000\245\0015\0016\006V\006f\005i\001+\001.\006^\004\218\002\164\002s\001\029\0011\002\196\002\212\0024\005l\003\156\002p\002v\0024\001*\003\156\002\129\002\218\000\245\0017\002\227\002\238\001A\000\245\002\244\002\132\002\137\002\250\003\000\001%\000\245\001+\001&\003\006\002\144\001H\001*\001\029\0011\003\012\000\245\0024\003\018\003\024\003\030\005t\006T\006U\002\149\002\157\001=\001%\0024\001+\001&\001I\001(\001H\0013\001\029\0011\0014\001a\003$\0015\0016\006V\006f\003*\0030\000\245\006^\004\218\002\163\000\245\000\245\002\178\001I\001(\006T\006U\002\195\005x\001=\001_\000\245\003\156\005\135\000\245\000\245\0017\0013\000\245\001A\0014\000\245\000\245\0015\0016\007\143\007\144\000\245\001.\003\159\006^\004\218\0036\000\245\003<\002\221\000\245\000\245\000\245\0013\003B\003H\0014\001*\002\211\0015\0016\001N\001%\0017\001.\001&\001A\003\156\001H\002\217\003N\000\245\002\226\002\237\001+\003T\000\245\000\245\003Z\001*\001\029\0011\002\243\001N\001%\001F\002\249\001&\001I\001(\001H\002\255\002D\002E\001u\001J\001+\003`\005\153\003\005\003d\003\011\001\029\0011\003\017\003\023\003\029\002\161\003#\003\197\001I\001(\003\207\003)\000\245\002\166\000\245\001]\003\217\003/\0035\004[\000\245\000\245\003;\003\227\001=\003A\002\192\003\236\003\245\004\000\004\t\004\018\0013\001.\003G\0014\000\245\005\157\0015\0016\001X\000\245\004\025\004A\000\245\004F\001=\004M\001*\003M\004\135\004\150\001N\001%\0013\001.\001&\0014\003S\001Y\0015\0016\001X\000\245\0017\001+\000\245\001A\004\156\004\172\001*\001\029\0011\003Y\001N\000\245\004\189\003_\000\245\001[\001(\003j\003q\000m\000\245\005\219\0017\001+\003\149\001A\002\198\000\245\003\196\001\029\0011\000\245\000\245\000\245\000\245\000\245\003\206\003\216\002H\003\226\002\200\000\242\004\191\003\235\003\244\003\156\000\245\000\245\003\255\000\245\004\b\000\245\004\017\001=\000\245\000\245\004\215\004\220\003\156\004\232\004\242\0013\001.\005\006\0014\004\024\005&\0015\0016\001X\002\204\005,\000\245\000\245\004-\001=\0053\001*\004@\0059\000\245\001N\005L\0013\001t\001u\0014\005Q\005`\0015\0016\001X\002\207\0017\001+\002\208\001A\002D\002E\001u\001\029\0011\002\201\004E\001v\001w\004L\001x\001y\005h\000\245\002\222\002\161\001\141\002\203\0017\001\237\005\209\001A\004i\002\166\004r\005k\005r\000\245\000\245\007\218\000\245\000\245\004\134\005\241\000\245\005v\002\192\000\245\002\224\002D\002E\001u\000\245\007\234\004\140\001%\004\155\000\245\001&\001=\000\245\001Y\005|\000\245\002\161\005\130\005\142\0013\000\245\000\245\0014\004\157\002\166\0015\0016\006\017\005\163\004\171\007K\004\214\005\168\001[\001(\005\173\001\239\002\192\007\220\007\235\005\183\004\222\000\245\002D\002E\001u\002\007\004\231\001}\005\189\002\011\0017\001\029\005\200\001A\000\245\000\245\004\241\002\161\004\252\001~\005\211\002\198\000\242\005\229\000\245\002\166\003\156\005\005\002D\002E\001u\005\001\005\215\002H\0052\002\200\000\242\005\236\002\192\001.\003\156\000\245\005\253\002\161\000\245\000\245\003\156\006\007\005+\005-\002\012\002\166\003\156\006 \001*\000\245\002\r\004\254\001N\000\245\002\198\003\156\000\245\003\156\002\192\002\204\0050\000\245\002\014\005?\0055\001+\002H\0066\002\200\000\242\000\245\001\029\0011\003\156\000\245\006@\003\156\001\139\002D\002E\001u\002\207\000\245\006L\002\208\000\245\001\140\006`\001\141\001|\006p\002\201\005\246\002\161\000\245\003\156\002\198\005>\002\204\000\245\002\222\002\166\001\141\002\203\000\245\006v\006\030\004\225\002H\000\245\002\200\000\242\006&\005:\002\192\000\245\005=\001=\0063\005K\002\207\006z\002\198\002\208\002\224\0013\006\150\006;\0014\006R\002\201\0015\0016\001X\002H\000\245\002\200\000\242\006\190\002\222\002\204\001\141\002\203\000\245\001%\006\131\003\156\001&\006\166\005P\001H\000\245\006\250\005[\003\156\000\245\003\156\0017\000\245\006\195\001A\006\234\002\207\002\224\005Z\002\208\002\204\006\192\003\156\006\200\001M\001(\002\201\000\245\006\230\006\206\005_\006\214\002\198\003\156\006\255\002\222\007\020\001\141\002\203\002D\002E\001u\002\207\000\245\002H\002\208\002\200\000\242\000\245\003\156\003\156\005j\002\201\005u\002\161\003\156\003\156\003\156\003\156\002\224\000\245\002\222\002\166\001\141\002\203\007Y\007e\007s\004\148\007u\005q\001.\006\203\003\156\000\245\002\192\002\204\002D\002E\001u\006\237\000\245\006\249\000\245\003\156\002\224\001*\005\129\003\156\005{\001N\000\245\002\161\003\156\006\253\003\156\000\245\000\245\002\207\000\245\002\166\002\208\000\245\001+\000\245\007\001\004\127\003\156\002\201\001\029\0011\005}\005\149\002\192\003\156\005\137\005\148\002\222\005\143\001\141\002\203\007\006\007\018\002D\002E\001u\005\147\007\025\007'\007.\0078\005\162\005\167\000\245\000\245\000\245\006\006\000\245\002\161\002\198\005\172\002\224\001\237\005\175\005\179\007j\002\166\005\187\005\194\005\205\006\005\002H\004P\002\200\000\242\001=\007\149\005\254\005\255\002\192\007\163\001t\001u\0013\006\004\007\175\0014\b\011\006\b\0015\0016\001X\006\t\002D\002E\001u\006(\002\198\006!\b\022\006\"\001v\002z\002\204\001x\001y\b\027\006'\002\161\002H\006=\002\200\000\242\0069\006:\0017\002\166\001\239\001A\006<\007?\006g\004=\006K\006O\002\207\006Q\002\007\002\208\002\192\006S\002\011\006_\001\029\006o\002\201\006q\006r\006w\006{\006\127\002\204\006\145\002\198\002\222\006\152\001\141\002\203\006\156\006\180\006\201\006\225\001%\006\235\007\027\002H\007\021\002\200\000\242\007\022\002D\002E\001u\002\207\007\026\007)\002\208\007T\002\224\007h\007i\007m\002\012\002\201\007\148\002\161\007\152\007\162\002\r\007\166\001}\007\253\002\222\002\166\001\141\002\203\000\000\002\204\000\000\0045\002\014\000\000\001~\002\198\000\000\000\242\002\192\000\000\002D\002E\001u\000\000\000\000\000\000\000\000\002H\002\224\002\200\000\242\002\207\000\000\000\000\002\208\002\161\000\000\000\000\000\000\000\000\000\000\002\201\000\000\002\166\000\000\000\000\000\000\000\000\000\000\002|\002\222\000\000\001\141\002\203\000\000\000\000\002\192\000\000\000\000\002\204\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\000\000\000\000\002\224\000\000\000\000\000\000\001\139\001+\000\000\002\207\002\198\000\000\002\208\001\029\0011\001\140\007|\001\141\001|\002\201\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\002\222\000\000\001\141\002\203\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\198\002D\002E\001u\002\224\000\000\002\204\002\166\000\000\001\237\000\000\000\000\002H\004*\002\200\000\242\002\161\000\000\000\000\0013\002\192\000\000\0014\000\000\002\166\0015\0016\000\000\002\207\000\000\002\189\002\208\000\000\000\000\000\000\000\000\000\000\002\192\002\201\000\000\000\000\000\000\000\000\000\000\002\204\000\000\000\000\002\222\000\000\001\141\002\203\007x\001\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\239\000\000\003~\002\"\000\000\002\208\0044\002\224\000\000\000\000\002\007\000\000\002\201\000\000\002\011\000\000\001\029\000\000\000\000\000\000\002\198\002\222\000\000\001\141\002\203\000\000\000\000\002D\002E\001u\000\000\000\000\002H\000\000\002\200\000\242\000\000\002\198\000\000\000\000\000\000\000\000\002\161\001\239\000\000\002\224\002\030\000\000\000\000\002H\002\166\002\200\000\242\002\007\000\000\002\012\002\206\002\011\000\000\001\029\000\000\002\r\000\000\002\192\002\204\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\002\014\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\204\000\000\000\000\000\000\000\000\002\207\000\000\002\166\002\208\001%\000\000\000\000\007~\002\234\000\000\002\201\000\000\002\012\000\000\000\000\002\192\000\000\002\207\002\r\002\222\002\208\001\141\002\203\000\000\007\028\000\000\000\000\002\201\000\000\000\000\002\014\001(\000\000\000\000\000\000\000\000\002\222\000\000\001\141\002\203\000\000\002\198\b\b\002\224\000\000\007\031\002D\002E\001u\000\000\000\000\000\000\000\000\002H\007 \002\200\000\242\001t\001u\000\000\002\224\002\161\000\000\000\000\000\000\000\000\003v\000\000\000\000\002\166\000\000\000\000\000\000\000\000\003y\002\233\000\000\001v\002z\002\198\001x\001y\002\192\000\000\007!\002\204\000\000\000\000\000\000\000\000\000\000\002H\001*\002\200\000\242\000\000\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\000\000\002{\000\000\002\207\000\000\001+\002\208\002\161\000\000\000\000\000\000\001\029\0011\002\201\000\000\002\166\000\000\007\"\000\000\002\204\000\000\003g\002\222\000\000\001\141\002\203\000\000\007#\002\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\207\002\198\000\000\002\208\000\000\002\224\000\000\b\t\000\000\000\000\002\201\001}\000\000\002H\000\000\002\200\000\242\000\000\000\000\002\222\000\000\001\141\002\203\001~\0013\007%\000\242\0014\000\000\000\000\0015\0016\002D\002E\001u\007&\000\000\000\000\000\000\000\000\007(\000\000\000\000\002\224\000\000\002\204\000\000\002\161\000\000\000\000\000\000\002\198\000\000\007*\000\000\002\166\0017\000\000\002|\000\000\000\000\003n\000\000\002H\000\000\002\200\000\242\002\207\002\192\000\000\002\208\007+\000\000\000\000\000\000\000\000\000\000\002\201\003z\003\128\000\000\000\000\002D\002E\001u\000\000\002\222\001\139\001\141\002\203\001\237\000\000\000\000\000\000\000\000\002\204\001\140\002\161\001\141\001|\000\000\000\000\000\000\000\000\000\000\002\166\000\000\000\000\000\000\000\000\002\224\003u\000\000\000\000\000\000\000\000\000\000\002\207\002\192\000\000\002\208\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002D\002E\001u\000\000\002\198\000\000\000\000\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\002\161\002H\001\239\002\200\000\242\001\240\000\000\000\000\002\166\000\000\000\000\000\000\002\007\007\028\003x\000\000\002\011\002\224\001\029\000\000\000\000\002\192\000\000\002D\002E\001u\000\000\000\000\b\017\000\000\000\000\b\018\000\000\002\204\007\031\000\000\000\000\000\000\002\161\002\198\000\000\000\000\000\000\007 \000\000\000\000\002\166\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\002\207\000\000\002\012\002\208\002\192\000\000\000\000\000\000\002\r\000\000\002\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007!\002\222\002\014\001\141\002\203\000\000\000\000\000\000\000\000\000\000\002\204\000\000\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002H\002\224\002\200\000\242\000\000\000\000\000\000\000\000\002\207\000\000\000\000\002\208\000\000\007\"\000\000\000\000\000\000\000\000\002\201\002D\002E\001u\000\000\007#\000\000\000\000\002\198\002\222\000\000\001\141\002\203\000\000\002\204\000\000\002\161\000\000\000\000\000\000\002H\000\000\002\200\000\242\002\166\b\023\000\000\002D\002E\001u\003\133\000\000\000\000\002\224\000\000\000\000\002\207\002\192\000\000\002\208\000\000\000\000\002\161\000\000\007%\000\000\002\201\002D\002E\001u\002\166\000\000\002\204\000\000\007&\002\222\003\136\001\141\002\203\007(\000\000\000\000\002\161\002\192\000\000\000\000\000\000\000\000\000\000\000\000\002\166\000\000\007*\000\000\003~\000\000\003\162\002\208\003\127\002\224\000\000\000\000\000\000\002\192\002\201\002D\002E\001u\000\000\000\000\007+\000\000\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\002\161\002\198\000\000\000\000\000\000\000\000\000\000\000\000\002\166\000\000\000\000\000\000\000\000\002H\003\166\002\200\000\242\002\224\000\000\000\000\000\000\002\192\000\000\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\002\204\000\000\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\000\000\000\000\002\207\000\000\000\000\002\208\002\204\000\000\001\237\000\000\000\000\000\000\002\201\002D\002E\001u\000\000\000\000\000\000\000\000\002\198\002\222\000\000\001\141\002\203\006)\002\204\000\000\002\207\000\000\000\000\002\208\002H\000\000\002\200\000\242\004\028\000\000\002\201\002D\002E\001u\000\000\000\000\000\000\002\224\000\000\002\222\002\207\001\141\002\203\002\208\000\000\006*\002\161\006+\000\000\000\000\002\201\002D\002E\001u\002\166\001\239\002\204\000\000\002\005\002\222\003\222\001\141\002\203\002\224\000\000\002\007\002\161\002\192\000\000\002\011\000\000\001\029\000\000\000\000\002\166\000\000\000\000\006,\002\207\000\000\003\231\002\208\000\000\002\224\000\000\000\000\000\000\002\192\002\201\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\002\161\002G\000\000\000\000\000\000\000\000\002\012\000\000\002\166\006-\000\000\000\000\002\r\002H\003\240\002\200\000\242\002\224\000\000\006.\006/\002\192\0060\000\000\002\014\000\000\000\000\002\198\000\000\000\000\000\000\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\006j\002\161\002\198\000\000\004\030\000\000\000\000\000\000\000\000\002\166\000\000\000\000\000\000\000\000\002H\004.\002\200\000\242\000\000\000\000\000\000\000\000\002\192\000\000\0062\000\000\002\204\000\000\000\000\0064\006>\000\000\002\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\198\002\202\006h\001\141\002\203\000\000\002\204\000\000\002\207\000\000\000\000\002\208\002H\000\000\002\200\000\242\000\000\000\000\002\201\000\000\006i\000\000\000\000\000\000\000\000\000\000\000\000\002\222\002\207\001\141\002\203\002\208\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002D\002E\001u\000\000\000\000\002\204\000\000\002\198\002\222\000\000\001\141\002\203\002\224\000\000\000\000\002\161\000\000\000\000\000\000\002H\000\000\002\200\000\242\002\166\000\000\000\000\000\000\002\207\000\000\0040\002\208\000\000\002\224\001\237\000\000\000\000\002\192\002\201\002D\002E\001u\000\000\002D\002E\001u\000\000\002\222\000\000\001\141\002\203\000\000\002\204\000\000\002\161\000\000\000\000\000\000\002\161\000\000\000\000\000\000\002\166\000\000\000\000\000\000\002\166\000\000\0047\000\000\000\000\002\224\004:\000\000\002\207\002\192\000\000\002\208\000\000\002\192\000\000\000\000\000\000\000\000\002\201\002D\002E\001u\000\000\001\239\000\000\000\000\002\016\002\222\000\000\001\141\002\203\000\000\000\000\002\007\002\161\002\198\000\000\002\011\000\000\001\029\000\000\000\000\002\166\000\000\000\000\000\000\000\000\002H\004S\002\200\000\242\002\224\000\000\000\000\000\000\002\192\000\000\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\198\000\000\000\000\000\000\002\198\002\012\002\204\002\166\000\000\000\000\000\000\002\r\002H\004V\002\200\000\242\002H\000\000\002\200\000\242\002\192\000\000\000\000\002\014\000\000\000\000\000\000\000\000\002\207\000\000\000\000\002\208\000\000\000\000\000\000\000\000\000\000\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\204\000\000\002\198\002\222\002\204\001\141\002\203\000\000\002D\002E\001u\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\000\000\000\000\002\207\000\000\000\000\002\208\002\207\002\224\000\000\002\208\000\000\005\003\002\201\000\000\000\000\000\000\002\201\000\000\000\000\000\000\002\198\002\222\001%\001\141\002\203\002\222\002\204\001\141\002\203\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\002D\002E\001u\000\000\000\000\002D\002E\001u\002\224\000\000\000\000\002\207\002\224\000\000\002\208\002\161\000\000\000\000\000\000\000\000\002\161\002\201\000\000\002\166\000\000\000\000\000\000\002\204\002\166\004\153\002\222\000\000\001\141\002\203\004\167\000\000\002\192\000\000\000\000\000\000\001%\002\192\000\000\001&\000\000\000\000\000\000\000\000\000\000\002\207\000\000\002G\002\208\000\000\002\224\000\000\000\000\000\000\000\000\002\201\000\000\000\000\000\000\002H\000\000\002\200\000\242\001(\002\222\000\000\001\141\002\203\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001+\000\000\002\224\000\000\000\000\000\000\001\029\0011\000\000\007w\002\198\002D\002E\001u\000\000\002\198\002D\002E\001u\000\000\000\000\000\000\002H\001.\002\200\000\242\002\161\002H\000\000\002\200\000\242\002\161\000\000\000\000\002\166\000\000\000\000\002\201\001*\002\166\004\217\001%\002D\002E\001u\005G\002\202\002\192\001\141\002\203\000\000\000\000\002\192\000\000\002\204\001+\000\000\002\161\000\000\002\204\0013\001\029\0011\0014\000\000\002\166\0015\0016\000\000\000\000\000\000\006~\000\000\000\000\000\000\000\000\002\207\000\000\002\192\002\208\000\000\002\207\000\000\000\000\002\208\000\000\002\201\000\000\000\000\000\000\000\000\002\201\007x\000\000\000\000\002\222\000\000\001\141\002\203\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\001G\000\000\000\000\000\000\002\198\000\000\000\000\000\000\0013\002\198\000\000\0014\002\224\000\000\0015\0016\002H\002\224\002\200\000\242\000\000\002H\001*\002\200\000\242\000\000\000\000\000\000\002D\002E\001u\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\001+\0017\000\000\000\000\002\161\000\000\001\029\0011\002H\002\204\002\200\000\242\002\166\000\000\002\204\002D\002E\001u\006\129\000\000\002D\002E\001u\000\000\000\000\002\192\000\000\000\000\000\000\000\000\002\161\002\207\000\000\000\000\002\208\002\161\002\207\000\000\002\166\002\208\002\204\002\201\000\000\002\166\006\144\000\000\002\201\000\000\000\000\006\147\002\222\002\192\001\141\002\203\000\000\002\222\002\192\001\141\002\203\000\000\0013\000\000\002\207\0014\007\028\002\208\0015\0016\000\000\000\000\000\000\000\000\002\201\000\000\002\224\000\000\000\000\000\000\000\000\002\224\000\000\002\222\007\029\001\141\002\203\007\031\000\000\000\000\000\000\002\198\000\000\000\000\0019\000\000\007 \000\000\000\000\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\002\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\198\002D\002E\001u\000\000\002\198\002D\002E\001u\007!\000\000\000\000\002H\000\000\002\200\000\242\002\161\002H\002\204\002\200\000\242\002\161\000\000\000\000\002\166\000\000\000\000\000\000\000\000\002\166\006\160\000\000\000\000\000\000\000\000\006\163\000\000\002\192\000\000\000\000\002\207\000\000\002\192\002\208\002\204\000\000\007\"\000\000\000\000\002\204\002\201\000\000\000\000\000\000\001%\000\000\007#\000\000\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\002\207\000\000\000\000\002\208\000\000\002\207\000\000\000\000\002\208\000\000\002\201\000\000\000\000\000\000\0079\002\201\000\000\002\224\000\000\002\222\000\000\001\141\002\203\000\000\002\222\000\000\001\141\002\203\000\000\007%\000\000\000\000\000\000\000\000\000\000\002\198\002D\002E\001u\007&\002\198\000\000\000\000\002\224\007(\000\000\000\000\002H\002\224\002\200\000\242\002\161\002H\000\000\002\200\000\242\000\000\007*\000\000\002\166\000\000\000\000\002D\002E\001u\006\184\000\000\002D\002E\001u\000\000\000\000\002\192\000\000\000\000\007+\001*\002\161\000\000\002\204\000\000\000\000\002\161\000\000\002\204\002\166\000\000\000\000\000\000\000\000\002\166\006\187\000\000\001+\000\000\000\000\006\191\000\000\002\192\001\029\0011\002\207\007z\002\192\002\208\000\000\002\207\000\000\000\000\002\208\000\000\002\201\000\000\000\000\000\000\000\000\002\201\000\000\000\000\000\000\002\222\000\000\001\141\002\203\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\224\000\000\000\000\000\000\002H\002\224\002\200\000\242\000\000\0013\000\000\000\000\0014\000\000\000\000\0015\0016\000\000\002\198\002D\002E\001u\000\000\002\198\002D\002E\001u\000\000\000\000\000\000\002H\000\000\002\200\000\242\002\161\002H\002\204\002\200\000\242\002\161\000\000\007x\002\166\000\000\000\000\000\000\000\000\002\166\007\179\001%\000\000\000\000\006\018\007\181\000\000\002\192\000\000\000\000\002\207\000\000\002\192\002\208\002\204\000\000\000\000\000\000\000\000\002\204\002\201\000\000\001%\000\000\000\000\001&\000\000\000\000\001(\002\222\000\000\001\141\002\203\000\000\000\000\000\000\002\207\000\000\000\000\002\208\000\000\002\207\000\000\000\000\002\208\000\000\002\201\000\000\000\000\001(\000\000\002\201\000\000\002\224\000\000\002\222\000\000\001\141\002\203\005T\002\222\000\000\001\141\002\203\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\198\000\000\000\000\006\020\007\174\002\198\000\000\000\000\002\224\000\000\000\000\000\000\002H\002\224\002\200\000\242\000\000\002H\001*\002\200\000\242\000\000\000\000\000\000\001.\002D\002E\001u\000\000\000\000\001t\001u\000\000\000\000\000\000\001+\000\000\000\000\000\000\001*\002\161\001\029\006\023\000\000\002\204\000\000\000\000\004\229\002\166\002\204\001v\002z\000\000\001x\001y\000\000\001+\000\000\004\236\000\000\000\000\002\192\001\029\0011\000\000\000\000\002\207\000\000\000\000\002\208\000\000\002\207\000\000\000\000\002\208\000\000\002\201\000\000\002{\000\000\000\000\002\201\000\000\000\000\000\000\002\222\000\000\001\141\002\203\000\000\002\222\000\000\001\141\002\203\000\000\0013\000\000\000\000\006\024\000\000\000\000\0015\0016\000\000\000\000\000\000\000\000\000\000\001=\002\224\000\000\005\226\000\000\006\029\002\224\006\026\0013\000\000\000\000\0014\000\000\000\000\0015\0016\005]\002\198\000\000\0017\000\000\001}\002D\002E\001u\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\001~\000\000\000\000\000\242\002\161\000\000\000\000\0017\000\000\000\000\001A\000\000\002\166\000\000\000\000\000\000\001t\001u\000\000\000\000\000\000\000\000\004\145\000\000\000\000\002\192\000\000\000\000\002\204\000\000\000\000\000\000\000\000\000\000\000\000\002|\001v\001\135\000\000\001x\001y\000\000\001t\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\175\000\000\003z\003\128\000\000\000\000\002\134\002\201\000\000\001v\001\135\001\139\001x\001y\000\000\000\000\002\222\000\000\001\141\002\203\001\140\000\000\001\141\001|\000\000\000\000\000\000\001\143\000\000\001\144\002d\000\000\002\139\000\000\000\000\000\000\002\198\000\000\000\000\000\000\002\224\000\000\002D\002E\001u\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\001\143\000\000\001\144\002d\002\161\000\000\000\000\000\000\000\000\001\142\001t\001u\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001~\004\"\000\000\000\242\002\192\000\000\002\204\000\000\000\000\001v\001\135\002\142\001x\001y\001\142\000\000\000\000\000\000\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\003\175\002\159\002\161\000\000\000\000\000\000\002\142\002\201\000\000\000\000\002\166\000\000\000\000\000\000\000\000\000\000\002\222\000\000\001\141\002\203\004!\000\000\001\143\002\192\001\144\002d\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\139\000\000\000\000\000\000\002\198\000\000\000\000\002\224\000\000\001\151\000\000\001\141\001|\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\001t\001u\000\000\001\142\000\000\001\139\000\000\001\237\000\000\000\000\000\000\000\000\000\000\000\000\001\151\001~\001\141\001|\000\242\000\000\001v\001\135\000\000\001x\001y\000\000\002\142\002\204\000\000\000\000\001t\001u\000\000\002\198\000\000\000\000\000\000\001t\001u\000\000\000\000\000\000\000\000\002\165\000\000\002H\000\000\002\200\000\242\000\000\001v\001\135\003\175\001x\001y\000\000\000\000\001v\001\135\002\201\001x\001y\001\239\000\000\001\143\002\018\001\144\002d\002\222\000\000\001\141\002\203\002\007\002\197\000\000\000\000\002\011\002\204\001\029\001\139\002\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\002\224\000\000\001\143\000\000\001\144\002d\000\000\001\142\000\000\001\143\003\175\001\144\002d\000\000\000\000\000\000\000\000\002\201\000\000\001~\000\000\000\000\000\242\000\000\000\000\002\012\002\222\000\000\001\141\002\203\002\142\002\r\000\000\000\000\001t\001u\000\000\001\142\000\000\000\000\000\000\001t\001u\002\014\001\142\000\000\000\000\000\000\000\000\001~\002\224\000\000\000\242\000\000\001v\001\135\001~\001x\001y\000\242\002\142\001v\001\135\000\000\001x\001y\000\000\002\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\219\000\000\000\000\000\000\000\000\000\000\001\139\002\228\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\000\000\000\000\001\143\000\000\001\144\002d\000\000\000\000\000\000\001\143\000\000\001\144\002d\000\000\000\000\000\000\000\000\001\139\000\000\001t\001u\000\000\000\000\000\000\001\139\000\000\001\151\000\000\001\141\001|\000\000\000\000\000\000\001\151\000\000\001\141\001|\001\142\000\000\001v\001\135\000\000\001x\001y\001\142\001t\001u\000\000\000\000\001~\001t\001u\000\242\000\000\000\000\000\000\001~\000\000\000\000\000\242\002\142\000\000\002\239\000\000\000\000\001v\001\135\002\142\001x\001y\001v\001\135\000\000\001x\001y\000\000\001t\001u\000\000\000\000\000\000\000\000\000\000\001\143\000\000\001\144\002d\000\000\002\245\000\000\000\000\000\000\000\000\002\251\000\000\000\000\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\143\000\000\001\144\002d\001\139\001\143\000\000\001\144\002d\001\142\003\001\001\139\000\000\001\151\000\000\001\141\001|\000\000\000\000\000\000\001\151\001~\001\141\001|\000\242\000\000\000\000\000\000\000\000\000\000\000\000\001\143\002\142\001\144\002d\001\142\001t\001u\000\000\000\000\001\142\001t\001u\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\001~\000\000\000\000\000\242\001v\001\135\002\142\001x\001y\001v\001\135\002\142\001x\001y\001\142\001t\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001~\003\007\000\000\000\242\000\000\000\000\003\r\001\139\000\000\001v\001\135\002\142\001x\001y\000\000\000\000\001\151\000\000\001\141\001|\000\000\000\000\001\143\000\000\001\144\002d\000\000\001\143\000\000\001\144\002d\000\000\003\019\001\139\000\000\000\000\000\000\000\000\001\139\000\000\000\000\000\000\001\151\000\000\001\141\001|\000\000\001\151\000\000\001\141\001|\000\000\000\000\001\143\000\000\001\144\002d\001\142\001t\001u\000\000\000\000\001\142\000\000\001\139\000\000\001%\000\000\000\000\001~\000\000\000\000\000\242\001\151\001~\001\141\001|\000\242\001v\001\135\002\142\001x\001y\000\000\000\000\002\142\000\000\000\000\001\142\001t\001u\000\000\000\000\000\000\001t\001u\000\000\000\000\000\000\000\000\001~\003\025\000\000\000\242\000\000\000\000\000\000\000\000\000\000\001v\001\135\002\142\001x\001y\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\001\143\000\000\001\144\002d\000\000\000\000\000\000\000\000\000\000\000\000\003\031\001\139\000\000\000\000\000\000\003%\001\139\000\000\000\000\000\000\001\151\000\000\001\141\001|\000\000\001\151\000\000\001\141\001|\000\000\000\000\001\143\001*\001\144\002d\001\142\001\143\000\000\001\144\002d\000\000\000\000\001\139\000\000\000\000\000\000\000\000\001~\000\000\001+\000\242\001\151\000\000\001\141\001|\001\029\0011\000\000\002\142\000\000\000\000\000\000\000\000\000\000\001t\001u\001\142\000\000\000\000\001\237\000\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\001~\001v\001\135\000\242\001x\001y\002\142\000\000\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003+\000\000\0013\000\000\001\139\0014\000\000\000\000\0015\0016\000\000\001%\000\000\001\151\000\000\001\141\001|\001\239\000\000\000\000\002.\001\143\000\000\001\144\002d\000\000\000\000\002\007\000\000\000\000\000\000\002\011\000\000\001\029\002\128\001\139\000\000\001t\001u\000\000\001\139\004\198\000\000\000\000\001\151\000\000\001\141\001|\004\204\001\151\000\000\001\141\001|\001t\001u\000\000\001\142\001v\001\135\000\000\001x\001y\000\000\001t\001u\000\000\000\000\000\000\001~\000\000\000\000\000\242\002\012\001v\001\135\000\000\001x\001y\002\r\002\142\0031\000\000\000\000\001v\001\135\000\000\001x\001y\000\000\000\000\002\014\001t\001u\000\000\000\000\000\000\0037\000\000\000\000\001*\000\000\001\143\000\000\001\144\002d\000\000\003=\000\000\000\000\000\000\000\000\001v\001\135\000\000\001x\001y\001+\001\143\000\000\001\144\002d\000\000\001\029\0011\000\000\000\000\000\000\001\143\000\000\001\144\002d\000\000\001\139\000\000\003C\000\000\001\142\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\000\000\000\000\000\000\001~\000\000\000\000\000\242\001\142\000\000\000\000\001\143\000\000\001\144\002d\002\142\001\237\000\000\001\142\000\000\001~\000\000\000\000\000\242\001t\001u\000\000\000\000\000\000\000\000\001~\002\142\0013\000\242\000\000\0014\000\000\000\000\0015\0016\000\000\002\142\004\210\000\000\001v\001\135\001\142\001x\001y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\000\000\004\213\000\000\000\000\003I\001\139\002\142\000\000\001\239\000\000\000\000\002T\000\000\000\000\001\151\000\000\001\141\001|\002\007\000\000\000\000\001\139\002\011\000\000\001\029\001\143\000\000\001\144\002d\000\000\001\151\001\139\001\141\001|\000\000\000\000\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001t\001u\000\000\000\000\000\000\000\000\001\139\001\142\000\000\000\000\002\012\000\000\000\000\001t\001u\001\151\002\r\001\141\001|\001~\001v\001\135\000\242\001x\001y\000\000\000\000\000\000\002\014\000\000\002\142\000\000\000\000\001v\001\135\000\000\001x\001y\001t\001u\000\000\000\000\000\000\003O\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003U\000\000\001v\001\135\000\000\001x\001y\000\000\001\143\000\000\001\144\002d\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\143\000\000\001\144\002d\003[\000\000\001\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\000\000\001t\001u\001\142\000\000\000\000\001\143\000\000\001\144\002d\000\000\000\000\000\000\000\000\000\000\001~\001\142\000\000\000\242\000\000\000\000\001v\001\135\000\000\001x\001y\002\142\000\000\001~\000\000\000\000\000\242\000\000\000\000\003e\001u\000\000\000\000\000\000\002\142\000\000\001\142\000\000\000\000\003a\000\000\000\000\002D\002E\001u\000\000\000\000\000\000\001~\003\129\001\135\000\242\001x\001y\000\000\000\000\000\000\002\161\000\000\002\142\001\143\000\000\001\144\002d\000\000\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\139\003\172\000\000\000\000\002\192\000\000\001\237\001\237\000\000\001\151\000\000\001\141\001|\001\139\000\000\000\000\000\000\000\000\003\134\003\150\003\151\001\142\001\151\000\000\001\141\001|\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\001\139\000\000\000\000\000\000\000\000\000\000\002\142\000\000\000\000\001\151\000\000\001\141\001|\000\000\000\000\000\000\001\142\000\000\000\000\000\000\002D\002E\001u\001\239\001\239\000\000\004\162\004\247\001~\000\000\002\198\000\242\000\000\002\007\002\007\002\161\000\000\002\011\002\011\001\029\001\029\000\000\002H\002\166\002\200\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\177\000\000\000\000\002\192\000\000\000\000\001\139\000\000\003\154\003\155\000\000\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\000\000\000\000\002\204\000\000\000\000\000\000\002\012\002\012\001%\000\000\000\000\001&\002\r\002\r\000\000\000\000\000\000\000\000\000\000\000\000\001\139\000\000\000\000\000\000\002\014\002\014\000\000\003\175\000\000\001\151\000\000\001\141\001|\000\000\002\201\001(\000\000\000\000\002D\002E\001u\000\000\000\000\002\222\000\000\001\141\002\203\000\000\002\198\000\000\000\000\000\000\000\000\002\161\000\000\002D\002E\001u\000\000\000\000\002H\002\166\002\200\000\242\000\000\000\000\000\000\002\224\000\000\000\000\002\161\003\179\000\000\000\000\002\192\002D\002E\001u\002\166\000\000\000\000\001.\001t\001u\000\000\000\000\000\000\000\000\003\183\000\000\002\161\002\192\002\204\000\000\000\000\000\000\001*\000\000\002\166\000\000\000\000\000\000\001v\001\135\000\000\001x\001y\000\000\003\191\000\000\000\000\002\192\000\000\001+\000\000\000\000\000\000\003\175\000\000\001\029\0011\000\000\000\000\000\000\002\201\003\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\222\000\000\001\141\002\203\000\000\002\198\000\000\000\000\002D\002E\001u\000\000\000\000\001\143\000\000\001\144\002d\002H\000\000\002\200\000\242\000\000\002\198\002\161\002\224\000\000\000\000\000\000\000\000\000\000\000\000\002\166\001=\000\000\002H\000\000\002\200\000\242\000\000\000\000\0013\003\201\002\198\0014\002\192\000\000\0015\0016\001\142\002\204\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\001~\000\000\000\000\000\242\000\000\000\000\002\204\000\000\000\000\000\000\000\000\002\142\0017\000\000\003\175\001T\001t\001u\000\000\000\000\000\000\002\201\000\000\000\000\000\000\000\000\002\204\000\000\000\000\000\000\002\222\003\175\001\141\002\203\000\000\000\000\001v\001\135\002\201\001x\001y\000\000\000\000\000\000\000\000\000\000\000\000\002\222\002\198\001\141\002\203\003\175\000\000\000\000\002\224\000\000\000\000\000\000\002\201\003\208\002H\000\000\002\200\000\242\001\139\000\000\000\000\002\222\000\000\001\141\002\203\002\224\006)\001\151\000\000\001\141\001|\000\000\000\000\000\000\001\143\000\000\001\144\002d\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\224\002\204\002D\002E\001u\000\000\000\000\001t\001u\006*\007\169\006+\000\000\000\000\000\000\000\000\000\000\002\161\000\000\000\000\000\000\000\000\000\000\000\000\001\142\002\166\003\175\001v\001\135\000\000\001x\001y\000\000\002\201\000\000\003\211\001~\000\000\002\192\000\242\000\000\006,\002\222\000\000\001\141\002\203\000\000\002\142\000\000\000\000\003\218\000\000\000\000\002D\002E\001u\000\000\000\000\001t\001u\000\000\000\000\000\000\000\000\000\000\000\000\002\224\000\000\002\161\000\000\000\000\001\143\000\000\001\144\002d\000\000\002\166\006-\001v\001\135\000\000\001x\001y\000\000\001t\001u\003\251\006.\006/\002\192\0060\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\139\003\228\002\198\000\000\001v\001\135\001\142\001x\001y\001\151\000\000\001\141\001|\006l\002H\000\000\002\200\000\242\001~\000\000\000\000\000\242\001\143\000\000\001\144\002d\000\000\003\237\000\000\002\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0062\001t\001u\000\000\000\000\0064\006>\000\000\000\000\002\204\000\000\001\143\000\000\001\144\002d\000\000\002\198\000\000\006h\000\000\001\142\001v\001\135\000\000\001x\001y\000\000\000\000\002H\000\000\002\200\000\242\001~\000\000\003\175\000\242\006i\000\000\000\000\000\000\000\000\002\201\000\000\002\142\003\246\001\139\001\142\000\000\000\000\000\000\002\222\000\000\001\141\002\203\001\151\000\000\001\141\001|\001~\000\000\002\204\000\242\000\000\000\000\000\000\001\143\000\000\001\144\002d\002\142\000\000\000\000\000\000\000\000\002\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\175\000\000\000\000\000\000\000\000\000\000\000\000\002\201\001t\001u\000\000\001\139\000\000\000\000\000\000\001\142\002\222\000\000\001\141\002\203\001\151\000\000\001\141\001|\002D\002E\001u\001~\001v\001\135\000\242\001x\001y\000\000\000\000\000\000\000\000\001\139\002\142\002\161\002\224\000\000\001t\001u\000\000\000\000\001\151\002\166\001\141\001|\000\000\004\001\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\002\192\000\000\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\000\000\000\000\001\143\000\000\001\144\002d\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\n\000\000\000\000\000\000\000\000\000\000\001\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\000\000\000\000\001\143\001\142\001\144\002d\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\002\198\002\161\000\000\000\000\000\000\000\000\002\142\000\000\000\000\002\166\000\000\000\000\002H\000\000\002\200\000\242\000\000\001\142\000\000\004\r\000\000\000\000\002\192\002D\002E\001u\000\000\000\000\000\000\001~\001t\001u\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\142\000\000\000\000\000\000\002\204\000\000\004}\000\000\000\000\000\000\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\000\000\001\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\151\003\175\001\141\001|\000\000\004\019\000\000\000\000\002\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\222\002\198\001\141\002\203\000\000\001t\001u\000\000\001\139\001\143\000\000\001\144\002d\002H\000\000\002\200\000\242\001\151\000\000\001\141\001|\000\000\000\000\000\000\002\224\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\000\000\000\000\002D\002E\001u\002G\000\000\002D\002E\001u\000\000\001\142\002\204\000\000\000\000\004\026\000\000\002H\000\000\002\200\000\242\000\000\002\161\001~\000\000\004\028\000\242\002D\002E\001u\002\166\000\000\000\000\000\000\002\142\000\000\001\143\003\175\001\144\002d\004%\000\000\002\161\002\192\002\201\000\000\001t\001u\000\000\004\029\002\166\000\000\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\004(\000\000\000\000\002\192\000\000\000\000\001v\001\135\000\000\001x\001y\001\142\000\000\000\000\000\000\000\000\000\000\002\224\000\000\000\000\000\000\002\201\000\000\001~\000\000\000\000\000\242\001\139\000\000\004B\002\202\000\000\001\141\002\203\002\142\000\000\001\151\000\000\001\141\001|\000\000\000\000\002G\000\000\000\000\000\000\000\000\002\198\000\000\000\000\001\143\000\000\001\144\002d\002H\000\000\002\200\000\242\000\000\002H\000\000\002\200\000\242\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\001t\001u\001\142\000\000\001\139\000\000\000\000\004\031\002\204\000\000\001\237\000\000\000\000\001\151\001~\001\141\001|\000\242\001t\001u\001v\001\135\000\000\001x\001y\002\142\000\000\000\000\002\204\000\000\000\000\000\000\000\000\003\175\000\000\002\201\000\000\000\000\001v\001\135\002\201\001x\001y\004G\002\202\000\000\001\141\002\203\000\000\002\222\000\000\001\141\002\203\003\175\000\000\000\000\000\000\000\000\000\000\000\000\002\201\004N\000\000\000\000\001\143\001\239\001\144\002d\005\012\002\222\000\000\001\141\002\203\002\224\000\000\002\007\000\000\000\000\001\139\002\011\000\000\001\029\001\143\000\000\001\144\002d\000\000\001\151\000\000\001\141\001|\000\000\000\000\002\224\000\000\002D\002E\001u\000\000\001\142\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\161\001~\000\000\000\000\000\242\002\161\000\000\001\142\002\166\000\000\002\012\000\000\002\142\002\166\001t\001u\002\r\000\000\004`\001~\000\000\002\192\000\242\004e\000\000\000\000\002\192\000\000\002\014\000\000\002\142\000\000\000\000\000\000\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003e\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\136\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\139\003\129\001\135\000\000\001x\001y\000\000\000\000\000\000\001\151\000\000\001\141\001|\001\143\000\000\001\144\002d\000\000\001\139\000\000\002\198\000\000\000\000\000\000\000\000\002\198\000\000\001\151\000\000\001\141\001|\000\000\002H\000\000\002\200\000\242\000\000\002H\000\000\002\200\000\242\000\000\000\000\000\000\003\134\003\150\003\151\000\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\001t\001u\000\000\000\000\000\000\001~\000\000\000\000\000\242\002\204\000\000\000\000\000\000\000\000\002\204\000\000\002\142\000\000\000\000\000\000\001v\001\135\000\000\001x\001y\001\142\000\000\000\000\000\000\001\237\000\000\000\000\000\000\000\000\003\175\000\000\000\000\001~\000\000\003\175\000\242\002\201\000\000\004\233\000\000\000\000\002\201\000\000\000\000\000\000\002\222\000\000\001\141\002\203\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\000\000\000\000\001\143\000\000\001\144\002d\000\000\001\139\003\154\004\223\000\000\000\000\002\224\000\000\000\000\000\000\001\151\002\224\001\141\001|\001t\001u\001\239\000\000\000\000\005\016\000\000\000\000\001%\000\000\000\000\001&\002\007\001t\001u\000\000\002\011\001\142\001\029\001\139\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\001\151\001~\001\141\001|\000\242\001v\001\135\001(\001x\001y\000\000\000\000\002\142\000\000\000\000\005\000\000\000\005T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001%\005\007\002\012\001&\000\000\000\000\005W\000\000\002\r\001\143\000\000\001\144\002d\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\014\000\000\001\143\000\000\001\144\002d\001.\001(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005T\001\139\000\000\000\000\001*\000\000\000\000\001\142\000\000\000\000\001\151\000\000\001\141\001|\000\000\000\000\005\208\000\000\001%\001~\001\142\001+\000\242\000\000\000\000\000\000\000\000\001\029\0011\000\000\002\142\000\000\001~\000\000\000\000\000\242\001.\000\000\001t\001u\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\006\164\000\000\000\000\001v\002z\000\000\001x\001y\000\000\000\000\000\000\001%\000\000\001+\001&\000\000\000\000\000\000\001=\001\029\0011\000\000\000\000\000\000\000\000\000\000\0013\000\000\001\139\0014\000\000\002{\0015\0016\005]\000\000\000\000\001\151\001(\001\141\001|\001\139\000\000\000\000\000\000\000\000\001\237\000\000\005T\000\000\001\151\001*\001\141\001|\000\000\000\000\000\000\000\000\0017\000\000\000\000\001A\000\000\000\000\006\161\001=\001%\000\000\001+\001&\000\000\000\000\000\000\0013\001\029\0011\0014\000\000\000\000\0015\0016\005]\001}\000\000\001.\000\000\000\000\000\000\001\237\001t\001u\000\000\000\000\001(\001~\000\000\000\000\000\242\000\000\001*\000\000\001\239\000\000\005T\005\019\0017\006\188\000\000\001A\001v\002z\002\007\001x\001y\000\000\002\011\001+\001\029\000\000\006\175\000\000\000\000\001\029\0011\000\000\000\000\000\000\000\000\0013\002|\000\000\0014\000\000\000\000\0015\0016\000\000\002{\000\000\001.\000\000\000\000\000\000\001\239\000\000\000\000\005\026\000\000\001%\003z\003\128\001&\000\000\002\007\001*\000\000\002\012\002\011\001\139\001\029\004\200\000\000\002\r\000\000\000\000\000\000\000\000\001\140\001=\001\141\001|\001+\000\000\000\000\002\014\001(\0013\001\029\0011\0014\000\000\000\000\0015\0016\005]\005T\003e\001u\001}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\012\000\000\001~\006\185\000\000\000\242\002\r\000\000\003\129\001\135\0017\001x\001y\001A\000\000\000\000\000\000\000\000\002\014\000\000\000\000\000\000\000\000\001.\000\000\001=\003e\001u\000\000\000\000\000\000\000\000\000\000\0013\000\000\000\000\0014\002|\001*\0015\0016\005]\000\000\000\000\000\000\000\000\003\129\001\135\000\000\001x\001y\003\134\003\150\003\151\000\000\001+\000\000\003z\003\128\000\000\000\000\001\029\0011\000\000\000\000\0017\001\139\000\000\001A\000\000\000\000\000\000\000\000\000\000\000\000\001\140\000\000\001\141\001|\000\000\000\000\000\000\000\000\000\000\000\000\001t\001u\001\142\000\000\003\134\003\150\003\151\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\000\000\001v\001\135\001=\001x\001y\000\000\000\000\000\000\000\000\000\000\0013\001%\000\000\0014\001&\000\000\0015\0016\005]\000\000\001\142\000\000\000\000\007N\000\000\000\000\000\000\003\154\006\202\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\000\000\001(\000\000\007\129\000\000\0017\000\000\001\143\001A\001\144\002d\001%\000\000\000\000\001&\000\000\000\000\000\000\000\000\000\000\000\000\001\139\000\000\000\000\000\000\000\000\000\000\000\000\003\154\006\236\001\151\000\000\001\141\001|\000\000\000\000\000\000\000\000\001(\000\000\000\000\000\000\001\142\002D\002E\001u\000\000\001.\004\185\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\001\139\000\000\000\000\001*\007r\000\000\002\142\004\028\000\000\001\151\000\000\001\141\001|\000\000\000\000\001t\001u\000\000\000\000\000\000\001+\000\000\002D\002E\001u\001.\001\029\0011\000\000\000\000\000\000\006\221\000\000\000\000\000\000\001v\001\135\002\161\001x\001y\001*\000\000\000\000\000\000\000\000\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001+\002\192\001\139\000\000\000\000\000\000\001\029\0011\000\000\000\000\000\000\001\151\000\000\001\141\001|\001=\000\000\002D\002E\001u\000\000\000\000\001\143\0013\001\144\001\162\0014\002G\000\000\0015\0016\007\136\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002H\002\166\002\200\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000m\000\000\001=\002\192\000\000\0017\000\000\001\142\001A\000\000\0013\001t\001u\0014\000\000\002\198\0015\0016\000\000\001~\000\000\000\000\000\242\000\000\000\000\004\031\000\000\002H\000\000\002\200\000\242\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\000\000\000\000\001\204\0017\000\000\000\000\004\192\000\000\000\000\000\000\000\000\001t\001u\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\204\000\000\000\000\002\202\000\000\001\141\002\203\000\000\002\198\000\000\000\000\001v\001\135\000\000\001x\001y\001\143\000\000\001\144\001\192\002H\001\189\002\200\000\242\001\139\005\021\000\000\000\000\000\000\000\000\000\000\000\000\002\201\001\151\000\000\001\141\001|\000\000\000\000\000\000\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\001t\001u\000\000\001\142\002\204\000\000\000\000\001\143\000\000\001\144\001\192\000\000\000\000\000\000\000\000\001~\000\000\002\224\000\242\000\000\001v\001\135\000\000\001x\001y\000\000\002D\002E\001u\004\234\001\194\000\000\000\000\000\000\000\000\000\000\002\201\000\000\000\000\000\000\000\000\002\161\001\142\000\000\000\000\002\222\000\000\001\141\002\203\002\166\000\000\000\000\001t\001u\001~\000\000\000\000\000\242\000\000\000\000\000\000\000\000\002\192\000\000\001\143\000\000\001\144\001\192\000\000\002\224\000\000\000\000\001v\002z\000\000\001x\001y\000\000\000\000\001\139\000\000\000\000\001t\001u\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\001t\001u\000\000\000\000\000\000\000\000\000\000\001\142\002{\000\000\001v\001\135\000\000\001x\001y\000\000\002D\002E\001u\001~\001v\001\135\000\242\001x\001y\000\000\001\139\000\000\000\000\000\000\000\000\002\161\000\000\000\000\002\198\001\151\000\000\001\141\001|\002\166\000\000\000\000\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\002\192\000\000\001\143\000\000\001\144\002d\000\000\001}\000\000\000\000\000\000\000\000\001\143\000\000\001\144\002l\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\000\000\000\000\002\204\000\000\000\000\000\000\000\000\001\139\000\000\000\000\000\000\000\000\000\000\001\142\000\000\000\000\001\151\000\000\001\141\001|\000\000\000\000\000\000\001\142\000\000\001~\000\000\004\137\000\242\000\000\002|\000\000\000\000\000\000\002\201\001~\004;\000\000\000\242\000\000\002\198\000\000\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\002~\003\128\002H\000\000\002\200\000\242\001t\001u\000\000\001\139\002D\002E\001u\000\000\000\000\002o\000\000\002\224\001\140\000\000\001\141\001|\000\000\000\000\000\000\002\161\001v\001\135\000\000\001x\001y\000\000\000\000\002\166\002\204\000\000\000\000\000\000\000\000\001\139\000\000\000\000\000\000\000\000\000\000\000\000\002\192\000\000\001\151\001\139\001\141\001|\000\000\000\000\000\000\000\000\000\000\000\000\001\151\0043\001\141\001|\000\000\000\000\000\000\000\000\002\201\000\000\000\000\000\000\001\143\000\000\001\144\002d\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002D\002E\001u\000\000\000\000\002D\002E\001u\002\224\000\000\000\000\001\237\000\000\000\000\001\142\002\161\000\000\000\000\000\000\002\198\002\161\000\000\000\000\002\166\000\000\000\000\001~\000\000\002\166\000\242\000\000\002H\000\000\002\200\000\242\000\000\002\192\002\141\000\000\000\000\000\000\002\192\002D\002E\001u\000\000\000\000\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\161\000\000\000\000\000\000\000\000\002\161\002\204\000\000\002\166\001\239\001\237\000\000\005\030\002\166\000\000\000\000\000\000\000\000\000\000\002\007\000\000\002\192\000\000\002\011\000\000\001\029\002\192\000\000\000\000\000\000\000\000\004 \000\000\001\139\000\000\000\000\000\000\000\000\002\201\000\000\000\000\000\000\001\151\002\198\001\141\001|\000\000\002\222\002\198\001\141\002\203\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\002H\000\000\002\200\000\242\002\012\001\239\000\000\000\000\005!\000\000\002\r\002\224\000\000\000\000\000\000\002\007\000\000\000\000\000\000\002\011\000\000\001\029\002\014\000\000\000\000\002\198\000\000\002\204\007\028\000\000\002\198\000\000\002\204\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\002H\b\017\002\200\000\242\b\018\000\000\000\000\007\031\000\000\000\000\003\160\000\000\000\000\000\000\000\000\002\214\007 \002\201\002\012\000\000\000\000\000\000\002\201\000\000\002\r\000\000\002\222\002\204\001\141\002\203\000\000\002\222\002\204\001\141\002\203\000\000\002\014\000\000\002D\002E\001u\000\000\000\000\002D\002E\001u\007!\000\000\000\000\000\000\002\224\000\000\002\220\002\161\000\000\002\224\000\000\002\229\002\161\002\201\000\000\002\166\000\000\000\000\002\201\000\000\002\166\000\000\002\222\000\000\001\141\002\203\000\000\002\222\002\192\001\141\002\203\000\000\000\000\002\192\002D\002E\001u\007\"\000\000\002D\002E\001u\000\000\000\000\000\000\000\000\002\224\007#\000\000\002\161\000\000\002\224\000\000\000\000\002\161\000\000\000\000\002\166\001t\001u\001\237\000\000\002\166\000\000\000\000\000\000\000\000\b\028\000\000\000\000\002\192\000\000\000\000\000\000\000\000\002\192\000\000\000\000\001v\002z\000\000\001x\001y\000\000\000\000\000\000\007%\000\000\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\007&\002\198\000\000\000\000\000\000\007(\000\000\000\000\002H\000\000\002\200\000\242\000\000\002H\000\000\002\200\000\242\000\000\007*\001\239\000\000\000\000\005/\000\000\002D\002E\001u\000\000\000\000\002\007\000\000\000\000\000\000\002\011\000\000\001\029\007+\000\000\002\198\002\161\002\204\000\000\000\000\002\198\000\000\002\204\000\000\002\166\000\000\000\000\002H\000\000\002\200\000\242\000\000\002H\000\000\002\200\000\242\000\000\002\192\001}\000\000\000\000\000\000\002\240\000\000\000\000\000\000\000\000\002\246\000\000\002\201\001~\002\012\000\000\000\242\002\201\001%\000\000\002\r\002\222\002\204\001\141\002\203\000\000\002\222\002\204\001\141\002\203\000\000\001%\002\014\000\000\006\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\224\000\000\002\252\006\215\000\000\002\224\000\000\003\002\000\000\002\201\000\000\000\000\000\000\001(\002\201\002D\002E\001u\002\222\002\198\001\141\002\203\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\002\161\002H\001\139\002\200\000\242\002D\002E\001u\002\166\000\000\000\000\001\140\002\224\001\141\001|\000\000\000\000\002\224\000\000\000\000\002\161\002\192\000\000\000\000\006\227\000\000\000\000\000\000\002\166\006\020\000\000\001*\000\000\002\204\000\000\000\000\002D\002E\001u\000\000\000\000\002\192\000\000\000\000\001*\000\000\000\000\000\000\001+\000\000\000\000\002\161\000\000\000\000\001\029\0011\000\000\000\000\003\b\002\166\000\000\001+\000\000\000\000\000\000\002\201\000\000\001\029\006\023\000\000\000\000\000\000\002\192\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\198\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002H\002\224\002\200\000\242\002\161\000\000\000\000\000\000\002\198\000\000\000\000\0013\002\166\000\000\0014\000\000\000\000\0015\0016\000\000\002H\000\000\002\200\000\242\0013\002\192\000\000\006\024\000\000\000\000\0015\0016\002\204\000\000\000\000\002D\002E\001u\000\000\002\198\005\226\000\000\006\028\004\208\006\026\002D\002E\001u\000\000\000\000\002\161\002H\002\204\002\200\000\242\000\000\0017\003\014\002\166\000\000\002\161\000\000\000\000\000\000\002\201\000\000\000\000\000\000\002\166\000\000\000\000\002\192\000\000\002\222\000\000\001\141\002\203\003\020\000\000\000\000\000\000\002\192\000\000\002\204\002\201\000\000\000\000\000\000\000\000\002\198\000\000\000\000\000\000\002\222\000\000\001\141\002\203\002\224\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\000\000\003\026\000\000\000\000\000\000\000\000\000\000\000\000\002\201\000\000\002\224\000\000\000\000\000\000\000\000\000\000\000\000\002\222\000\000\001\141\002\203\002D\002E\001u\000\000\000\000\002\204\000\000\002\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\161\000\000\002\198\000\000\002H\002\224\002\200\000\242\002\166\000\000\000\000\000\000\000\000\000\000\002H\003 \002\200\000\242\000\000\000\000\000\000\002\192\002\201\000\000\002D\002E\001u\000\000\002D\002E\001u\002\222\000\000\001\141\002\203\000\000\002\204\000\000\000\000\002\161\000\000\000\000\000\000\000\000\000\000\000\000\002\204\002\166\000\000\000\000\000\000\002F\002D\002E\001u\002\224\000\000\000\000\000\000\000\000\002\192\003&\000\000\000\000\000\000\000\000\000\000\002\161\002\201\000\000\000\000\003,\000\000\000\000\000\000\002\166\000\000\002\222\002\201\001\141\002\203\000\000\000\000\000\000\000\000\002\198\000\000\002\222\002\192\001\141\002\203\002D\002E\001u\000\000\000\000\000\000\002H\000\000\002\200\000\242\002\224\000\000\000\000\000\000\000\000\002\161\000\000\002D\002E\001u\002\224\000\000\000\000\002\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\161\002\198\000\000\000\000\002\192\002G\002\204\000\000\002\166\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\002H\000\000\002\200\000\242\002\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\198\000\000\0032\000\000\000\000\000\000\000\000\000\000\000\000\002\201\000\000\000\000\002H\000\000\002\200\000\242\002\204\000\000\002\222\000\000\001\141\002\203\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\161\000\000\002\198\001%\0038\002\224\001&\002\204\002\166\000\000\001\237\002\201\000\000\000\000\002H\002\201\002\200\000\242\000\000\002\198\002\222\002\192\001\141\002\203\002\202\000\000\001\141\002\203\000\000\000\000\001(\002H\003>\002\200\000\242\002D\002E\001u\000\000\002\201\003o\002D\002E\001u\002\224\000\000\002\204\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\000\000\002\161\000\000\002\151\000\000\000\000\000\000\000\000\002\204\002\166\001\239\000\000\000\000\005\127\000\000\000\000\003D\002\224\000\000\000\000\002\007\001.\002\192\002\201\002\011\000\000\001\029\000\000\000\000\000\000\002\198\000\000\002\222\003J\001\141\002\203\001*\000\000\000\000\000\000\002\201\000\000\002H\000\000\002\200\000\242\002D\002E\001u\002\222\000\000\001\141\002\203\001+\000\000\000\000\002\224\000\000\000\000\001\029\0011\002\161\000\000\000\000\000\000\002\012\002D\002E\001u\002\166\000\000\002\r\000\000\002\224\002\204\000\000\000\000\000\000\000\000\000\000\002G\002\161\002\192\002\014\000\000\000\000\002\198\000\000\000\000\002\166\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\002H\003P\002\200\000\242\002\192\000\000\000\000\001=\002\201\000\000\000\000\000\000\000\000\000\000\000\000\0013\000\000\002\222\0014\001\141\002\203\0015\0016\002\175\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\224\000\000\000\000\000\000\000\000\000\000\0017\002\198\000\000\001A\002D\002E\001u\000\000\000\000\000\000\003V\002\201\000\000\002H\000\000\002\200\000\242\002\201\000\000\002\161\002\202\002\198\001\141\002\203\000\000\000\000\002\222\002\166\001\141\002\203\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\000\000\002\192\000\000\000\000\000\000\000\000\002\204\002D\002E\001u\000\000\002\224\002D\002E\001u\000\000\000\000\002D\002E\001u\000\000\000\000\002\161\000\000\000\000\000\000\002\204\002\161\000\000\000\000\002\166\003\\\002\161\000\000\000\000\002\166\000\000\000\000\002\201\000\000\002\166\000\000\000\000\002\192\000\000\000\000\000\000\002\222\002\192\001\141\002\203\003b\001%\002\192\000\000\000\000\000\000\000\000\002\201\000\000\000\000\000\000\000\000\000\000\000\000\002\198\000\000\002\222\000\000\001\141\002\203\002\224\000\000\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\224\000\000\000\000\000\000\000\000\001%\000\000\000\000\006\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\198\000\000\002\204\000\000\000\000\002\198\002D\002E\001u\000\000\002\198\000\000\002H\000\000\002\200\000\242\001(\002H\000\000\002\200\000\242\002\161\002H\000\000\002\200\000\242\000\000\003\199\000\000\002\166\000\000\000\000\000\000\001*\002\201\000\000\000\000\002D\002E\001u\000\000\000\000\002\192\002\222\002\204\001\141\002\203\000\000\000\000\002\204\001+\000\000\002\161\000\000\002\204\000\000\001\029\0011\000\000\000\000\002\166\000\000\006\020\000\000\000\000\000\000\000\000\002\224\000\000\003\209\000\000\000\000\000\000\002\192\003\219\000\000\002\201\001*\000\000\003\229\000\000\002\201\000\000\000\000\000\000\002\222\002\201\001\141\002\203\000\000\002\222\000\000\001\141\002\203\001+\002\222\000\000\001\141\002\203\000\000\001\029\006\023\000\000\000\000\000\000\000\000\002\198\000\000\000\000\002\224\0013\000\000\000\000\0014\002\224\000\000\0015\0016\002H\002\224\002\200\000\242\000\000\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002D\002E\001u\000\000\002\198\002\161\000\000\000\000\000\000\004\212\002D\002E\001u\002\166\000\000\002\161\002H\002\204\002\200\000\242\000\000\0013\000\000\002\166\006\024\002\161\002\192\0015\0016\000\000\000\000\000\000\000\000\002\166\000\000\000\000\002\192\005\226\000\000\006\027\000\000\006\026\003\238\000\000\000\000\000\000\002\192\000\000\002\204\002\201\000\000\000\000\000\000\0017\000\000\000\000\000\000\000\000\002\222\000\000\001\141\002\203\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\247\000\000\000\000\000\000\000\000\000\000\000\000\002\201\000\000\002\224\000\000\000\000\000\000\000\000\000\000\000\000\002\222\002\198\001\141\002\203\002D\002E\001u\000\000\000\000\000\000\000\000\002\198\000\000\002H\000\000\002\200\000\242\000\000\000\000\002\161\000\000\002\198\000\000\002H\002\224\002\200\000\242\002\166\000\000\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\000\000\002\192\000\000\000\000\001t\001u\002\204\002D\002E\001u\000\000\000\000\000\000\000\000\000\000\000\000\002\204\002D\002E\001u\000\000\000\000\002\161\000\000\001v\001\138\002\204\001x\001y\000\000\002\166\004\002\002\161\000\000\000\000\000\000\000\000\000\000\002\201\000\000\002\166\004\011\000\000\002\192\000\000\000\000\000\000\002\222\002\201\001\141\002\203\004\020\000\000\002\192\000\000\000\000\000\000\002\222\002\201\001\141\002\203\000\000\000\000\000\000\000\000\002\198\000\000\002\222\000\000\001\141\002\203\002\224\000\000\000\000\000\000\000\000\000\000\002H\000\000\002\200\000\242\002\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\224\000\000\000\000\000\000\000\000\000\000\002D\002E\001u\000\000\000\000\000\000\001}\001\207\001u\000\000\002\198\000\000\002\204\000\000\000\000\002\161\000\000\000\000\001~\000\000\002\198\000\242\002H\002\166\002\200\000\242\000\000\001v\002Y\000\000\001x\001y\002H\000\000\002\200\000\242\002\192\004\027\000\000\000\000\000\000\000\000\000\000\000\000\002\201\000\000\000\000\001%\000\000\001%\001&\000\000\001&\002\222\002\204\001\141\002\203\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\204\000\000\000\000\000\000\000\000\000\000\004Q\003\150\003\151\000\000\001(\000\000\001(\002\224\000\000\004I\000\000\005\219\001\139\000\000\004\185\000\000\002\201\000\000\000\000\004H\000\000\001\140\000\000\001\141\001|\002\222\002\201\001\141\002\203\004\188\002\198\000\000\000\000\000\000\000\000\002\222\001\142\001\141\002\203\000\000\000\000\000\000\002H\000\000\002\200\000\242\000\000\000\000\001~\002\224\001.\000\242\001.\001%\000\000\000\000\001&\000\000\000\000\002\224\000\000\000\000\000\000\000\000\000\000\001*\000\000\001*\000\000\000\000\000\000\000\000\000\000\001%\002\204\000\000\001&\004X\000\000\000\000\001(\000\000\001+\001%\001+\000\000\001&\000\000\001\029\0011\001\029\0011\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004O\001(\000\000\000\000\000\000\000\000\006\210\002\201\000\000\000\000\000\000\001(\000\000\001\139\000\000\000\000\002\222\000\000\001\141\002\203\000\000\000\000\001\151\000\000\001\141\001|\000\000\001.\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001=\000\000\001=\000\000\000\000\002\224\000\000\001*\0013\000\000\0013\0014\001.\0014\0015\0016\0015\0016\005\224\000\000\000\000\000\000\001.\000\000\001+\000\000\000\000\001*\000\000\000\000\001\029\0011\000\000\000\000\000\000\000\000\001%\001*\000\000\001&\0017\000\000\0017\004\192\001+\001A\000\000\000\000\000\000\000\000\001\029\0011\000\000\000\000\001+\000\000\000\000\000\000\000\000\000\000\001\029\0011\000\000\001(\000\000\001t\001u\000\000\000\000\000\000\001%\000\000\000\000\001&\000\000\000\000\001=\000\000\001t\001u\000\000\000\000\000\000\000\000\0013\001v\001\135\0014\001x\001y\0015\0016\005\237\000\000\000\000\005\240\001=\001(\001v\001\135\000\000\001x\001y\000\000\0013\007\214\001=\0014\000\000\001.\0015\0016\005\224\000\000\0013\000\000\0017\0014\000\000\001A\0015\0016\005\237\000\000\001*\007\000\000\000\000\000\000\000\001\143\000\000\001\144\007\242\000\000\007\244\000\000\0017\000\000\000\000\001A\000\000\001+\001\143\001.\001\144\007B\0017\001\029\0011\001A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\001&\001+\001~\001\142\000\000\000\242\000\000\001\029\0011\001%\000\000\000\000\001&\000\000\000\000\001~\000\000\000\000\000\242\001=\000\000\000\000\000\000\000\000\001(\000\000\000\000\0013\001t\001u\0014\000\000\000\000\0015\0016\007\215\001(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001R\000\000\000\000\000\000\001v\001\135\000\000\001x\001y\001=\000\000\000\000\000\000\000\000\000\000\0017\000\000\0013\001A\000\000\0014\000\000\001\139\0015\0016\001h\001.\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\001\139\000\000\000\000\001.\000\000\000\000\001*\000\000\000\000\001\151\000\000\001\141\001|\001\143\0017\001\144\001\196\001A\001*\000\000\000\000\000\000\000\000\001+\000\000\000\000\000\000\000\000\000\000\001\029\0011\000\000\000\000\001t\001u\001+\000\000\000\000\000\000\000\000\000\000\001\029\0011\000\000\000\000\000\000\001t\001u\001\142\000\000\000\000\000\000\000\000\001v\001\135\000\000\001x\001y\000\000\000\000\001~\000\000\000\000\000\242\000\000\000\000\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\000\000\001=\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0013\001t\001u\0014\001=\000\000\0015\0016\001>\000\000\000\000\000\000\0013\000\000\001\143\0014\001\144\001\184\0015\0016\000\000\001v\001\135\000\000\001x\001y\000\000\001\143\000\000\001\144\001\181\000\000\0017\000\000\000\000\001A\000\000\000\000\000\000\000\000\000\000\001\139\000\000\000\000\0017\000\000\000\000\001V\000\000\001\142\001\151\000\000\001\141\001|\000\000\001t\001u\000\000\000\000\000\000\000\000\001~\001\142\000\000\000\242\001\143\000\000\001\144\001\180\000\000\000\000\000\000\000\000\000\000\001~\001v\001\135\000\242\001x\001y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001t\001u\000\000\000\000\000\000\000\000\000\000\001\142\001%\000\000\000\000\001&\000\000\001t\001u\000\000\000\000\000\000\000\000\001~\001v\001\135\000\242\001x\001y\000\000\001\143\000\000\001\144\001\146\000\000\000\000\001\139\001v\001\135\001(\001x\001y\000\000\001t\001u\001\151\000\000\001\141\001|\001\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\000\000\001v\001\135\001\142\001x\001y\001\143\000\000\001\144\001\149\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\242\001\143\000\000\001\144\001\179\001.\000\000\001\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\001*\000\000\000\000\001\142\000\000\001\237\000\000\001\143\001%\001\144\001\167\001&\000\000\000\000\000\000\001~\001\142\001+\000\242\000\000\000\000\000\000\000\000\001\029\0011\000\000\000\000\000\000\001~\001%\000\000\000\242\001&\000\000\000\000\001(\000\000\000\000\000\000\000\000\000\000\001\139\001\142\000\000\001t\001u\000\000\000\000\000\000\000\000\001\151\000\000\001\141\001|\001~\000\000\001(\000\242\000\000\000\000\001\239\000\000\000\000\005\139\001v\001\135\000\000\001x\001y\001=\002\007\000\000\000\000\000\000\002\011\000\000\001\029\0013\000\000\001\139\0014\001.\000\000\0015\0016\001\170\000\000\000\000\001\151\000\000\001\141\001|\001\139\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\001\151\001.\001\141\001|\000\000\000\000\000\000\001\143\0017\001\144\001\175\001A\001+\000\000\002\012\000\000\001*\001\139\001\029\0011\002\r\001%\000\000\000\000\001&\000\000\001\151\000\000\001\141\001|\000\000\000\000\002\014\001+\000\000\000\000\000\000\001\237\000\000\001\029\0011\000\000\001\142\001%\000\000\000\000\001&\000\000\001(\000\000\000\000\000\000\000\000\000\000\001~\000\000\000\000\000\242\000\000\000\000\000\000\000\000\001%\000\000\001=\001&\000\000\000\000\000\000\000\000\001(\000\000\0013\000\000\000\000\0014\000\000\000\000\0015\0016\001\212\000\000\000\000\000\000\000\000\001=\000\000\000\000\000\000\001(\000\000\000\000\001\239\0013\001.\005\145\0014\000\000\000\000\0015\0016\001\253\002\007\000\000\0017\000\000\002\011\001A\001\029\001*\000\000\000\000\000\000\000\000\000\000\000\000\001.\001%\001\139\000\000\001&\000\000\000\000\000\000\000\000\0017\001+\001\151\001A\001\141\001|\001*\001\029\0011\000\000\001.\000\000\001t\001u\000\000\000\000\000\000\000\000\000\000\001(\000\000\000\000\002\012\001+\000\000\001*\000\000\000\000\002\r\001\029\0011\000\000\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\002\014\000\000\001+\001%\000\000\000\000\001&\000\000\001\029\0011\000\000\000\000\000\000\001=\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0013\000\000\000\000\0014\001.\000\000\0015\0016\001\255\001(\000\000\000\000\000\000\001%\001=\001\143\001&\001\144\002\146\001*\000\000\000\000\0013\000\000\000\000\0014\000\000\000\000\0015\0016\002[\000\000\0017\001=\000\000\001A\001+\000\000\000\000\000\000\001(\0013\001\029\0011\0014\000\000\000\000\0015\0016\002n\001\142\000\000\000\000\000\000\0017\001.\000\000\001A\001t\001u\000\000\000\000\001~\001%\000\000\000\242\001&\000\000\000\000\000\000\001*\000\000\000\000\0017\000\000\000\000\001A\000\000\001v\001\158\000\000\001x\001y\000\000\000\000\000\000\001.\001+\001=\000\000\001(\000\000\000\000\001\029\0011\000\000\0013\000\000\000\000\0014\000\000\001*\0015\0016\002\172\000\000\000\000\001%\000\000\000\000\001&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001+\000\000\000\000\000\000\000\000\000\000\001\029\0011\001\139\000\000\0017\000\000\000\000\001A\000\000\000\000\001(\001\151\001.\001\141\001|\001=\001t\001u\000\000\000\000\000\000\000\000\000\000\0013\000\000\000\000\0014\001*\000\000\0015\0016\002\177\000\000\001}\000\000\000\000\001v\001\135\000\000\001x\001y\000\000\000\000\000\000\001+\001~\001=\000\000\000\242\000\000\001\029\0011\000\000\000\000\0013\0017\001.\0014\001A\000\000\0015\0016\003l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\001t\001u\001\143\000\000\001\144\003\139\000\000\000\000\0017\000\000\001+\001A\000\000\000\000\000\000\000\000\001\029\0011\001=\000\000\001v\001\135\000\000\001x\001y\000\000\0013\001t\001u\0014\000\000\001\139\0015\0016\003s\000\000\000\000\001\142\000\000\000\000\001\140\000\000\001\141\001|\000\000\000\000\000\000\001v\001\135\001~\001x\001y\000\242\000\000\000\000\000\000\000\000\000\000\0017\000\000\000\000\001A\001=\000\000\001\143\000\000\001\144\003\142\000\000\000\000\0013\000\000\000\000\0014\000\000\000\000\0015\0016\003\131\000\000\001t\001u\000\000\000\000\000\000\002D\002E\001u\000\000\000\000\000\000\001\143\000\000\001\144\003\145\000\000\001t\001u\000\000\001\142\001v\001\135\0017\001x\001y\001A\000\000\000\000\004m\000\000\000\000\001~\001\237\001\139\000\242\004u\001v\001\135\000\000\001x\001y\000\000\001\151\000\000\001\141\001|\001\142\000\000\000\000\000\000\001%\000\000\000\000\001&\000\000\000\000\000\000\000\000\001~\004v\000\000\000\242\001%\000\000\001\143\001&\001\144\003\153\000\000\000\000\000\000\001%\000\000\000\000\001&\000\000\000\000\001(\000\000\000\000\001\143\000\000\001\144\005E\000\000\000\000\000\000\001\239\000\000\001(\005\155\000\000\000\000\000\000\000\000\001\139\000\000\002\007\001(\001\142\000\000\002\011\000\000\001\029\001\151\002G\001\141\001|\000\000\000\000\000\000\001~\000\000\000\000\000\242\001\142\000\000\004y\000\000\002\200\000\242\001\b\001\139\001.\000\000\000\000\001%\001~\000\000\001&\000\242\001\151\000\000\001\141\001|\001.\000\000\000\000\001*\000\000\000\000\000\000\002\012\000\000\001.\000\000\000\000\000\000\002\r\000\000\001*\000\000\000\000\001(\004p\001+\000\000\000\000\000\000\001*\002\014\001\029\0011\000\000\000\000\000\000\000\000\001+\001%\000\000\000\000\001&\000\000\001\029\0011\001\139\001+\001%\000\000\000\000\001/\002\201\001\029\0011\001\151\000\000\001\141\001|\000\000\000\000\002\202\001\139\001\141\002\203\000\000\001(\000\000\000\000\000\000\001.\001\151\000\000\001\141\001|\001(\001%\000\000\001=\006\018\000\000\000\000\000\000\000\000\000\000\001*\0013\000\000\000\000\0014\001=\000\000\0015\0016\005V\000\000\000\000\000\000\0013\001=\000\000\0014\001+\001(\0015\0016\005\185\0013\001\029\0011\0014\000\000\001.\0015\0016\005\197\000\000\000\000\0017\000\000\001%\001A\000\000\006\018\000\000\000\000\000\000\001*\000\000\000\000\0017\000\000\000\000\001A\000\000\000\000\001*\000\000\000\000\0017\000\000\000\000\001A\000\000\001+\000\000\000\000\001(\000\000\006\020\001\029\0011\000\000\001+\001=\001%\000\000\000\000\001&\001\029\0011\000\000\0013\000\000\001*\0014\000\000\000\000\0015\0016\005\223\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001+\001(\000\000\000\000\000\000\000\000\001\029\006\023\000\000\000\000\000\000\000\000\006\020\0017\000\000\001=\001A\000\000\001%\000\000\000\000\001&\000\000\0013\000\000\000\000\0014\001*\000\000\0015\0016\005\239\0013\000\000\000\000\0014\000\000\000\000\0015\0016\000\000\000\000\000\000\000\000\001+\001(\000\000\001.\000\000\000\000\001\029\006\023\000\000\000\000\000\000\0017\000\000\000\000\001A\000\000\0013\000\000\001*\006\024\0017\000\000\0015\0016\001%\000\000\000\000\001&\000\000\000\000\000\000\000\000\005\226\000\000\006\025\001+\006\026\000\000\000\000\000\000\000\000\001\029\0011\000\000\000\000\000\000\001%\001.\0017\006\018\000\000\001(\000\000\000\000\002D\002E\001u\000\000\000\000\000\000\0013\000\000\001*\006\024\000\000\000\000\0015\0016\000\000\000\000\000\000\000\000\000\000\001(\000\000\000\000\005\226\002\153\006%\001+\006\026\000\000\000\000\000\000\000\000\001\029\0011\001=\001%\000\000\000\000\006\018\0017\000\000\000\000\0013\000\000\001.\0014\000\000\000\000\0015\0016\006\140\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\001(\000\000\000\000\000\000\006\020\000\000\001%\000\000\000\000\001&\000\000\000\000\0017\000\000\001+\001A\001=\000\000\000\000\001*\001\029\0011\000\000\000\000\0013\001%\000\000\0014\001&\000\000\0015\0016\006\158\001(\000\000\000\000\001+\001%\000\000\002G\001&\000\000\001\029\006\023\000\000\000\000\006\020\000\000\000\000\000\000\000\000\002H\001(\002\200\000\242\000\000\0017\000\000\000\000\001A\000\000\001*\000\000\000\000\001(\000\000\001=\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0013\000\000\000\000\0014\001+\001.\0015\0016\006\182\000\000\001\029\006\023\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\0013\000\000\001.\006\024\000\000\000\000\0015\0016\000\000\000\000\0017\000\000\000\000\001A\001.\001+\005\226\001*\006\242\002\201\006\026\001\029\0011\000\000\000\000\000\000\000\000\006)\002\202\001*\001\141\002\203\0017\000\000\001+\000\000\000\000\000\000\000\000\000\000\001\029\0011\0013\000\000\000\000\006\024\001+\000\000\0015\0016\000\000\000\000\001\029\0011\000\000\006*\007\188\006+\005\226\000\000\007\012\000\000\006\026\000\000\000\000\000\000\001%\001=\000\000\001&\000\000\000\000\000\000\000\000\0017\0013\000\000\000\000\0014\000\000\000\000\0015\0016\007E\000\000\000\000\001=\006,\001%\000\000\000\000\001&\000\000\001(\0013\000\000\000\000\0014\001=\000\000\0015\0016\007\135\000\000\000\000\000\000\0013\0017\000\000\0014\001A\000\000\0015\0016\007\138\001(\000\000\000\000\000\000\000\000\000\000\001%\000\000\006-\001&\000\000\0017\000\000\000\000\001A\000\000\000\000\000\000\006.\006/\000\000\0060\000\000\0017\001.\000\000\001A\000\000\000\000\001t\001u\000\000\000\000\001(\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\006l\000\000\001.\000\000\000\000\001v\002z\000\000\001x\001y\001%\000\000\001+\001&\000\000\000\000\000\000\001*\001\029\0011\000\000\000\000\000\000\000\000\0062\007\190\000\000\000\000\000\000\0064\006>\000\000\000\000\000\000\001+\001.\000\000\001(\001t\001u\001\029\0011\006h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001v\002z\006i\001x\001y\000\000\001=\000\000\000\000\001+\000\000\000\000\000\000\000\000\0013\001\029\0011\0014\000\000\000\000\0015\0016\000\000\000\000\000\000\001.\001}\000\000\001=\000\000\000\000\001t\001u\000\000\000\000\000\000\0013\006)\001~\0014\001*\000\242\0015\0016\000\000\000\000\0017\000\000\000\000\001\248\000\000\001v\002y\000\000\001x\001y\000\000\001+\000\000\000\000\000\000\001=\000\000\001\029\0011\006*\000\000\006+\0017\0013\000\000\001\250\0014\007\015\000\000\0015\0016\000\000\000\000\001}\001%\000\000\000\000\001&\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001~\001%\000\000\000\242\006\014\000\000\006,\000\000\000\000\000\000\0017\001\139\000\000\004\187\000\000\000\000\001(\000\000\0012\000\000\001\140\000\000\001\141\001|\000\000\000\000\0013\000\000\001(\0014\000\000\000\000\0015\0016\007\016\007\015\002D\002E\001u\001}\000\000\000\000\006-\000\000\002D\002E\001u\000\000\000\000\000\000\000\000\001~\006.\006/\000\242\0060\000\000\000\000\0017\002\184\000\000\000\000\001.\000\000\001\139\000\000\000\000\002\199\002D\002E\001u\000\000\000\000\001\140\000\000\001\141\001|\001*\0061\000\000\000\000\002D\002E\001u\000\000\000\000\000\000\007\024\000\000\001*\000\000\002\223\000\000\000\000\001+\000\000\000\000\000\000\000\000\000\000\001\029\0011\0062\000\000\003\188\000\000\001+\0064\006>\000\000\000\000\000\000\001\029\0011\001%\001\139\000\000\006\021\000\000\000\000\006h\000\000\000\000\000\000\001\140\000\000\001\141\001|\000\000\000\000\000\000\000\000\001\237\000\000\000\000\000\000\002G\000\000\006i\000\000\000\000\001(\000\000\000\000\002G\000\000\007\128\000\000\002H\000\000\002\200\000\242\000\000\000\000\0013\000\000\002H\0014\002\200\000\242\0015\0016\000\000\000\000\000\000\000\000\0013\000\000\002G\0014\000\000\000\000\0015\0016\000\000\000\000\000\000\000\000\000\000\000\000\002H\002G\002\200\000\242\000\000\000\000\0017\001\239\000\000\000\000\005\164\000\000\000\000\002H\000\000\002\200\000\242\002\007\0017\000\000\000\000\002\011\001*\001\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\201\000\000\000\000\000\000\000\000\000\000\000\000\001+\002\201\002\202\000\000\001\141\002\203\001\029\0011\000\000\000\000\002\202\000\000\001\141\002\203\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\012\000\000\002\201\000\000\000\000\000\000\002\r\000\000\000\000\000\000\000\000\002\202\000\000\001\141\002\203\002\201\000\000\000\000\002\014\000\000\000\000\000\000\000\000\000\000\002\202\000\000\001\141\002\203\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0013\000\000\000\000\0014\000\000\000\000\0015\0016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0017"))
   
   and semantic_action =
     [|
@@ -1447,9 +1486,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3972 "parsing/parser.mly"
+# 4024 "parsing/parser.mly"
                                                 ( "+" )
-# 1453 "parsing/parser.ml"
+# 1492 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -1472,9 +1511,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3973 "parsing/parser.mly"
+# 4025 "parsing/parser.mly"
                                                 ( "+." )
-# 1478 "parsing/parser.ml"
+# 1517 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -1497,9 +1536,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.core_type) = 
-# 3469 "parsing/parser.mly"
+# 3514 "parsing/parser.mly"
       ( _1 )
-# 1503 "parsing/parser.ml"
+# 1542 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -1542,40 +1581,42 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_ty_ in
         let _endpos = _endpos__2_inlined1_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let tyvar =
-              let (_endpos__2_, _2) = (_endpos__2_inlined1_, _2_inlined1) in
-              let _endpos = _endpos__2_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 3417 "parsing/parser.mly"
+            let _1 =
+              let tyvar =
+                let (_endpos__2_, _2) = (_endpos__2_inlined1_, _2_inlined1) in
+                let _endpos = _endpos__2_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 3462 "parsing/parser.mly"
     ( mkrhs _2 _sloc )
-# 1556 "parsing/parser.ml"
+# 1596 "parsing/parser.ml"
+                
+              in
+              
+# 3517 "parsing/parser.mly"
+        ( Ptyp_alias(ty, tyvar) )
+# 1602 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__2_inlined1_, _startpos_ty_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3472 "parsing/parser.mly"
-        ( Ptyp_alias(ty, tyvar) )
-# 1562 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 1612 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__2_inlined1_, _startpos_ty_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 1572 "parsing/parser.ml"
-          
-        in
-        
-# 3474 "parsing/parser.mly"
+          (
+# 3519 "parsing/parser.mly"
     ( _1 )
-# 1578 "parsing/parser.ml"
-         in
+# 1618 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -1618,34 +1659,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (let_binding) = let attrs2 =
-          let _1 = _1_inlined2 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined2 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 1627 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined2_ in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 1669 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined2_ in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 1636 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2705 "parsing/parser.mly"
+# 1678 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2747 "parsing/parser.mly"
     (
       let attrs = attrs1 @ attrs2 in
       mklb ~loc:_sloc false body attrs
     )
-# 1648 "parsing/parser.ml"
-         in
+# 1690 "parsing/parser.ml"
+           : (let_binding))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -1667,9 +1710,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3856 "parsing/parser.mly"
+# 3908 "parsing/parser.mly"
       ( _1 )
-# 1673 "parsing/parser.ml"
+# 1716 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -1692,9 +1735,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3857 "parsing/parser.mly"
+# 3909 "parsing/parser.mly"
                                  ( Lident _1 )
-# 1698 "parsing/parser.ml"
+# 1741 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -1717,9 +1760,9 @@ module Tables = struct
         let _startpos = _startpos_type__ in
         let _endpos = _endpos_type__ in
         let _v : (Parsetree.core_type) = 
-# 3605 "parsing/parser.mly"
+# 3650 "parsing/parser.mly"
       ( type_ )
-# 1723 "parsing/parser.ml"
+# 1766 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -1741,43 +1784,45 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let tid =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let tid =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 1754 "parsing/parser.ml"
+# 1798 "parsing/parser.ml"
+                
+              in
+              let tys = 
+# 3683 "parsing/parser.mly"
+      ( [] )
+# 1804 "parsing/parser.ml"
+               in
+              
+# 3654 "parsing/parser.mly"
+        ( Ptyp_constr (tid, tys) )
+# 1809 "parsing/parser.ml"
               
             in
-            let tys = 
-# 3638 "parsing/parser.mly"
-      ( [] )
-# 1760 "parsing/parser.ml"
-             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3609 "parsing/parser.mly"
-        ( Ptyp_constr (tid, tys) )
-# 1765 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 1818 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 1774 "parsing/parser.ml"
-          
-        in
-        
-# 3623 "parsing/parser.mly"
+          (
+# 3668 "parsing/parser.mly"
   ( _1 )
-# 1780 "parsing/parser.ml"
-         in
+# 1824 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -1805,44 +1850,46 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_ty_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let tid =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let tid =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 1818 "parsing/parser.ml"
+# 1864 "parsing/parser.ml"
+                
+              in
+              let tys = 
+# 3685 "parsing/parser.mly"
+      ( [ ty ] )
+# 1870 "parsing/parser.ml"
+               in
+              
+# 3654 "parsing/parser.mly"
+        ( Ptyp_constr (tid, tys) )
+# 1875 "parsing/parser.ml"
               
             in
-            let tys = 
-# 3640 "parsing/parser.mly"
-      ( [ ty ] )
-# 1824 "parsing/parser.ml"
-             in
+            let _startpos__1_ = _startpos_ty_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3609 "parsing/parser.mly"
-        ( Ptyp_constr (tid, tys) )
-# 1829 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 1885 "parsing/parser.ml"
             
           in
-          let _startpos__1_ = _startpos_ty_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 1839 "parsing/parser.ml"
-          
-        in
-        
-# 3623 "parsing/parser.mly"
+          (
+# 3668 "parsing/parser.mly"
   ( _1 )
-# 1845 "parsing/parser.ml"
-         in
+# 1891 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -1884,59 +1931,61 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let tid =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let tid =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 1898 "parsing/parser.ml"
-              
-            in
-            let tys =
+# 1946 "parsing/parser.ml"
+                
+              in
               let tys =
-                let xs = 
-# 253 "<standard.mly>"
+                let tys =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 1906 "parsing/parser.ml"
-                 in
-                
-# 1143 "parsing/parser.mly"
+# 1954 "parsing/parser.ml"
+                   in
+                  
+# 1167 "parsing/parser.mly"
     ( xs )
-# 1911 "parsing/parser.ml"
+# 1959 "parsing/parser.ml"
+                  
+                in
+                
+# 3687 "parsing/parser.mly"
+      ( tys )
+# 1965 "parsing/parser.ml"
                 
               in
               
-# 3642 "parsing/parser.mly"
-      ( tys )
-# 1917 "parsing/parser.ml"
+# 3654 "parsing/parser.mly"
+        ( Ptyp_constr (tid, tys) )
+# 1971 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3609 "parsing/parser.mly"
-        ( Ptyp_constr (tid, tys) )
-# 1923 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 1981 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 1933 "parsing/parser.ml"
-          
-        in
-        
-# 3623 "parsing/parser.mly"
+          (
+# 3668 "parsing/parser.mly"
   ( _1 )
-# 1939 "parsing/parser.ml"
-         in
+# 1987 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -1964,44 +2013,46 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__2_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let cid =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let cid =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 1977 "parsing/parser.ml"
+# 2027 "parsing/parser.ml"
+                
+              in
+              let tys = 
+# 3683 "parsing/parser.mly"
+      ( [] )
+# 2033 "parsing/parser.ml"
+               in
+              
+# 3658 "parsing/parser.mly"
+        ( Ptyp_class (cid, tys) )
+# 2038 "parsing/parser.ml"
               
             in
-            let tys = 
-# 3638 "parsing/parser.mly"
-      ( [] )
-# 1983 "parsing/parser.ml"
-             in
+            let _startpos__1_ = _startpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3613 "parsing/parser.mly"
-        ( Ptyp_class (cid, tys) )
-# 1988 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2048 "parsing/parser.ml"
             
           in
-          let _startpos__1_ = _startpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 1998 "parsing/parser.ml"
-          
-        in
-        
-# 3623 "parsing/parser.mly"
+          (
+# 3668 "parsing/parser.mly"
   ( _1 )
-# 2004 "parsing/parser.ml"
-         in
+# 2054 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2036,44 +2087,46 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_ty_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let cid =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let cid =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 2049 "parsing/parser.ml"
+# 2101 "parsing/parser.ml"
+                
+              in
+              let tys = 
+# 3685 "parsing/parser.mly"
+      ( [ ty ] )
+# 2107 "parsing/parser.ml"
+               in
+              
+# 3658 "parsing/parser.mly"
+        ( Ptyp_class (cid, tys) )
+# 2112 "parsing/parser.ml"
               
             in
-            let tys = 
-# 3640 "parsing/parser.mly"
-      ( [ ty ] )
-# 2055 "parsing/parser.ml"
-             in
+            let _startpos__1_ = _startpos_ty_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3613 "parsing/parser.mly"
-        ( Ptyp_class (cid, tys) )
-# 2060 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2122 "parsing/parser.ml"
             
           in
-          let _startpos__1_ = _startpos_ty_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 2070 "parsing/parser.ml"
-          
-        in
-        
-# 3623 "parsing/parser.mly"
+          (
+# 3668 "parsing/parser.mly"
   ( _1 )
-# 2076 "parsing/parser.ml"
-         in
+# 2128 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2122,59 +2175,61 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let cid =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let cid =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 2136 "parsing/parser.ml"
-              
-            in
-            let tys =
+# 2190 "parsing/parser.ml"
+                
+              in
               let tys =
-                let xs = 
-# 253 "<standard.mly>"
+                let tys =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 2144 "parsing/parser.ml"
-                 in
-                
-# 1143 "parsing/parser.mly"
+# 2198 "parsing/parser.ml"
+                   in
+                  
+# 1167 "parsing/parser.mly"
     ( xs )
-# 2149 "parsing/parser.ml"
+# 2203 "parsing/parser.ml"
+                  
+                in
+                
+# 3687 "parsing/parser.mly"
+      ( tys )
+# 2209 "parsing/parser.ml"
                 
               in
               
-# 3642 "parsing/parser.mly"
-      ( tys )
-# 2155 "parsing/parser.ml"
+# 3658 "parsing/parser.mly"
+        ( Ptyp_class (cid, tys) )
+# 2215 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3613 "parsing/parser.mly"
-        ( Ptyp_class (cid, tys) )
-# 2161 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2225 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 2171 "parsing/parser.ml"
-          
-        in
-        
-# 3623 "parsing/parser.mly"
+          (
+# 3668 "parsing/parser.mly"
   ( _1 )
-# 2177 "parsing/parser.ml"
-         in
+# 2231 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2209,39 +2264,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_type__ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let mod_ident =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let mod_ident =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 2222 "parsing/parser.ml"
+# 2278 "parsing/parser.ml"
+                
+              in
+              
+# 3662 "parsing/parser.mly"
+        ( Ptyp_open (mod_ident, type_) )
+# 2284 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos_type__ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3617 "parsing/parser.mly"
-        ( Ptyp_open (mod_ident, type_) )
-# 2228 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 2294 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_type__ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 2238 "parsing/parser.ml"
-          
-        in
-        
-# 3623 "parsing/parser.mly"
+          (
+# 3668 "parsing/parser.mly"
   ( _1 )
-# 2244 "parsing/parser.ml"
-         in
+# 2300 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2269,27 +2326,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_ident_ in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 = 
-# 3619 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3664 "parsing/parser.mly"
         ( Ptyp_var ident )
-# 2277 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos_ident_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 2335 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos_ident_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 2286 "parsing/parser.ml"
-          
-        in
-        
-# 3623 "parsing/parser.mly"
+# 2344 "parsing/parser.ml"
+            
+          in
+          (
+# 3668 "parsing/parser.mly"
   ( _1 )
-# 2292 "parsing/parser.ml"
-         in
+# 2350 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2310,26 +2369,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 = 
-# 3621 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3666 "parsing/parser.mly"
         ( Ptyp_any )
-# 2318 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 2378 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 2326 "parsing/parser.ml"
-          
-        in
-        
-# 3623 "parsing/parser.mly"
+# 2386 "parsing/parser.ml"
+            
+          in
+          (
+# 3668 "parsing/parser.mly"
   ( _1 )
-# 2332 "parsing/parser.ml"
-         in
+# 2392 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2350,26 +2411,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Ast_helper.str) = let _1 =
-          let _1 = 
-# 4039 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 4091 "parsing/parser.mly"
                      ( _1 )
-# 2358 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 990 "parsing/parser.mly"
+# 2420 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1014 "parsing/parser.mly"
     ( mkloc _1 (make_loc _sloc) )
-# 2366 "parsing/parser.ml"
-          
-        in
-        
-# 4041 "parsing/parser.mly"
+# 2428 "parsing/parser.ml"
+            
+          in
+          (
+# 4093 "parsing/parser.mly"
     ( _1 )
-# 2372 "parsing/parser.ml"
-         in
+# 2434 "parsing/parser.ml"
+           : (Ast_helper.str))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2404,27 +2467,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Ast_helper.str) = let _1 =
-          let _1 = 
-# 4040 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 4092 "parsing/parser.mly"
                                  ( _1 ^ "." ^ _3.txt )
-# 2412 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 990 "parsing/parser.mly"
+# 2476 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1014 "parsing/parser.mly"
     ( mkloc _1 (make_loc _sloc) )
-# 2421 "parsing/parser.ml"
-          
-        in
-        
-# 4041 "parsing/parser.mly"
+# 2485 "parsing/parser.ml"
+            
+          in
+          (
+# 4093 "parsing/parser.mly"
     ( _1 )
-# 2427 "parsing/parser.ml"
-         in
+# 2491 "parsing/parser.ml"
+           : (Ast_helper.str))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2446,11 +2511,11 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.payload) = 
-# 4096 "parsing/parser.mly"
+# 4148 "parsing/parser.mly"
     ( Builtin_attributes.mark_payload_attrs_used _1;
       _1
     )
-# 2454 "parsing/parser.ml"
+# 2519 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -2493,14 +2558,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.attribute) = let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 4045 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 4097 "parsing/parser.mly"
     ( mk_attr ~loc:(make_loc _sloc) _2 _3 )
-# 2503 "parsing/parser.ml"
-         in
+# 2569 "parsing/parser.ml"
+           : (Parsetree.attribute))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2522,9 +2589,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.class_expr) = 
-# 1975 "parsing/parser.mly"
+# 1997 "parsing/parser.mly"
       ( _1 )
-# 2528 "parsing/parser.ml"
+# 2595 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -2560,22 +2627,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.class_expr) = let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 2569 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1977 "parsing/parser.mly"
+# 2637 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1999 "parsing/parser.mly"
       ( wrap_class_attrs ~loc:_sloc _3 _2 )
-# 2578 "parsing/parser.ml"
-         in
+# 2646 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2610,14 +2679,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.class_expr) = let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1979 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2001 "parsing/parser.mly"
       ( class_of_let_bindings ~loc:_sloc _1 _3 )
-# 2620 "parsing/parser.ml"
-         in
+# 2690 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2673,41 +2744,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : (Parsetree.class_expr) = let _5 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let _5 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 2685 "parsing/parser.ml"
-          
-        in
-        let _endpos__5_ = _endpos__1_inlined2_ in
-        let _4 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 2757 "parsing/parser.ml"
+            
+          in
+          let _endpos__5_ = _endpos__1_inlined2_ in
+          let _4 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 2694 "parsing/parser.ml"
-          
-        in
-        let _3 = 
-# 3964 "parsing/parser.mly"
+# 2766 "parsing/parser.ml"
+            
+          in
+          let _3 = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 2700 "parsing/parser.ml"
-         in
-        let _endpos = _endpos__7_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1981 "parsing/parser.mly"
+# 2772 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2003 "parsing/parser.mly"
       ( let loc = (_startpos__2_, _endpos__5_) in
         let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
         mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
-# 2710 "parsing/parser.ml"
-         in
+# 2782 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2770,41 +2843,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : (Parsetree.class_expr) = let _5 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let _5 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 2782 "parsing/parser.ml"
-          
-        in
-        let _endpos__5_ = _endpos__1_inlined3_ in
-        let _4 =
-          let _1 = _1_inlined2 in
-          
-# 4062 "parsing/parser.mly"
+# 2856 "parsing/parser.ml"
+            
+          in
+          let _endpos__5_ = _endpos__1_inlined3_ in
+          let _4 =
+            let _1 = _1_inlined2 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 2791 "parsing/parser.ml"
-          
-        in
-        let _3 = 
-# 3965 "parsing/parser.mly"
+# 2865 "parsing/parser.ml"
+            
+          in
+          let _3 = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 2797 "parsing/parser.ml"
-         in
-        let _endpos = _endpos__7_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1981 "parsing/parser.mly"
+# 2871 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2003 "parsing/parser.mly"
       ( let loc = (_startpos__2_, _endpos__5_) in
         let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
         mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
-# 2807 "parsing/parser.ml"
-         in
+# 2881 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2833,9 +2908,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.class_expr) = 
-# 1985 "parsing/parser.mly"
+# 2007 "parsing/parser.mly"
       ( Cl.attr _1 _2 )
-# 2839 "parsing/parser.ml"
+# 2914 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -2864,41 +2939,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.class_expr) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let _2 =
+                let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 2874 "parsing/parser.ml"
-               in
-              
-# 1062 "parsing/parser.mly"
+# 2950 "parsing/parser.ml"
+                 in
+                
+# 1086 "parsing/parser.mly"
     ( xs )
-# 2879 "parsing/parser.ml"
+# 2955 "parsing/parser.ml"
+                
+              in
+              
+# 2010 "parsing/parser.mly"
+        ( Pcl_apply(_1, _2) )
+# 2961 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos_xs_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1988 "parsing/parser.mly"
-        ( Pcl_apply(_1, _2) )
-# 2885 "parsing/parser.ml"
+# 1037 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 2971 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_xs_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
-    ( mkclass ~loc:_sloc _1 )
-# 2895 "parsing/parser.ml"
-          
-        in
-        
-# 1991 "parsing/parser.mly"
+          (
+# 2013 "parsing/parser.mly"
       ( _1 )
-# 2901 "parsing/parser.ml"
-         in
+# 2977 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2919,26 +2996,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.class_expr) = let _1 =
-          let _1 = 
-# 1990 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2012 "parsing/parser.mly"
         ( Pcl_extension _1 )
-# 2927 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
+# 3005 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1037 "parsing/parser.mly"
     ( mkclass ~loc:_sloc _1 )
-# 2935 "parsing/parser.ml"
-          
-        in
-        
-# 1991 "parsing/parser.mly"
+# 3013 "parsing/parser.ml"
+            
+          in
+          (
+# 2013 "parsing/parser.mly"
       ( _1 )
-# 2941 "parsing/parser.ml"
-         in
+# 3019 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -2987,37 +3066,39 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.class_field) = let _6 =
-          let _1 = _1_inlined2 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _6 =
+            let _1 = _1_inlined2 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 2996 "parsing/parser.ml"
-          
-        in
-        let _endpos__6_ = _endpos__1_inlined2_ in
-        let _3 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 3076 "parsing/parser.ml"
+            
+          in
+          let _endpos__6_ = _endpos__1_inlined2_ in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 3005 "parsing/parser.ml"
-          
-        in
-        let _2 = 
-# 3964 "parsing/parser.mly"
+# 3085 "parsing/parser.ml"
+            
+          in
+          let _2 = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 3011 "parsing/parser.ml"
-         in
-        let _endpos = _endpos__6_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2040 "parsing/parser.mly"
+# 3091 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__6_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2062 "parsing/parser.mly"
       ( let docs = symbol_docs _sloc in
         mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3020 "parsing/parser.ml"
-         in
+# 3100 "parsing/parser.ml"
+           : (Parsetree.class_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3073,37 +3154,39 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.class_field) = let _6 =
-          let _1 = _1_inlined3 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _6 =
+            let _1 = _1_inlined3 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 3082 "parsing/parser.ml"
-          
-        in
-        let _endpos__6_ = _endpos__1_inlined3_ in
-        let _3 =
-          let _1 = _1_inlined2 in
-          
-# 4062 "parsing/parser.mly"
+# 3164 "parsing/parser.ml"
+            
+          in
+          let _endpos__6_ = _endpos__1_inlined3_ in
+          let _3 =
+            let _1 = _1_inlined2 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 3091 "parsing/parser.ml"
-          
-        in
-        let _2 = 
-# 3965 "parsing/parser.mly"
+# 3173 "parsing/parser.ml"
+            
+          in
+          let _2 = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 3097 "parsing/parser.ml"
-         in
-        let _endpos = _endpos__6_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2040 "parsing/parser.mly"
+# 3179 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__6_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2062 "parsing/parser.mly"
       ( let docs = symbol_docs _sloc in
         mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3106 "parsing/parser.ml"
-         in
+# 3188 "parsing/parser.ml"
+           : (Parsetree.class_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3140,25 +3223,27 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.class_field) = let _3 =
-          let _1 = _1_inlined1 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 3149 "parsing/parser.ml"
-          
-        in
-        let _endpos__3_ = _endpos__1_inlined1_ in
-        let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2043 "parsing/parser.mly"
+# 3233 "parsing/parser.ml"
+            
+          in
+          let _endpos__3_ = _endpos__1_inlined1_ in
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2065 "parsing/parser.mly"
       ( let v, attrs = _2 in
         let docs = symbol_docs _sloc in
         mkcf ~loc:_sloc (Pcf_val v) ~attrs:(attrs@_3) ~docs )
-# 3161 "parsing/parser.ml"
-         in
+# 3245 "parsing/parser.ml"
+           : (Parsetree.class_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3195,25 +3280,27 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.class_field) = let _3 =
-          let _1 = _1_inlined1 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 3204 "parsing/parser.ml"
-          
-        in
-        let _endpos__3_ = _endpos__1_inlined1_ in
-        let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2047 "parsing/parser.mly"
+# 3290 "parsing/parser.ml"
+            
+          in
+          let _endpos__3_ = _endpos__1_inlined1_ in
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2069 "parsing/parser.mly"
       ( let meth, attrs = _2 in
         let docs = symbol_docs _sloc in
         mkcf ~loc:_sloc (Pcf_method meth) ~attrs:(attrs@_3) ~docs )
-# 3216 "parsing/parser.ml"
-         in
+# 3302 "parsing/parser.ml"
+           : (Parsetree.class_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3255,32 +3342,34 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.class_field) = let _4 =
-          let _1 = _1_inlined2 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined2 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 3264 "parsing/parser.ml"
-          
-        in
-        let _endpos__4_ = _endpos__1_inlined2_ in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 3352 "parsing/parser.ml"
+            
+          in
+          let _endpos__4_ = _endpos__1_inlined2_ in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 3273 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2051 "parsing/parser.mly"
+# 3361 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2073 "parsing/parser.mly"
       ( let docs = symbol_docs _sloc in
         mkcf ~loc:_sloc (Pcf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 3283 "parsing/parser.ml"
-         in
+# 3371 "parsing/parser.ml"
+           : (Parsetree.class_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3322,32 +3411,34 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.class_field) = let _4 =
-          let _1 = _1_inlined2 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined2 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 3331 "parsing/parser.ml"
-          
-        in
-        let _endpos__4_ = _endpos__1_inlined2_ in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 3421 "parsing/parser.ml"
+            
+          in
+          let _endpos__4_ = _endpos__1_inlined2_ in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 3340 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2054 "parsing/parser.mly"
+# 3430 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2076 "parsing/parser.mly"
       ( let docs = symbol_docs _sloc in
         mkcf ~loc:_sloc (Pcf_initializer _3) ~attrs:(_2@_4) ~docs )
-# 3350 "parsing/parser.ml"
-         in
+# 3440 "parsing/parser.ml"
+           : (Parsetree.class_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3375,24 +3466,26 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.class_field) = let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 3384 "parsing/parser.ml"
-          
-        in
-        let _endpos__2_ = _endpos__1_inlined1_ in
-        let _endpos = _endpos__2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2057 "parsing/parser.mly"
+# 3476 "parsing/parser.ml"
+            
+          in
+          let _endpos__2_ = _endpos__1_inlined1_ in
+          let _endpos = _endpos__2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2079 "parsing/parser.mly"
       ( let docs = symbol_docs _sloc in
         mkcf ~loc:_sloc (Pcf_extension _1) ~attrs:_2 ~docs )
-# 3395 "parsing/parser.ml"
-         in
+# 3487 "parsing/parser.ml"
+           : (Parsetree.class_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3413,26 +3506,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.class_field) = let _1 =
-          let _1 = 
-# 2060 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2082 "parsing/parser.mly"
       ( Pcf_attribute _1 )
-# 3421 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1011 "parsing/parser.mly"
+# 3515 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1035 "parsing/parser.mly"
     ( mkcf ~loc:_sloc _1 )
-# 3429 "parsing/parser.ml"
-          
-        in
-        
-# 2061 "parsing/parser.mly"
+# 3523 "parsing/parser.ml"
+            
+          in
+          (
+# 2083 "parsing/parser.mly"
       ( _1 )
-# 3435 "parsing/parser.ml"
-         in
+# 3529 "parsing/parser.ml"
+           : (Parsetree.class_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3461,9 +3556,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.class_expr) = 
-# 1955 "parsing/parser.mly"
+# 1977 "parsing/parser.mly"
       ( _2 )
-# 3467 "parsing/parser.ml"
+# 3562 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -3506,27 +3601,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.class_expr) = let _1 =
-          let _1 = 
-# 1958 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1980 "parsing/parser.mly"
         ( Pcl_constraint(_4, _2) )
-# 3514 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
+# 3610 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1037 "parsing/parser.mly"
     ( mkclass ~loc:_sloc _1 )
-# 3523 "parsing/parser.ml"
-          
-        in
-        
-# 1961 "parsing/parser.mly"
+# 3619 "parsing/parser.ml"
+            
+          in
+          (
+# 1983 "parsing/parser.mly"
       ( _1 )
-# 3529 "parsing/parser.ml"
-         in
+# 3625 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3554,27 +3651,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.class_expr) = let _1 =
-          let _1 = 
-# 1960 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1982 "parsing/parser.mly"
       ( let (l,o,p) = _1 in Pcl_fun(l, o, p, _2) )
-# 3562 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
+# 3660 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1037 "parsing/parser.mly"
     ( mkclass ~loc:_sloc _1 )
-# 3571 "parsing/parser.ml"
-          
-        in
-        
-# 1961 "parsing/parser.mly"
+# 3669 "parsing/parser.ml"
+            
+          in
+          (
+# 1983 "parsing/parser.mly"
       ( _1 )
-# 3577 "parsing/parser.ml"
-         in
+# 3675 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3609,27 +3708,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_e_ in
-        let _v : (Parsetree.class_expr) = let _1 =
-          let _1 = 
-# 2016 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2038 "parsing/parser.mly"
       ( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 3617 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos_e_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
+# 3717 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos_e_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1037 "parsing/parser.mly"
     ( mkclass ~loc:_sloc _1 )
-# 3626 "parsing/parser.ml"
-          
-        in
-        
-# 2017 "parsing/parser.mly"
+# 3726 "parsing/parser.ml"
+            
+          in
+          (
+# 2039 "parsing/parser.mly"
     ( _1 )
-# 3632 "parsing/parser.ml"
-         in
+# 3732 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3657,27 +3758,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_e_ in
-        let _v : (Parsetree.class_expr) = let _1 =
-          let _1 = 
-# 2016 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2038 "parsing/parser.mly"
       ( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 3665 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos_e_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
+# 3767 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos_e_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1037 "parsing/parser.mly"
     ( mkclass ~loc:_sloc _1 )
-# 3674 "parsing/parser.ml"
-          
-        in
-        
-# 2017 "parsing/parser.mly"
+# 3776 "parsing/parser.ml"
+            
+          in
+          (
+# 2039 "parsing/parser.mly"
     ( _1 )
-# 3680 "parsing/parser.ml"
-         in
+# 3782 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3699,9 +3802,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3846 "parsing/parser.mly"
+# 3898 "parsing/parser.mly"
                                       ( _1 )
-# 3705 "parsing/parser.ml"
+# 3808 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -3737,14 +3840,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2025 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2047 "parsing/parser.mly"
       ( reloc_pat ~loc:_sloc _2 )
-# 3747 "parsing/parser.ml"
-         in
+# 3851 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3793,27 +3898,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2027 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2049 "parsing/parser.mly"
       ( Ppat_constraint(_2, _4) )
-# 3801 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 3907 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 3810 "parsing/parser.ml"
-          
-        in
-        
-# 2028 "parsing/parser.mly"
+# 3916 "parsing/parser.ml"
+            
+          in
+          (
+# 2050 "parsing/parser.mly"
       ( _1 )
-# 3816 "parsing/parser.ml"
-         in
+# 3922 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3827,14 +3934,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
-        let _v : (Parsetree.pattern) = let _endpos = _endpos__0_ in
-        let _symbolstartpos = _endpos in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2030 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__0_ in
+          let _symbolstartpos = _endpos in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2052 "parsing/parser.mly"
       ( ghpat ~loc:_sloc Ppat_any )
-# 3837 "parsing/parser.ml"
-         in
+# 3945 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3870,9 +3979,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.core_type) = 
-# 2155 "parsing/parser.mly"
+# 2177 "parsing/parser.mly"
       ( _2 )
-# 3876 "parsing/parser.ml"
+# 3985 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -3887,27 +3996,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 = 
-# 2156 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2178 "parsing/parser.mly"
                       ( Ptyp_any )
-# 3895 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__0_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _endpos in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 4005 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__0_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _endpos in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 3904 "parsing/parser.ml"
-          
-        in
-        
-# 2157 "parsing/parser.mly"
+# 4014 "parsing/parser.ml"
+            
+          in
+          (
+# 2179 "parsing/parser.mly"
       ( _1 )
-# 3910 "parsing/parser.ml"
-         in
+# 4020 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -3949,32 +4060,34 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.class_type_field) = let _4 =
-          let _1 = _1_inlined2 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined2 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 3958 "parsing/parser.ml"
-          
-        in
-        let _endpos__4_ = _endpos__1_inlined2_ in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 4070 "parsing/parser.ml"
+            
+          in
+          let _endpos__4_ = _endpos__1_inlined2_ in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 3967 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2165 "parsing/parser.mly"
+# 4079 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2187 "parsing/parser.mly"
       ( let docs = symbol_docs _sloc in
         mkctf ~loc:_sloc (Pctf_inherit _3) ~attrs:(_2@_4) ~docs )
-# 3977 "parsing/parser.ml"
-         in
+# 4089 "parsing/parser.ml"
+           : (Parsetree.class_type_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4031,9 +4144,9 @@ module Tables = struct
         let ty : (Parsetree.core_type) = Obj.magic ty in
         let _3 : unit = Obj.magic _3 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 4037 "parsing/parser.ml"
+# 4150 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let flags : (Asttypes.mutable_flag * Asttypes.virtual_flag) = Obj.magic flags in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -4041,58 +4154,60 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.class_type_field) = let _4 =
-          let _1 = _1_inlined3 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined3 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 4050 "parsing/parser.ml"
-          
-        in
-        let _endpos__4_ = _endpos__1_inlined3_ in
-        let _3 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let label =
-            let _1 = 
-# 3720 "parsing/parser.mly"
-                                                ( _1 )
-# 4060 "parsing/parser.ml"
-             in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
+# 4164 "parsing/parser.ml"
             
-# 960 "parsing/parser.mly"
+          in
+          let _endpos__4_ = _endpos__1_inlined3_ in
+          let _3 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let label =
+              let _1 = 
+# 3765 "parsing/parser.mly"
+                                                ( _1 )
+# 4174 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 4068 "parsing/parser.ml"
+# 4182 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2190 "parsing/parser.mly"
+# 2212 "parsing/parser.mly"
   (
     let mut, virt = flags in
     label, mut, virt, ty
   )
-# 4077 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 4191 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 4085 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2168 "parsing/parser.mly"
+# 4199 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2190 "parsing/parser.mly"
       ( let docs = symbol_docs _sloc in
         mkctf ~loc:_sloc (Pctf_val _3) ~attrs:(_2@_4) ~docs )
-# 4095 "parsing/parser.ml"
-         in
+# 4209 "parsing/parser.ml"
+           : (Parsetree.class_type_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4149,9 +4264,9 @@ module Tables = struct
         let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 4155 "parsing/parser.ml"
+# 4270 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let _3 : (Asttypes.private_flag * Asttypes.virtual_flag) = Obj.magic _3 in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -4159,57 +4274,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : (Parsetree.class_type_field) = let _7 =
-          let _1 = _1_inlined4 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _7 =
+            let _1 = _1_inlined4 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 4168 "parsing/parser.ml"
-          
-        in
-        let _endpos__7_ = _endpos__1_inlined4_ in
-        let _6 =
-          let _1 = _1_inlined3 in
-          
-# 3435 "parsing/parser.mly"
+# 4284 "parsing/parser.ml"
+            
+          in
+          let _endpos__7_ = _endpos__1_inlined4_ in
+          let _6 =
+            let _1 = _1_inlined3 in
+            
+# 3480 "parsing/parser.mly"
     ( _1 )
-# 4177 "parsing/parser.ml"
-          
-        in
-        let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+# 4293 "parsing/parser.ml"
+            
+          in
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 4185 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 4301 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 4193 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 4309 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 4201 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__7_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2172 "parsing/parser.mly"
+# 4317 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2194 "parsing/parser.mly"
       ( let (p, v) = _3 in
         let docs = symbol_docs _sloc in
         mkctf ~loc:_sloc (Pctf_method (_4, p, v, _6)) ~attrs:(_2@_7) ~docs )
-# 4212 "parsing/parser.ml"
-         in
+# 4328 "parsing/parser.ml"
+           : (Parsetree.class_type_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4251,32 +4368,34 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.class_type_field) = let _4 =
-          let _1 = _1_inlined2 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined2 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 4260 "parsing/parser.ml"
-          
-        in
-        let _endpos__4_ = _endpos__1_inlined2_ in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 4378 "parsing/parser.ml"
+            
+          in
+          let _endpos__4_ = _endpos__1_inlined2_ in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 4269 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2176 "parsing/parser.mly"
+# 4387 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2198 "parsing/parser.mly"
       ( let docs = symbol_docs _sloc in
         mkctf ~loc:_sloc (Pctf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 4279 "parsing/parser.ml"
-         in
+# 4397 "parsing/parser.ml"
+           : (Parsetree.class_type_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4304,24 +4423,26 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.class_type_field) = let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 4313 "parsing/parser.ml"
-          
-        in
-        let _endpos__2_ = _endpos__1_inlined1_ in
-        let _endpos = _endpos__2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2179 "parsing/parser.mly"
+# 4433 "parsing/parser.ml"
+            
+          in
+          let _endpos__2_ = _endpos__1_inlined1_ in
+          let _endpos = _endpos__2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2201 "parsing/parser.mly"
       ( let docs = symbol_docs _sloc in
         mkctf ~loc:_sloc (Pctf_extension _1) ~attrs:_2 ~docs )
-# 4324 "parsing/parser.ml"
-         in
+# 4444 "parsing/parser.ml"
+           : (Parsetree.class_type_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4342,26 +4463,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.class_type_field) = let _1 =
-          let _1 = 
-# 2182 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2204 "parsing/parser.mly"
       ( Pctf_attribute _1 )
-# 4350 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1009 "parsing/parser.mly"
+# 4472 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1033 "parsing/parser.mly"
     ( mkctf ~loc:_sloc _1 )
-# 4358 "parsing/parser.ml"
-          
-        in
-        
-# 2183 "parsing/parser.mly"
+# 4480 "parsing/parser.ml"
+            
+          in
+          (
+# 2205 "parsing/parser.mly"
       ( _1 )
-# 4364 "parsing/parser.ml"
-         in
+# 4486 "parsing/parser.ml"
+           : (Parsetree.class_type_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4382,50 +4505,52 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.class_type) = let _1 =
+        let _v =
           let _1 =
-            let cid =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let cid =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 4395 "parsing/parser.ml"
-              
-            in
-            let tys =
-              let tys = 
-# 2141 "parsing/parser.mly"
+# 4519 "parsing/parser.ml"
+                
+              in
+              let tys =
+                let tys = 
+# 2163 "parsing/parser.mly"
       ( [] )
-# 4402 "parsing/parser.ml"
-               in
-              
-# 2147 "parsing/parser.mly"
+# 4526 "parsing/parser.ml"
+                 in
+                
+# 2169 "parsing/parser.mly"
     ( tys )
-# 4407 "parsing/parser.ml"
+# 4531 "parsing/parser.ml"
+                
+              in
+              
+# 2146 "parsing/parser.mly"
+        ( Pcty_constr (cid, tys) )
+# 4537 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2124 "parsing/parser.mly"
-        ( Pcty_constr (cid, tys) )
-# 4413 "parsing/parser.ml"
+# 1031 "parsing/parser.mly"
+    ( mkcty ~loc:_sloc _1 )
+# 4546 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1007 "parsing/parser.mly"
-    ( mkcty ~loc:_sloc _1 )
-# 4422 "parsing/parser.ml"
-          
-        in
-        
-# 2127 "parsing/parser.mly"
+          (
+# 2149 "parsing/parser.mly"
       ( _1 )
-# 4428 "parsing/parser.ml"
-         in
+# 4552 "parsing/parser.ml"
+           : (Parsetree.class_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4467,66 +4592,68 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.class_type) = let _1 =
+        let _v =
           let _1 =
-            let cid =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let cid =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 4481 "parsing/parser.ml"
-              
-            in
-            let tys =
+# 4607 "parsing/parser.ml"
+                
+              in
               let tys =
-                let params =
-                  let xs = 
-# 253 "<standard.mly>"
+                let tys =
+                  let params =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 4490 "parsing/parser.ml"
-                   in
-                  
-# 1115 "parsing/parser.mly"
+# 4616 "parsing/parser.ml"
+                     in
+                    
+# 1139 "parsing/parser.mly"
     ( xs )
-# 4495 "parsing/parser.ml"
+# 4621 "parsing/parser.ml"
+                    
+                  in
+                  
+# 2165 "parsing/parser.mly"
+      ( params )
+# 4627 "parsing/parser.ml"
                   
                 in
                 
-# 2143 "parsing/parser.mly"
-      ( params )
-# 4501 "parsing/parser.ml"
+# 2169 "parsing/parser.mly"
+    ( tys )
+# 4633 "parsing/parser.ml"
                 
               in
               
-# 2147 "parsing/parser.mly"
-    ( tys )
-# 4507 "parsing/parser.ml"
+# 2146 "parsing/parser.mly"
+        ( Pcty_constr (cid, tys) )
+# 4639 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2124 "parsing/parser.mly"
-        ( Pcty_constr (cid, tys) )
-# 4513 "parsing/parser.ml"
+# 1031 "parsing/parser.mly"
+    ( mkcty ~loc:_sloc _1 )
+# 4649 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1007 "parsing/parser.mly"
-    ( mkcty ~loc:_sloc _1 )
-# 4523 "parsing/parser.ml"
-          
-        in
-        
-# 2127 "parsing/parser.mly"
+          (
+# 2149 "parsing/parser.mly"
       ( _1 )
-# 4529 "parsing/parser.ml"
-         in
+# 4655 "parsing/parser.ml"
+           : (Parsetree.class_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4547,26 +4674,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.class_type) = let _1 =
-          let _1 = 
-# 2126 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2148 "parsing/parser.mly"
         ( Pcty_extension _1 )
-# 4555 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1007 "parsing/parser.mly"
+# 4683 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1031 "parsing/parser.mly"
     ( mkcty ~loc:_sloc _1 )
-# 4563 "parsing/parser.ml"
-          
-        in
-        
-# 2127 "parsing/parser.mly"
+# 4691 "parsing/parser.ml"
+            
+          in
+          (
+# 2149 "parsing/parser.mly"
       ( _1 )
-# 4569 "parsing/parser.ml"
-         in
+# 4697 "parsing/parser.ml"
+           : (Parsetree.class_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4615,52 +4744,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.class_type) = let _3 =
-          let _1 = _1_inlined2 in
-          let _2 =
-            let _1 =
-              let _1 = 
-# 260 "<standard.mly>"
+        let _v =
+          let _3 =
+            let _1 = _1_inlined2 in
+            let _2 =
+              let _1 =
+                let _1 = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 4626 "parsing/parser.ml"
-               in
-              
-# 2161 "parsing/parser.mly"
+# 4756 "parsing/parser.ml"
+                 in
+                
+# 2183 "parsing/parser.mly"
     ( _1 )
-# 4631 "parsing/parser.ml"
+# 4761 "parsing/parser.ml"
+                
+              in
+              let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+              let _endpos = _endpos__1_ in
+              let _startpos = _startpos__1_ in
+              
+# 979 "parsing/parser.mly"
+                               ( extra_csig _startpos _endpos _1 )
+# 4770 "parsing/parser.ml"
               
             in
-            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
-            let _endpos = _endpos__1_ in
-            let _startpos = _startpos__1_ in
             
-# 955 "parsing/parser.mly"
-                               ( extra_csig _startpos _endpos _1 )
-# 4640 "parsing/parser.ml"
+# 2173 "parsing/parser.mly"
+      ( Csig.mk _1 _2 )
+# 4776 "parsing/parser.ml"
             
           in
-          
-# 2151 "parsing/parser.mly"
-      ( Csig.mk _1 _2 )
-# 4646 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 4654 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2129 "parsing/parser.mly"
+# 4784 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2151 "parsing/parser.mly"
       ( mkcty ~loc:_sloc ~attrs:_2 (Pcty_signature _3) )
-# 4663 "parsing/parser.ml"
-         in
+# 4793 "parsing/parser.ml"
+           : (Parsetree.class_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4709,51 +4840,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.class_type) = let _3 =
-          let _1 = _1_inlined2 in
-          let _2 =
-            let _1 =
-              let _1 = 
-# 260 "<standard.mly>"
+        let _v =
+          let _3 =
+            let _1 = _1_inlined2 in
+            let _2 =
+              let _1 =
+                let _1 = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 4720 "parsing/parser.ml"
-               in
-              
-# 2161 "parsing/parser.mly"
+# 4852 "parsing/parser.ml"
+                 in
+                
+# 2183 "parsing/parser.mly"
     ( _1 )
-# 4725 "parsing/parser.ml"
+# 4857 "parsing/parser.ml"
+                
+              in
+              let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+              let _endpos = _endpos__1_ in
+              let _startpos = _startpos__1_ in
+              
+# 979 "parsing/parser.mly"
+                               ( extra_csig _startpos _endpos _1 )
+# 4866 "parsing/parser.ml"
               
             in
-            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
-            let _endpos = _endpos__1_ in
-            let _startpos = _startpos__1_ in
             
-# 955 "parsing/parser.mly"
-                               ( extra_csig _startpos _endpos _1 )
-# 4734 "parsing/parser.ml"
+# 2173 "parsing/parser.mly"
+      ( Csig.mk _1 _2 )
+# 4872 "parsing/parser.ml"
             
           in
-          
-# 2151 "parsing/parser.mly"
-      ( Csig.mk _1 _2 )
-# 4740 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 4748 "parsing/parser.ml"
-          
-        in
-        let _loc__4_ = (_startpos__4_, _endpos__4_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 2131 "parsing/parser.mly"
+# 4880 "parsing/parser.ml"
+            
+          in
+          let _loc__4_ = (_startpos__4_, _endpos__4_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 2153 "parsing/parser.mly"
       ( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 4756 "parsing/parser.ml"
-         in
+# 4888 "parsing/parser.ml"
+           : (Parsetree.class_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4782,9 +4915,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.class_type) = 
-# 2133 "parsing/parser.mly"
+# 2155 "parsing/parser.mly"
       ( Cty.attr _1 _2 )
-# 4788 "parsing/parser.ml"
+# 4921 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -4841,41 +4974,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : (Parsetree.class_type) = let _5 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let _5 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 4853 "parsing/parser.ml"
-          
-        in
-        let _endpos__5_ = _endpos__1_inlined2_ in
-        let _4 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 4987 "parsing/parser.ml"
+            
+          in
+          let _endpos__5_ = _endpos__1_inlined2_ in
+          let _4 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 4862 "parsing/parser.ml"
-          
-        in
-        let _3 = 
-# 3964 "parsing/parser.mly"
+# 4996 "parsing/parser.ml"
+            
+          in
+          let _3 = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 4868 "parsing/parser.ml"
-         in
-        let _endpos = _endpos__7_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2135 "parsing/parser.mly"
+# 5002 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2157 "parsing/parser.mly"
       ( let loc = (_startpos__2_, _endpos__5_) in
         let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
         mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
-# 4878 "parsing/parser.ml"
-         in
+# 5012 "parsing/parser.ml"
+           : (Parsetree.class_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -4938,41 +5073,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : (Parsetree.class_type) = let _5 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let _5 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 4950 "parsing/parser.ml"
-          
-        in
-        let _endpos__5_ = _endpos__1_inlined3_ in
-        let _4 =
-          let _1 = _1_inlined2 in
-          
-# 4062 "parsing/parser.mly"
+# 5086 "parsing/parser.ml"
+            
+          in
+          let _endpos__5_ = _endpos__1_inlined3_ in
+          let _4 =
+            let _1 = _1_inlined2 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 4959 "parsing/parser.ml"
-          
-        in
-        let _3 = 
-# 3965 "parsing/parser.mly"
+# 5095 "parsing/parser.ml"
+            
+          in
+          let _3 = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 4965 "parsing/parser.ml"
-         in
-        let _endpos = _endpos__7_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2135 "parsing/parser.mly"
+# 5101 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2157 "parsing/parser.mly"
       ( let loc = (_startpos__2_, _endpos__5_) in
         let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
         mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
-# 4975 "parsing/parser.ml"
-         in
+# 5111 "parsing/parser.ml"
+           : (Parsetree.class_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5008,9 +5145,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.class_expr) = 
-# 1995 "parsing/parser.mly"
+# 2017 "parsing/parser.mly"
       ( _2 )
-# 5014 "parsing/parser.ml"
+# 5151 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -5046,13 +5183,15 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.class_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1997 "parsing/parser.mly"
+        let _v =
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 2019 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 5055 "parsing/parser.ml"
-         in
+# 5193 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5073,50 +5212,52 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.class_expr) = let _1 =
+        let _v =
           let _1 =
-            let cid =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let cid =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 5086 "parsing/parser.ml"
-              
-            in
-            let tys =
-              let tys = 
-# 2141 "parsing/parser.mly"
+# 5226 "parsing/parser.ml"
+                
+              in
+              let tys =
+                let tys = 
+# 2163 "parsing/parser.mly"
       ( [] )
-# 5093 "parsing/parser.ml"
-               in
-              
-# 2147 "parsing/parser.mly"
+# 5233 "parsing/parser.ml"
+                 in
+                
+# 2169 "parsing/parser.mly"
     ( tys )
-# 5098 "parsing/parser.ml"
+# 5238 "parsing/parser.ml"
+                
+              in
+              
+# 2022 "parsing/parser.mly"
+        ( Pcl_constr(cid, tys) )
+# 5244 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2000 "parsing/parser.mly"
-        ( Pcl_constr(cid, tys) )
-# 5104 "parsing/parser.ml"
+# 1037 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 5253 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
-    ( mkclass ~loc:_sloc _1 )
-# 5113 "parsing/parser.ml"
-          
-        in
-        
-# 2007 "parsing/parser.mly"
+          (
+# 2029 "parsing/parser.mly"
       ( _1 )
-# 5119 "parsing/parser.ml"
-         in
+# 5259 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5158,66 +5299,68 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.class_expr) = let _1 =
+        let _v =
           let _1 =
-            let cid =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let cid =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 5172 "parsing/parser.ml"
-              
-            in
-            let tys =
+# 5314 "parsing/parser.ml"
+                
+              in
               let tys =
-                let params =
-                  let xs = 
-# 253 "<standard.mly>"
+                let tys =
+                  let params =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 5181 "parsing/parser.ml"
-                   in
-                  
-# 1115 "parsing/parser.mly"
+# 5323 "parsing/parser.ml"
+                     in
+                    
+# 1139 "parsing/parser.mly"
     ( xs )
-# 5186 "parsing/parser.ml"
+# 5328 "parsing/parser.ml"
+                    
+                  in
+                  
+# 2165 "parsing/parser.mly"
+      ( params )
+# 5334 "parsing/parser.ml"
                   
                 in
                 
-# 2143 "parsing/parser.mly"
-      ( params )
-# 5192 "parsing/parser.ml"
+# 2169 "parsing/parser.mly"
+    ( tys )
+# 5340 "parsing/parser.ml"
                 
               in
               
-# 2147 "parsing/parser.mly"
-    ( tys )
-# 5198 "parsing/parser.ml"
+# 2022 "parsing/parser.mly"
+        ( Pcl_constr(cid, tys) )
+# 5346 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2000 "parsing/parser.mly"
-        ( Pcl_constr(cid, tys) )
-# 5204 "parsing/parser.ml"
+# 1037 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 5356 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
-    ( mkclass ~loc:_sloc _1 )
-# 5214 "parsing/parser.ml"
-          
-        in
-        
-# 2007 "parsing/parser.mly"
+          (
+# 2029 "parsing/parser.mly"
       ( _1 )
-# 5220 "parsing/parser.ml"
-         in
+# 5362 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5266,69 +5409,71 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.class_expr) = let _1 =
+        let _v =
           let _1 =
-            let _3 =
-              let _1 = _1_inlined2 in
-              let _2 =
-                let _1 =
-                  let _1 = 
-# 260 "<standard.mly>"
+            let _1 =
+              let _3 =
+                let _1 = _1_inlined2 in
+                let _2 =
+                  let _1 =
+                    let _1 = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 5279 "parsing/parser.ml"
-                   in
-                  
-# 2034 "parsing/parser.mly"
+# 5423 "parsing/parser.ml"
+                     in
+                    
+# 2056 "parsing/parser.mly"
     ( _1 )
-# 5284 "parsing/parser.ml"
+# 5428 "parsing/parser.ml"
+                    
+                  in
+                  let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+                  let _endpos = _endpos__1_ in
+                  let _startpos = _startpos__1_ in
+                  
+# 978 "parsing/parser.mly"
+                               ( extra_cstr _startpos _endpos _1 )
+# 5437 "parsing/parser.ml"
                   
                 in
-                let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
-                let _endpos = _endpos__1_ in
-                let _startpos = _startpos__1_ in
                 
-# 954 "parsing/parser.mly"
-                               ( extra_cstr _startpos _endpos _1 )
-# 5293 "parsing/parser.ml"
+# 2043 "parsing/parser.mly"
+       ( Cstr.mk _1 _2 )
+# 5443 "parsing/parser.ml"
                 
               in
-              
-# 2021 "parsing/parser.mly"
-       ( Cstr.mk _1 _2 )
-# 5299 "parsing/parser.ml"
-              
-            in
-            let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 5307 "parsing/parser.ml"
+# 5451 "parsing/parser.ml"
+                
+              in
+              let _loc__4_ = (_startpos__4_, _endpos__4_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 2024 "parsing/parser.mly"
+        ( unclosed "object" _loc__1_ "end" _loc__4_ )
+# 5459 "parsing/parser.ml"
               
             in
-            let _loc__4_ = (_startpos__4_, _endpos__4_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            let _endpos__1_ = _endpos__4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2002 "parsing/parser.mly"
-        ( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 5315 "parsing/parser.ml"
+# 1037 "parsing/parser.mly"
+    ( mkclass ~loc:_sloc _1 )
+# 5469 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
-    ( mkclass ~loc:_sloc _1 )
-# 5325 "parsing/parser.ml"
-          
-        in
-        
-# 2007 "parsing/parser.mly"
+          (
+# 2029 "parsing/parser.mly"
       ( _1 )
-# 5331 "parsing/parser.ml"
-         in
+# 5475 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5377,27 +5522,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.class_expr) = let _1 =
-          let _1 = 
-# 2004 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2026 "parsing/parser.mly"
         ( Pcl_constraint(_2, _4) )
-# 5385 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
+# 5531 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1037 "parsing/parser.mly"
     ( mkclass ~loc:_sloc _1 )
-# 5394 "parsing/parser.ml"
-          
-        in
-        
-# 2007 "parsing/parser.mly"
+# 5540 "parsing/parser.ml"
+            
+          in
+          (
+# 2029 "parsing/parser.mly"
       ( _1 )
-# 5400 "parsing/parser.ml"
-         in
+# 5546 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5446,31 +5593,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.class_expr) = let _1 =
+        let _v =
           let _1 =
-            let _loc__5_ = (_startpos__5_, _endpos__5_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2006 "parsing/parser.mly"
+            let _1 =
+              let _loc__5_ = (_startpos__5_, _endpos__5_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 2028 "parsing/parser.mly"
         ( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 5457 "parsing/parser.ml"
+# 5605 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1013 "parsing/parser.mly"
+# 1037 "parsing/parser.mly"
     ( mkclass ~loc:_sloc _1 )
-# 5467 "parsing/parser.ml"
-          
-        in
-        
-# 2007 "parsing/parser.mly"
+# 5615 "parsing/parser.ml"
+            
+          in
+          (
+# 2029 "parsing/parser.mly"
       ( _1 )
-# 5473 "parsing/parser.ml"
-         in
+# 5621 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5519,52 +5668,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.class_expr) = let _3 =
-          let _1 = _1_inlined2 in
-          let _2 =
-            let _1 =
-              let _1 = 
-# 260 "<standard.mly>"
+        let _v =
+          let _3 =
+            let _1 = _1_inlined2 in
+            let _2 =
+              let _1 =
+                let _1 = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 5530 "parsing/parser.ml"
-               in
-              
-# 2034 "parsing/parser.mly"
+# 5680 "parsing/parser.ml"
+                 in
+                
+# 2056 "parsing/parser.mly"
     ( _1 )
-# 5535 "parsing/parser.ml"
+# 5685 "parsing/parser.ml"
+                
+              in
+              let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+              let _endpos = _endpos__1_ in
+              let _startpos = _startpos__1_ in
+              
+# 978 "parsing/parser.mly"
+                               ( extra_cstr _startpos _endpos _1 )
+# 5694 "parsing/parser.ml"
               
             in
-            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
-            let _endpos = _endpos__1_ in
-            let _startpos = _startpos__1_ in
             
-# 954 "parsing/parser.mly"
-                               ( extra_cstr _startpos _endpos _1 )
-# 5544 "parsing/parser.ml"
+# 2043 "parsing/parser.mly"
+       ( Cstr.mk _1 _2 )
+# 5700 "parsing/parser.ml"
             
           in
-          
-# 2021 "parsing/parser.mly"
-       ( Cstr.mk _1 _2 )
-# 5550 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 5558 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2009 "parsing/parser.mly"
+# 5708 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2031 "parsing/parser.mly"
     ( mkclass ~loc:_sloc ~attrs:_2 (Pcl_structure _3) )
-# 5567 "parsing/parser.ml"
-         in
+# 5717 "parsing/parser.ml"
+           : (Parsetree.class_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5586,9 +5737,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.class_type) = 
-# 2112 "parsing/parser.mly"
+# 2134 "parsing/parser.mly"
       ( _1 )
-# 5592 "parsing/parser.ml"
+# 5743 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -5631,34 +5782,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_label_ in
         let _endpos = _endpos_codomain_ in
-        let _v : (Parsetree.class_type) = let _1 =
+        let _v =
           let _1 =
-            let label = 
-# 3498 "parsing/parser.mly"
+            let _1 =
+              let label = 
+# 3543 "parsing/parser.mly"
       ( Optional label )
-# 5640 "parsing/parser.ml"
-             in
-            
-# 2118 "parsing/parser.mly"
+# 5792 "parsing/parser.ml"
+               in
+              
+# 2140 "parsing/parser.mly"
         ( Pcty_arrow(label, domain, codomain) )
-# 5645 "parsing/parser.ml"
+# 5797 "parsing/parser.ml"
+              
+            in
+            let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1007 "parsing/parser.mly"
+# 1031 "parsing/parser.mly"
     ( mkcty ~loc:_sloc _1 )
-# 5655 "parsing/parser.ml"
-          
-        in
-        
-# 2119 "parsing/parser.mly"
+# 5807 "parsing/parser.ml"
+            
+          in
+          (
+# 2141 "parsing/parser.mly"
       ( _1 )
-# 5661 "parsing/parser.ml"
-         in
+# 5813 "parsing/parser.ml"
+           : (Parsetree.class_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5704,41 +5857,43 @@ module Tables = struct
         let domain : (Parsetree.core_type) = Obj.magic domain in
         let _2 : unit = Obj.magic _2 in
         let label : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 5710 "parsing/parser.ml"
+# 5863 "parsing/parser.ml"
         ) = Obj.magic label in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_label_ in
         let _endpos = _endpos_codomain_ in
-        let _v : (Parsetree.class_type) = let _1 =
+        let _v =
           let _1 =
-            let label = 
-# 3500 "parsing/parser.mly"
+            let _1 =
+              let label = 
+# 3545 "parsing/parser.mly"
       ( Labelled label )
-# 5720 "parsing/parser.ml"
-             in
-            
-# 2118 "parsing/parser.mly"
+# 5874 "parsing/parser.ml"
+               in
+              
+# 2140 "parsing/parser.mly"
         ( Pcty_arrow(label, domain, codomain) )
-# 5725 "parsing/parser.ml"
+# 5879 "parsing/parser.ml"
+              
+            in
+            let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1007 "parsing/parser.mly"
+# 1031 "parsing/parser.mly"
     ( mkcty ~loc:_sloc _1 )
-# 5735 "parsing/parser.ml"
-          
-        in
-        
-# 2119 "parsing/parser.mly"
+# 5889 "parsing/parser.ml"
+            
+          in
+          (
+# 2141 "parsing/parser.mly"
       ( _1 )
-# 5741 "parsing/parser.ml"
-         in
+# 5895 "parsing/parser.ml"
+           : (Parsetree.class_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5773,34 +5928,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_domain_ in
         let _endpos = _endpos_codomain_ in
-        let _v : (Parsetree.class_type) = let _1 =
+        let _v =
           let _1 =
-            let label = 
-# 3502 "parsing/parser.mly"
+            let _1 =
+              let label = 
+# 3547 "parsing/parser.mly"
       ( Nolabel )
-# 5782 "parsing/parser.ml"
-             in
-            
-# 2118 "parsing/parser.mly"
+# 5938 "parsing/parser.ml"
+               in
+              
+# 2140 "parsing/parser.mly"
         ( Pcty_arrow(label, domain, codomain) )
-# 5787 "parsing/parser.ml"
+# 5943 "parsing/parser.ml"
+              
+            in
+            let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_domain_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_domain_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1007 "parsing/parser.mly"
+# 1031 "parsing/parser.mly"
     ( mkcty ~loc:_sloc _1 )
-# 5797 "parsing/parser.ml"
-          
-        in
-        
-# 2119 "parsing/parser.mly"
+# 5953 "parsing/parser.ml"
+            
+          in
+          (
+# 2141 "parsing/parser.mly"
       ( _1 )
-# 5803 "parsing/parser.ml"
-         in
+# 5959 "parsing/parser.ml"
+           : (Parsetree.class_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5882,9 +6039,9 @@ module Tables = struct
         let csig : (Parsetree.class_type) = Obj.magic csig in
         let _8 : unit = Obj.magic _8 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 5888 "parsing/parser.ml"
+# 6045 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -5895,41 +6052,42 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_bs_ in
-        let _v : (string Asttypes.loc option * Parsetree.class_type_declaration list) = let _1 =
-          let a =
-            let attrs2 =
-              let _1 = _1_inlined3 in
-              
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let a =
+              let attrs2 =
+                let _1 = _1_inlined3 in
+                
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 5906 "parsing/parser.ml"
-              
-            in
-            let _endpos_attrs2_ = _endpos__1_inlined3_ in
-            let id =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+# 6064 "parsing/parser.ml"
+                
+              in
+              let _endpos_attrs2_ = _endpos__1_inlined3_ in
+              let id =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 5918 "parsing/parser.ml"
-              
-            in
-            let attrs1 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+# 6076 "parsing/parser.ml"
+                
+              in
+              let attrs1 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 5926 "parsing/parser.ml"
+# 6084 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos_attrs2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos_attrs2_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2257 "parsing/parser.mly"
+# 2279 "parsing/parser.mly"
     (
       let attrs = attrs1 @ attrs2 in
       let loc = make_loc _sloc in
@@ -5937,20 +6095,21 @@ module Tables = struct
       ext,
       Ci.mk id csig ~virt ~params ~attrs ~loc ~docs
     )
-# 5941 "parsing/parser.ml"
+# 6099 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 1212 "parsing/parser.mly"
+# 1236 "parsing/parser.mly"
     ( let (x, b) = a in x, b :: bs )
-# 5947 "parsing/parser.ml"
-          
-        in
-        
-# 2245 "parsing/parser.mly"
+# 6105 "parsing/parser.ml"
+            
+          in
+          (
+# 2267 "parsing/parser.mly"
     ( _1 )
-# 5953 "parsing/parser.ml"
-         in
+# 6111 "parsing/parser.ml"
+           : (string Asttypes.loc option * Parsetree.class_type_declaration list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -5972,9 +6131,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3843 "parsing/parser.mly"
+# 3895 "parsing/parser.mly"
                                            ( _1 )
-# 5978 "parsing/parser.ml"
+# 6137 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -5993,18 +6152,24 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 764 "parsing/parser.mly"
+# 783 "parsing/parser.mly"
        (string * char option)
-# 5999 "parsing/parser.ml"
+# 6158 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.constant) = 
-# 3726 "parsing/parser.mly"
-                 ( let (n, m) = _1 in Pconst_integer (n, m) )
-# 6007 "parsing/parser.ml"
-         in
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3771 "parsing/parser.mly"
+                 ( let (n, m) = _1 in
+                   mkconst ~loc:_sloc (Pconst_integer (n, m)) )
+# 6171 "parsing/parser.ml"
+           : (Parsetree.constant))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6022,18 +6187,23 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 723 "parsing/parser.mly"
+# 741 "parsing/parser.mly"
        (char)
-# 6028 "parsing/parser.ml"
+# 6193 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.constant) = 
-# 3727 "parsing/parser.mly"
-                 ( Pconst_char _1 )
-# 6036 "parsing/parser.ml"
-         in
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3773 "parsing/parser.mly"
+                 ( mkconst ~loc:_sloc (Pconst_char _1) )
+# 6205 "parsing/parser.ml"
+           : (Parsetree.constant))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6051,18 +6221,24 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 816 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
        (string * Location.t * string option)
-# 6057 "parsing/parser.ml"
+# 6227 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.constant) = 
-# 3728 "parsing/parser.mly"
-                 ( let (s, strloc, d) = _1 in Pconst_string (s, strloc, d) )
-# 6065 "parsing/parser.ml"
-         in
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3774 "parsing/parser.mly"
+                 ( let (s, strloc, d) = _1 in
+                   mkconst ~loc:_sloc (Pconst_string (s,strloc,d)) )
+# 6240 "parsing/parser.ml"
+           : (Parsetree.constant))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6080,18 +6256,24 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 743 "parsing/parser.mly"
+# 762 "parsing/parser.mly"
        (string * char option)
-# 6086 "parsing/parser.ml"
+# 6262 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.constant) = 
-# 3729 "parsing/parser.mly"
-                 ( let (f, m) = _1 in Pconst_float (f, m) )
-# 6094 "parsing/parser.ml"
-         in
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3776 "parsing/parser.mly"
+                 ( let (f, m) = _1 in
+                   mkconst ~loc:_sloc (Pconst_float (f, m)) )
+# 6275 "parsing/parser.ml"
+           : (Parsetree.constant))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6120,9 +6302,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.label) = 
-# 3800 "parsing/parser.mly"
+# 3852 "parsing/parser.mly"
                                                 ( "[]" )
-# 6126 "parsing/parser.ml"
+# 6308 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6152,9 +6334,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.label) = 
-# 3801 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
                                                 ( "()" )
-# 6158 "parsing/parser.ml"
+# 6340 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6177,9 +6359,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3802 "parsing/parser.mly"
+# 3854 "parsing/parser.mly"
                                                 ( "false" )
-# 6183 "parsing/parser.ml"
+# 6365 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6202,9 +6384,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3803 "parsing/parser.mly"
+# 3855 "parsing/parser.mly"
                                                 ( "true" )
-# 6208 "parsing/parser.ml"
+# 6390 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6223,17 +6405,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 6229 "parsing/parser.ml"
+# 6411 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3806 "parsing/parser.mly"
+# 3858 "parsing/parser.mly"
                                                 ( _1 )
-# 6237 "parsing/parser.ml"
+# 6419 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6269,16 +6451,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3797 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3849 "parsing/parser.mly"
                                                 ( "::" )
-# 6276 "parsing/parser.ml"
-         in
-        
-# 3807 "parsing/parser.mly"
+# 6459 "parsing/parser.ml"
+           in
+          (
+# 3859 "parsing/parser.mly"
                                                 ( _1 )
-# 6281 "parsing/parser.ml"
-         in
+# 6464 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6300,9 +6484,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3808 "parsing/parser.mly"
+# 3860 "parsing/parser.mly"
                                                 ( _1 )
-# 6306 "parsing/parser.ml"
+# 6490 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6325,9 +6509,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3811 "parsing/parser.mly"
+# 3863 "parsing/parser.mly"
                                          ( _1 )
-# 6331 "parsing/parser.ml"
+# 6515 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6377,16 +6561,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Longident.t) = let _3 = 
-# 3797 "parsing/parser.mly"
+        let _v =
+          let _3 = 
+# 3849 "parsing/parser.mly"
                                                 ( "::" )
-# 6384 "parsing/parser.ml"
-         in
-        
-# 3812 "parsing/parser.mly"
+# 6569 "parsing/parser.ml"
+           in
+          (
+# 3864 "parsing/parser.mly"
                                          ( Ldot(_1,_3) )
-# 6389 "parsing/parser.ml"
-         in
+# 6574 "parsing/parser.ml"
+           : (Longident.t))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6421,16 +6607,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Longident.t) = let _1 = 
-# 3797 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3849 "parsing/parser.mly"
                                                 ( "::" )
-# 6428 "parsing/parser.ml"
-         in
-        
-# 3813 "parsing/parser.mly"
+# 6615 "parsing/parser.ml"
+           in
+          (
+# 3865 "parsing/parser.mly"
                                          ( Lident _1 )
-# 6433 "parsing/parser.ml"
-         in
+# 6620 "parsing/parser.ml"
+           : (Longident.t))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6452,9 +6640,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3814 "parsing/parser.mly"
+# 3866 "parsing/parser.mly"
                                          ( Lident _1 )
-# 6458 "parsing/parser.ml"
+# 6646 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6491,9 +6679,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.core_type * Parsetree.core_type) = 
-# 2201 "parsing/parser.mly"
+# 2223 "parsing/parser.mly"
     ( _1, _3 )
-# 6497 "parsing/parser.ml"
+# 6685 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6515,30 +6703,32 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.constructor_arguments) = let tys =
-          let xs =
-            let xs = 
-# 1099 "parsing/parser.mly"
+        let _v =
+          let tys =
+            let xs =
+              let xs = 
+# 1123 "parsing/parser.mly"
     ( [ x ] )
-# 6524 "parsing/parser.ml"
-             in
-            
-# 253 "<standard.mly>"
+# 6713 "parsing/parser.ml"
+               in
+              
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 6529 "parsing/parser.ml"
+# 6718 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 1119 "parsing/parser.mly"
+# 1143 "parsing/parser.mly"
     ( xs )
-# 6535 "parsing/parser.ml"
-          
-        in
-        
-# 3301 "parsing/parser.mly"
+# 6724 "parsing/parser.ml"
+            
+          in
+          (
+# 3346 "parsing/parser.mly"
       ( Pcstr_tuple tys )
-# 6541 "parsing/parser.ml"
-         in
+# 6730 "parsing/parser.ml"
+           : (Parsetree.constructor_arguments))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6573,30 +6763,32 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.constructor_arguments) = let tys =
-          let xs =
-            let xs = 
-# 1103 "parsing/parser.mly"
+        let _v =
+          let tys =
+            let xs =
+              let xs = 
+# 1127 "parsing/parser.mly"
     ( x :: xs )
-# 6582 "parsing/parser.ml"
-             in
-            
-# 253 "<standard.mly>"
+# 6773 "parsing/parser.ml"
+               in
+              
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 6587 "parsing/parser.ml"
+# 6778 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 1119 "parsing/parser.mly"
+# 1143 "parsing/parser.mly"
     ( xs )
-# 6593 "parsing/parser.ml"
-          
-        in
-        
-# 3301 "parsing/parser.mly"
+# 6784 "parsing/parser.ml"
+            
+          in
+          (
+# 3346 "parsing/parser.mly"
       ( Pcstr_tuple tys )
-# 6599 "parsing/parser.ml"
-         in
+# 6790 "parsing/parser.ml"
+           : (Parsetree.constructor_arguments))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6632,9 +6824,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.constructor_arguments) = 
-# 3303 "parsing/parser.mly"
+# 3348 "parsing/parser.mly"
       ( Pcstr_record _2 )
-# 6638 "parsing/parser.ml"
+# 6830 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6657,9 +6849,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.constructor_declaration list) = 
-# 3217 "parsing/parser.mly"
+# 3262 "parsing/parser.mly"
       ( [] )
-# 6663 "parsing/parser.ml"
+# 6855 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6681,16 +6873,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.constructor_declaration list) = let cs = 
-# 1204 "parsing/parser.mly"
+        let _v =
+          let cs = 
+# 1228 "parsing/parser.mly"
     ( List.rev xs )
-# 6688 "parsing/parser.ml"
-         in
-        
-# 3219 "parsing/parser.mly"
+# 6881 "parsing/parser.ml"
+           in
+          (
+# 3264 "parsing/parser.mly"
       ( cs )
-# 6693 "parsing/parser.ml"
-         in
+# 6886 "parsing/parser.ml"
+           : (Parsetree.constructor_declaration list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6711,16 +6905,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type) = let _1 = 
-# 3460 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3505 "parsing/parser.mly"
     ( _1 )
-# 6718 "parsing/parser.ml"
-         in
-        
-# 3450 "parsing/parser.mly"
+# 6913 "parsing/parser.ml"
+           in
+          (
+# 3495 "parsing/parser.mly"
       ( _1 )
-# 6723 "parsing/parser.ml"
-         in
+# 6918 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6749,9 +6945,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.core_type) = 
-# 3452 "parsing/parser.mly"
+# 3497 "parsing/parser.mly"
       ( Typ.attr _1 _2 )
-# 6755 "parsing/parser.ml"
+# 6951 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6774,9 +6970,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.core_type) = 
-# 3600 "parsing/parser.mly"
+# 3645 "parsing/parser.mly"
     ( _1 )
-# 6780 "parsing/parser.ml"
+# 6976 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6799,9 +6995,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.core_type) = 
-# 3600 "parsing/parser.mly"
+# 3645 "parsing/parser.mly"
     ( _1 )
-# 6805 "parsing/parser.ml"
+# 7001 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6824,9 +7020,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.core_type) = 
-# 3600 "parsing/parser.mly"
+# 3645 "parsing/parser.mly"
     ( _1 )
-# 6830 "parsing/parser.ml"
+# 7026 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6863,9 +7059,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.core_type) = 
-# 3553 "parsing/parser.mly"
+# 3598 "parsing/parser.mly"
       ( type_ )
-# 6869 "parsing/parser.ml"
+# 7065 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -6922,43 +7118,45 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.core_type) = let package_type =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3646 "parsing/parser.mly"
+        let _v =
+          let package_type =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 6936 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-          let _2 =
-            let _1 = _1_inlined1 in
+# 7133 "parsing/parser.ml"
             
-# 4062 "parsing/parser.mly"
+          in
+          let attrs =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 6946 "parsing/parser.ml"
+# 7143 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 6952 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3555 "parsing/parser.mly"
+# 7149 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3600 "parsing/parser.mly"
       ( wrap_typ_attrs ~loc:_sloc (reloc_typ ~loc:_sloc package_type) attrs )
-# 6961 "parsing/parser.ml"
-         in
+# 7158 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -6993,27 +7191,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 = 
-# 3558 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3603 "parsing/parser.mly"
         ( Ptyp_variant([ field ], Closed, None) )
-# 7001 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 7200 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 7010 "parsing/parser.ml"
-          
-        in
-        
-# 3575 "parsing/parser.mly"
+# 7209 "parsing/parser.ml"
+            
+          in
+          (
+# 3620 "parsing/parser.mly"
   ( _1 )
-# 7016 "parsing/parser.ml"
-         in
+# 7215 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7055,48 +7255,50 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let fields =
-              let _1 =
-                let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let fields =
+                let _1 =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 7066 "parsing/parser.ml"
-                 in
-                
-# 1115 "parsing/parser.mly"
+# 7267 "parsing/parser.ml"
+                   in
+                  
+# 1139 "parsing/parser.mly"
     ( xs )
-# 7071 "parsing/parser.ml"
+# 7272 "parsing/parser.ml"
+                  
+                in
+                
+# 3697 "parsing/parser.mly"
+    ( _1 )
+# 7278 "parsing/parser.ml"
                 
               in
               
-# 3652 "parsing/parser.mly"
-    ( _1 )
-# 7077 "parsing/parser.ml"
+# 3605 "parsing/parser.mly"
+        ( Ptyp_variant(fields, Closed, None) )
+# 7284 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3560 "parsing/parser.mly"
-        ( Ptyp_variant(fields, Closed, None) )
-# 7083 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 7294 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 7093 "parsing/parser.ml"
-          
-        in
-        
-# 3575 "parsing/parser.mly"
+          (
+# 3620 "parsing/parser.mly"
   ( _1 )
-# 7099 "parsing/parser.ml"
-         in
+# 7300 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7145,48 +7347,50 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let fields =
-              let _1 =
-                let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let fields =
+                let _1 =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 7156 "parsing/parser.ml"
-                 in
-                
-# 1115 "parsing/parser.mly"
+# 7359 "parsing/parser.ml"
+                   in
+                  
+# 1139 "parsing/parser.mly"
     ( xs )
-# 7161 "parsing/parser.ml"
+# 7364 "parsing/parser.ml"
+                  
+                in
+                
+# 3697 "parsing/parser.mly"
+    ( _1 )
+# 7370 "parsing/parser.ml"
                 
               in
               
-# 3652 "parsing/parser.mly"
-    ( _1 )
-# 7167 "parsing/parser.ml"
+# 3607 "parsing/parser.mly"
+        ( Ptyp_variant(field :: fields, Closed, None) )
+# 7376 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3562 "parsing/parser.mly"
-        ( Ptyp_variant(field :: fields, Closed, None) )
-# 7173 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 7386 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 7183 "parsing/parser.ml"
-          
-        in
-        
-# 3575 "parsing/parser.mly"
+          (
+# 3620 "parsing/parser.mly"
   ( _1 )
-# 7189 "parsing/parser.ml"
-         in
+# 7392 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7228,48 +7432,50 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let fields =
-              let _1 =
-                let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let fields =
+                let _1 =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 7239 "parsing/parser.ml"
-                 in
-                
-# 1115 "parsing/parser.mly"
+# 7444 "parsing/parser.ml"
+                   in
+                  
+# 1139 "parsing/parser.mly"
     ( xs )
-# 7244 "parsing/parser.ml"
+# 7449 "parsing/parser.ml"
+                  
+                in
+                
+# 3697 "parsing/parser.mly"
+    ( _1 )
+# 7455 "parsing/parser.ml"
                 
               in
               
-# 3652 "parsing/parser.mly"
-    ( _1 )
-# 7250 "parsing/parser.ml"
+# 3609 "parsing/parser.mly"
+        ( Ptyp_variant(fields, Open, None) )
+# 7461 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3564 "parsing/parser.mly"
-        ( Ptyp_variant(fields, Open, None) )
-# 7256 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 7471 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 7266 "parsing/parser.ml"
-          
-        in
-        
-# 3575 "parsing/parser.mly"
+          (
+# 3620 "parsing/parser.mly"
   ( _1 )
-# 7272 "parsing/parser.ml"
-         in
+# 7477 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7297,27 +7503,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 = 
-# 3566 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3611 "parsing/parser.mly"
         ( Ptyp_variant([], Open, None) )
-# 7305 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 7512 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 7314 "parsing/parser.ml"
-          
-        in
-        
-# 3575 "parsing/parser.mly"
+# 7521 "parsing/parser.ml"
+            
+          in
+          (
+# 3620 "parsing/parser.mly"
   ( _1 )
-# 7320 "parsing/parser.ml"
-         in
+# 7527 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7359,48 +7567,50 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let fields =
-              let _1 =
-                let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let fields =
+                let _1 =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 7370 "parsing/parser.ml"
-                 in
-                
-# 1115 "parsing/parser.mly"
+# 7579 "parsing/parser.ml"
+                   in
+                  
+# 1139 "parsing/parser.mly"
     ( xs )
-# 7375 "parsing/parser.ml"
+# 7584 "parsing/parser.ml"
+                  
+                in
+                
+# 3697 "parsing/parser.mly"
+    ( _1 )
+# 7590 "parsing/parser.ml"
                 
               in
               
-# 3652 "parsing/parser.mly"
-    ( _1 )
-# 7381 "parsing/parser.ml"
+# 3613 "parsing/parser.mly"
+        ( Ptyp_variant(fields, Closed, Some []) )
+# 7596 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3568 "parsing/parser.mly"
-        ( Ptyp_variant(fields, Closed, Some []) )
-# 7387 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 7606 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 7397 "parsing/parser.ml"
-          
-        in
-        
-# 3575 "parsing/parser.mly"
+          (
+# 3620 "parsing/parser.mly"
   ( _1 )
-# 7403 "parsing/parser.ml"
-         in
+# 7612 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7456,68 +7666,70 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let tags =
-              let xs = xs_inlined1 in
-              let _1 =
-                let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let tags =
+                let xs = xs_inlined1 in
+                let _1 =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 7468 "parsing/parser.ml"
-                 in
-                
-# 1062 "parsing/parser.mly"
+# 7679 "parsing/parser.ml"
+                   in
+                  
+# 1086 "parsing/parser.mly"
     ( xs )
-# 7473 "parsing/parser.ml"
+# 7684 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 3680 "parsing/parser.mly"
+# 3725 "parsing/parser.mly"
     ( _1 )
-# 7479 "parsing/parser.ml"
-              
-            in
-            let fields =
-              let _1 =
-                let xs = 
-# 253 "<standard.mly>"
-    ( List.rev xs )
-# 7487 "parsing/parser.ml"
-                 in
+# 7690 "parsing/parser.ml"
                 
-# 1115 "parsing/parser.mly"
+              in
+              let fields =
+                let _1 =
+                  let xs = 
+# 264 "<standard.mly>"
+    ( List.rev xs )
+# 7698 "parsing/parser.ml"
+                   in
+                  
+# 1139 "parsing/parser.mly"
     ( xs )
-# 7492 "parsing/parser.ml"
+# 7703 "parsing/parser.ml"
+                  
+                in
+                
+# 3697 "parsing/parser.mly"
+    ( _1 )
+# 7709 "parsing/parser.ml"
                 
               in
               
-# 3652 "parsing/parser.mly"
-    ( _1 )
-# 7498 "parsing/parser.ml"
+# 3618 "parsing/parser.mly"
+        ( Ptyp_variant(fields, Closed, Some tags) )
+# 7715 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__6_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3573 "parsing/parser.mly"
-        ( Ptyp_variant(fields, Closed, Some tags) )
-# 7504 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 7725 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__6_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 7514 "parsing/parser.ml"
-          
-        in
-        
-# 3575 "parsing/parser.mly"
+          (
+# 3620 "parsing/parser.mly"
   ( _1 )
-# 7520 "parsing/parser.ml"
-         in
+# 7731 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7539,9 +7751,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.direction_flag) = 
-# 3909 "parsing/parser.mly"
+# 3961 "parsing/parser.mly"
                                                 ( Upto )
-# 7545 "parsing/parser.ml"
+# 7757 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -7564,9 +7776,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.direction_flag) = 
-# 3910 "parsing/parser.mly"
+# 3962 "parsing/parser.mly"
                                                 ( Downto )
-# 7570 "parsing/parser.ml"
+# 7782 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -7582,9 +7794,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (string Asttypes.loc option) = 
-# 4065 "parsing/parser.mly"
+# 4117 "parsing/parser.mly"
                   ( None )
-# 7588 "parsing/parser.ml"
+# 7800 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -7614,9 +7826,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (string Asttypes.loc option) = 
-# 4066 "parsing/parser.mly"
+# 4118 "parsing/parser.mly"
                     ( Some _2 )
-# 7620 "parsing/parser.ml"
+# 7832 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -7660,9 +7872,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
         let _v : (Parsetree.extension) = 
-# 4078 "parsing/parser.mly"
+# 4130 "parsing/parser.mly"
                                              ( (_2, _3) )
-# 7666 "parsing/parser.ml"
+# 7878 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -7681,21 +7893,23 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 818 "parsing/parser.mly"
+# 837 "parsing/parser.mly"
        (string * Location.t * string * Location.t * string option)
-# 7687 "parsing/parser.ml"
+# 7899 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.extension) = let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 4080 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 4132 "parsing/parser.mly"
     ( mk_quotedext ~loc:_sloc _1 )
-# 7698 "parsing/parser.ml"
-         in
+# 7911 "parsing/parser.ml"
+           : (Parsetree.extension))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7744,46 +7958,48 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.extension_constructor) = let attrs =
-          let _1 = _1_inlined3 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let attrs =
+            let _1 = _1_inlined3 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 7753 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs_ = _endpos__1_inlined3_ in
-        let lid =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 7968 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs_ = _endpos__1_inlined3_ in
+          let lid =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 7765 "parsing/parser.ml"
-          
-        in
-        let cid =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+# 7980 "parsing/parser.ml"
+            
+          in
+          let cid =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 7991 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 7776 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3370 "parsing/parser.mly"
+          (
+# 3415 "parsing/parser.mly"
       ( let info = symbol_info _endpos in
         Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 7786 "parsing/parser.ml"
-         in
+# 8001 "parsing/parser.ml"
+           : (Parsetree.extension_constructor))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7825,51 +8041,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.extension_constructor) = let attrs =
-          let _1 = _1_inlined2 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let attrs =
+            let _1 = _1_inlined2 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 7834 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs_ = _endpos__1_inlined2_ in
-        let lid =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 8051 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs_ = _endpos__1_inlined2_ in
+          let lid =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 7846 "parsing/parser.ml"
-          
-        in
-        let cid =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 8063 "parsing/parser.ml"
+            
+          in
+          let cid =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 7856 "parsing/parser.ml"
-          
-        in
-        let _startpos_cid_ = _startpos__1_ in
-        let _1 = 
-# 3883 "parsing/parser.mly"
+# 8073 "parsing/parser.ml"
+            
+          in
+          let _startpos_cid_ = _startpos__1_ in
+          let _1 = 
+# 3935 "parsing/parser.mly"
     ( () )
-# 7863 "parsing/parser.ml"
-         in
-        let _endpos = _endpos_attrs_ in
-        let _symbolstartpos = _startpos_cid_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3370 "parsing/parser.mly"
+# 8080 "parsing/parser.ml"
+           in
+          let _endpos = _endpos_attrs_ in
+          let _symbolstartpos = _startpos_cid_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3415 "parsing/parser.mly"
       ( let info = symbol_info _endpos in
         Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 7872 "parsing/parser.ml"
-         in
+# 8089 "parsing/parser.ml"
+           : (Parsetree.extension_constructor))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7890,27 +8108,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_ext_ in
         let _endpos = _endpos_ext_ in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 = 
-# 3591 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3636 "parsing/parser.mly"
         ( Ptyp_extension ext )
-# 7898 "parsing/parser.ml"
-           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_ext_, _startpos_ext_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 8117 "parsing/parser.ml"
+             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_ext_, _startpos_ext_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 7907 "parsing/parser.ml"
-          
-        in
-        
-# 3593 "parsing/parser.mly"
+# 8126 "parsing/parser.ml"
+            
+          in
+          (
+# 3638 "parsing/parser.mly"
   ( _1 )
-# 7913 "parsing/parser.ml"
-         in
+# 8132 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7952,15 +8172,17 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.attribute) = let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 4053 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 4105 "parsing/parser.mly"
     ( mark_symbol_docs _sloc;
       mk_attr ~loc:(make_loc _sloc) _2 _3 )
-# 7963 "parsing/parser.ml"
-         in
+# 8184 "parsing/parser.ml"
+           : (Parsetree.attribute))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -7974,16 +8196,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
-        let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let params = 
-# 2141 "parsing/parser.mly"
+        let _v =
+          let params = 
+# 2163 "parsing/parser.mly"
       ( [] )
-# 7981 "parsing/parser.ml"
-         in
-        
-# 1966 "parsing/parser.mly"
+# 8204 "parsing/parser.ml"
+           in
+          (
+# 1988 "parsing/parser.mly"
     ( params )
-# 7986 "parsing/parser.ml"
-         in
+# 8209 "parsing/parser.ml"
+           : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -8018,30 +8242,32 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let params =
+        let _v =
           let params =
-            let xs = 
-# 253 "<standard.mly>"
+            let params =
+              let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 8027 "parsing/parser.ml"
-             in
-            
-# 1115 "parsing/parser.mly"
+# 8252 "parsing/parser.ml"
+               in
+              
+# 1139 "parsing/parser.mly"
     ( xs )
-# 8032 "parsing/parser.ml"
+# 8257 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2143 "parsing/parser.mly"
+# 2165 "parsing/parser.mly"
       ( params )
-# 8038 "parsing/parser.ml"
-          
-        in
-        
-# 1966 "parsing/parser.mly"
+# 8263 "parsing/parser.ml"
+            
+          in
+          (
+# 1988 "parsing/parser.mly"
     ( params )
-# 8044 "parsing/parser.ml"
-         in
+# 8269 "parsing/parser.ml"
+           : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -8083,47 +8309,48 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.function_body) = let _3 =
-          let xs =
-            let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _3 =
+            let xs =
+              let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 8092 "parsing/parser.ml"
-             in
+# 8319 "parsing/parser.ml"
+               in
+              
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 8324 "parsing/parser.ml"
+              
+            in
             
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 8097 "parsing/parser.ml"
+# 8330 "parsing/parser.ml"
             
           in
-          
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 8103 "parsing/parser.ml"
-          
-        in
-        let _endpos__3_ = _endpos_xs_ in
-        let _2 =
-          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+          let _endpos__3_ = _endpos_xs_ in
           let _2 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 8114 "parsing/parser.ml"
+# 8341 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 8120 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2742 "parsing/parser.mly"
+# 8347 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2784 "parsing/parser.mly"
       ( let ext, attrs = _2 in
         match ext with
         | None -> Pfunction_cases (_3, make_loc _sloc, attrs)
@@ -8133,8 +8360,9 @@ module Tables = struct
             Pfunction_body
               (mkexp_attrs ~loc:_sloc (mkfunction [] None cases) _2)
       )
-# 8137 "parsing/parser.ml"
-         in
+# 8364 "parsing/parser.ml"
+           : (Parsetree.function_body))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -8156,9 +8384,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.function_body) = 
-# 2752 "parsing/parser.mly"
+# 2794 "parsing/parser.mly"
       ( Pfunction_body _1 )
-# 8162 "parsing/parser.ml"
+# 8390 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -8181,9 +8409,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.expression) = 
-# 2399 "parsing/parser.mly"
+# 2421 "parsing/parser.mly"
       ( _1 )
-# 8187 "parsing/parser.ml"
+# 8415 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -8254,50 +8482,52 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 8267 "parsing/parser.ml"
-            
-          in
-          let _3 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 8496 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _3 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 8277 "parsing/parser.ml"
+# 8506 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8512 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 8283 "parsing/parser.ml"
+# 2457 "parsing/parser.mly"
+      ( Pexp_letmodule(_4, _5, _7), _3 )
+# 8518 "parsing/parser.ml"
             
           in
-          
-# 2435 "parsing/parser.mly"
-      ( Pexp_letmodule(_4, _5, _7), _3 )
-# 8289 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__7_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__7_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 8300 "parsing/parser.ml"
-         in
+# 8529 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -8375,70 +8605,72 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 =
-            let (_endpos__1_inlined1_, _endpos__1_, _startpos__1_, _1_inlined1, _2, _1) = (_endpos__1_inlined4_, _endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined4, _2_inlined1, _1_inlined3) in
-            let _3 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 =
+              let (_endpos__1_inlined1_, _endpos__1_, _startpos__1_, _1_inlined1, _2, _1) = (_endpos__1_inlined4_, _endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined4, _2_inlined1, _1_inlined3) in
+              let _3 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 8387 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos__1_inlined1_ in
-            let _1 =
-              let _endpos = _endpos__1_ in
+# 8618 "parsing/parser.ml"
+                
+              in
+              let _endpos__3_ = _endpos__1_inlined1_ in
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 8629 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
               let _symbolstartpos = _startpos__1_ in
               let _sloc = (_symbolstartpos, _endpos) in
               
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 8398 "parsing/parser.ml"
-              
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 3281 "parsing/parser.mly"
+# 3326 "parsing/parser.mly"
       ( let vars, args, res = _2 in
         Te.decl _1 ~vars ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) )
-# 8408 "parsing/parser.ml"
-            
-          in
-          let _3 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 8639 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _3 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 8418 "parsing/parser.ml"
+# 8649 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 8655 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 8424 "parsing/parser.ml"
+# 2459 "parsing/parser.mly"
+      ( Pexp_letexception(_4, _6), _3 )
+# 8661 "parsing/parser.ml"
             
           in
-          
-# 2437 "parsing/parser.mly"
-      ( Pexp_letexception(_4, _6), _3 )
-# 8430 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__6_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__6_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 8441 "parsing/parser.ml"
-         in
+# 8672 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -8501,46 +8733,48 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 8513 "parsing/parser.ml"
+# 8746 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 8519 "parsing/parser.ml"
-            
-          in
-          let _3 = 
-# 3964 "parsing/parser.mly"
+# 8752 "parsing/parser.ml"
+              
+            in
+            let _3 = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 8525 "parsing/parser.ml"
-           in
-          
-# 2439 "parsing/parser.mly"
+# 8758 "parsing/parser.ml"
+             in
+            
+# 2461 "parsing/parser.mly"
       ( let open_loc = make_loc (_startpos__2_, _endpos__5_) in
         let od = Opn.mk _5 ~override:_3 ~loc:open_loc in
         Pexp_open(od, _7), _4 )
-# 8532 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__7_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+# 8765 "parsing/parser.ml"
+            
+          in
+          let _endpos__1_ = _endpos__7_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 8543 "parsing/parser.ml"
-         in
+# 8776 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -8610,46 +8844,48 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 =
-            let (_1_inlined1, _1) = (_1_inlined3, _1_inlined2) in
-            let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 =
+              let (_1_inlined1, _1) = (_1_inlined3, _1_inlined2) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 8622 "parsing/parser.ml"
+# 8857 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 8628 "parsing/parser.ml"
-            
-          in
-          let _3 = 
-# 3965 "parsing/parser.mly"
+# 8863 "parsing/parser.ml"
+              
+            in
+            let _3 = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 8634 "parsing/parser.ml"
-           in
-          
-# 2439 "parsing/parser.mly"
+# 8869 "parsing/parser.ml"
+             in
+            
+# 2461 "parsing/parser.mly"
       ( let open_loc = make_loc (_startpos__2_, _endpos__5_) in
         let od = Opn.mk _5 ~override:_3 ~loc:open_loc in
         Pexp_open(od, _7), _4 )
-# 8641 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__7_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+# 8876 "parsing/parser.ml"
+            
+          in
+          let _endpos__1_ = _endpos__7_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 8652 "parsing/parser.ml"
-         in
+# 8887 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -8712,41 +8948,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+        let _v =
+          let _1 =
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 8724 "parsing/parser.ml"
+# 8961 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 8730 "parsing/parser.ml"
+# 8967 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2445 "parsing/parser.mly"
+# 2467 "parsing/parser.mly"
       ( let body_constraint = Option.map (fun x -> Pconstraint x) _4 in
         mkfunction _3 body_constraint _6, _2
       )
-# 8738 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__6_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+# 8975 "parsing/parser.ml"
+            
+          in
+          let _endpos__1_ = _endpos__6_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 8749 "parsing/parser.ml"
-         in
+# 8986 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -8802,58 +9040,60 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _5 =
-            let xs =
-              let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let _5 =
+              let xs =
+                let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 8812 "parsing/parser.ml"
-               in
+# 9051 "parsing/parser.ml"
+                 in
+                
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 9056 "parsing/parser.ml"
+                
+              in
               
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 8817 "parsing/parser.ml"
+# 9062 "parsing/parser.ml"
               
             in
-            
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 8823 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 8833 "parsing/parser.ml"
+# 9072 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 9078 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 8839 "parsing/parser.ml"
+# 2471 "parsing/parser.mly"
+      ( Pexp_match(_3, _5), _2 )
+# 9084 "parsing/parser.ml"
             
           in
-          
-# 2449 "parsing/parser.mly"
-      ( Pexp_match(_3, _5), _2 )
-# 8845 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos_xs_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos_xs_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 8856 "parsing/parser.ml"
-         in
+# 9095 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -8909,58 +9149,60 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _5 =
-            let xs =
-              let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let _5 =
+              let xs =
+                let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 8919 "parsing/parser.ml"
-               in
+# 9160 "parsing/parser.ml"
+                 in
+                
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 9165 "parsing/parser.ml"
+                
+              in
               
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 8924 "parsing/parser.ml"
+# 9171 "parsing/parser.ml"
               
             in
-            
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 8930 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 8940 "parsing/parser.ml"
+# 9181 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 9187 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 8946 "parsing/parser.ml"
+# 2473 "parsing/parser.mly"
+      ( Pexp_try(_3, _5), _2 )
+# 9193 "parsing/parser.ml"
             
           in
-          
-# 2451 "parsing/parser.mly"
-      ( Pexp_try(_3, _5), _2 )
-# 8952 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos_xs_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos_xs_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 8963 "parsing/parser.ml"
-         in
+# 9204 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -9016,39 +9258,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+        let _v =
+          let _1 =
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 9028 "parsing/parser.ml"
+# 9271 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 9277 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 9034 "parsing/parser.ml"
+# 2475 "parsing/parser.mly"
+      ( syntax_error() )
+# 9283 "parsing/parser.ml"
             
           in
-          
-# 2453 "parsing/parser.mly"
-      ( syntax_error() )
-# 9040 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__5_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__5_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 9051 "parsing/parser.ml"
-         in
+# 9294 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -9118,65 +9362,67 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _7 =
-            let _1 = _1_inlined4 in
-            let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _7 =
+              let _1 = _1_inlined4 in
+              let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 9128 "parsing/parser.ml"
-             in
-            
-# 2431 "parsing/parser.mly"
+# 9373 "parsing/parser.ml"
+               in
+              
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 9133 "parsing/parser.ml"
-            
-          in
-          let _5 =
-            let _1 = _1_inlined3 in
-            let _1 = 
-# 2287 "parsing/parser.mly"
+# 9378 "parsing/parser.ml"
+              
+            in
+            let _5 =
+              let _1 = _1_inlined3 in
+              let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 9141 "parsing/parser.ml"
-             in
-            
-# 2431 "parsing/parser.mly"
+# 9386 "parsing/parser.ml"
+               in
+              
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 9146 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 9391 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _2 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 9156 "parsing/parser.ml"
+# 9401 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 9407 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 9162 "parsing/parser.ml"
+# 2477 "parsing/parser.mly"
+      ( Pexp_ifthenelse(_3, _5, Some _7), _2 )
+# 9413 "parsing/parser.ml"
             
           in
-          
-# 2455 "parsing/parser.mly"
-      ( Pexp_ifthenelse(_3, _5, Some _7), _2 )
-# 9168 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__1_inlined4_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__1_inlined4_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 9179 "parsing/parser.ml"
-         in
+# 9424 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -9267,51 +9513,52 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _7 =
-            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined4_, _1_inlined6, _1_inlined5) in
-            let _1 =
-              let _3 =
-                let xs =
-                  let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let _7 =
+              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined4_, _1_inlined6, _1_inlined5) in
+              let _1 =
+                let _3 =
+                  let xs =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 9280 "parsing/parser.ml"
-                   in
+# 9527 "parsing/parser.ml"
+                     in
+                    
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 9532 "parsing/parser.ml"
+                    
+                  in
                   
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 9285 "parsing/parser.ml"
+# 9538 "parsing/parser.ml"
                   
                 in
-                
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 9291 "parsing/parser.ml"
-                
-              in
-              let _endpos__3_ = _endpos_xs_ in
-              let _2 =
-                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _endpos__3_ = _endpos_xs_ in
                 let _2 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _2 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 9302 "parsing/parser.ml"
+# 9549 "parsing/parser.ml"
+                    
+                  in
                   
-                in
-                
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 9308 "parsing/parser.ml"
+# 9555 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos__3_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos__3_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -9324,60 +9571,61 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 9328 "parsing/parser.ml"
+# 9575 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 9334 "parsing/parser.ml"
-            
-          in
-          let _5 =
-            let _1 = _1_inlined3 in
-            let _1 = 
-# 2287 "parsing/parser.mly"
+# 9581 "parsing/parser.ml"
+              
+            in
+            let _5 =
+              let _1 = _1_inlined3 in
+              let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 9342 "parsing/parser.ml"
-             in
-            
-# 2431 "parsing/parser.mly"
+# 9589 "parsing/parser.ml"
+               in
+              
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 9347 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 9594 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _2 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 9357 "parsing/parser.ml"
+# 9604 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 9610 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 9363 "parsing/parser.ml"
+# 2477 "parsing/parser.mly"
+      ( Pexp_ifthenelse(_3, _5, Some _7), _2 )
+# 9616 "parsing/parser.ml"
             
           in
-          
-# 2455 "parsing/parser.mly"
-      ( Pexp_ifthenelse(_3, _5, Some _7), _2 )
-# 9369 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos_xs_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos_xs_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 9380 "parsing/parser.ml"
-         in
+# 9627 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -9468,64 +9716,65 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined6_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _7 =
-            let _1 = _1_inlined6 in
-            let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _7 =
+              let _1 = _1_inlined6 in
+              let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 9478 "parsing/parser.ml"
-             in
-            
-# 2431 "parsing/parser.mly"
+# 9727 "parsing/parser.ml"
+               in
+              
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 9483 "parsing/parser.ml"
-            
-          in
-          let _5 =
-            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined3_, _1_inlined5, _1_inlined4) in
-            let _1 =
-              let _3 =
-                let xs =
-                  let xs = 
-# 253 "<standard.mly>"
+# 9732 "parsing/parser.ml"
+              
+            in
+            let _5 =
+              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined3_, _1_inlined5, _1_inlined4) in
+              let _1 =
+                let _3 =
+                  let xs =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 9494 "parsing/parser.ml"
-                   in
+# 9743 "parsing/parser.ml"
+                     in
+                    
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 9748 "parsing/parser.ml"
+                    
+                  in
                   
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 9499 "parsing/parser.ml"
+# 9754 "parsing/parser.ml"
                   
                 in
-                
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 9505 "parsing/parser.ml"
-                
-              in
-              let _endpos__3_ = _endpos_xs_ in
-              let _2 =
-                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _endpos__3_ = _endpos_xs_ in
                 let _2 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _2 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 9516 "parsing/parser.ml"
+# 9765 "parsing/parser.ml"
+                    
+                  in
                   
-                in
-                
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 9522 "parsing/parser.ml"
+# 9771 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos__3_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos__3_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -9538,47 +9787,48 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 9542 "parsing/parser.ml"
+# 9791 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 9548 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 9797 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _2 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 9558 "parsing/parser.ml"
+# 9807 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 9813 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 9564 "parsing/parser.ml"
+# 2477 "parsing/parser.mly"
+      ( Pexp_ifthenelse(_3, _5, Some _7), _2 )
+# 9819 "parsing/parser.ml"
             
           in
-          
-# 2455 "parsing/parser.mly"
-      ( Pexp_ifthenelse(_3, _5, Some _7), _2 )
-# 9570 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__1_inlined6_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__1_inlined6_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 9581 "parsing/parser.ml"
-         in
+# 9830 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -9690,51 +9940,52 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _7 =
-            let (_endpos_xs_, _startpos__1_, xs, _1_inlined2, _1_inlined1) = (_endpos_xs_inlined1_, _startpos__1_inlined6_, xs_inlined1, _1_inlined8, _1_inlined7) in
-            let _1 =
-              let _3 =
-                let xs =
-                  let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let _7 =
+              let (_endpos_xs_, _startpos__1_, xs, _1_inlined2, _1_inlined1) = (_endpos_xs_inlined1_, _startpos__1_inlined6_, xs_inlined1, _1_inlined8, _1_inlined7) in
+              let _1 =
+                let _3 =
+                  let xs =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 9703 "parsing/parser.ml"
-                   in
+# 9954 "parsing/parser.ml"
+                     in
+                    
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 9959 "parsing/parser.ml"
+                    
+                  in
                   
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 9708 "parsing/parser.ml"
+# 9965 "parsing/parser.ml"
                   
                 in
-                
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 9714 "parsing/parser.ml"
-                
-              in
-              let _endpos__3_ = _endpos_xs_ in
-              let _2 =
-                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _endpos__3_ = _endpos_xs_ in
                 let _2 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _2 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 9725 "parsing/parser.ml"
+# 9976 "parsing/parser.ml"
+                    
+                  in
                   
-                in
-                
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 9731 "parsing/parser.ml"
+# 9982 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos__3_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos__3_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -9747,59 +9998,59 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 9751 "parsing/parser.ml"
+# 10002 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 9757 "parsing/parser.ml"
-            
-          in
-          let _5 =
-            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined3_, _1_inlined5, _1_inlined4) in
-            let _1 =
-              let _3 =
-                let xs =
-                  let xs = 
-# 253 "<standard.mly>"
+# 10008 "parsing/parser.ml"
+              
+            in
+            let _5 =
+              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined3_, _1_inlined5, _1_inlined4) in
+              let _1 =
+                let _3 =
+                  let xs =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 9768 "parsing/parser.ml"
-                   in
+# 10019 "parsing/parser.ml"
+                     in
+                    
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 10024 "parsing/parser.ml"
+                    
+                  in
                   
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 9773 "parsing/parser.ml"
+# 10030 "parsing/parser.ml"
                   
                 in
-                
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 9779 "parsing/parser.ml"
-                
-              in
-              let _endpos__3_ = _endpos_xs_ in
-              let _2 =
-                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _endpos__3_ = _endpos_xs_ in
                 let _2 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _2 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 9790 "parsing/parser.ml"
+# 10041 "parsing/parser.ml"
+                    
+                  in
                   
-                in
-                
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 9796 "parsing/parser.ml"
+# 10047 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos__3_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos__3_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -9812,47 +10063,48 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 9816 "parsing/parser.ml"
+# 10067 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 9822 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 10073 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _2 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 9832 "parsing/parser.ml"
+# 10083 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 10089 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 9838 "parsing/parser.ml"
+# 2477 "parsing/parser.mly"
+      ( Pexp_ifthenelse(_3, _5, Some _7), _2 )
+# 10095 "parsing/parser.ml"
             
           in
-          
-# 2455 "parsing/parser.mly"
-      ( Pexp_ifthenelse(_3, _5, Some _7), _2 )
-# 9844 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos_xs_inlined1_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos_xs_inlined1_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 9855 "parsing/parser.ml"
-         in
+# 10106 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -9908,52 +10160,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _5 =
-            let _1 = _1_inlined3 in
-            let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _5 =
+              let _1 = _1_inlined3 in
+              let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 9918 "parsing/parser.ml"
-             in
-            
-# 2431 "parsing/parser.mly"
+# 10171 "parsing/parser.ml"
+               in
+              
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 9923 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 10176 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _2 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 9933 "parsing/parser.ml"
+# 10186 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 10192 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 9939 "parsing/parser.ml"
+# 2479 "parsing/parser.mly"
+      ( Pexp_ifthenelse(_3, _5, None), _2 )
+# 10198 "parsing/parser.ml"
             
           in
-          
-# 2457 "parsing/parser.mly"
-      ( Pexp_ifthenelse(_3, _5, None), _2 )
-# 9945 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__1_inlined3_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__1_inlined3_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 9956 "parsing/parser.ml"
-         in
+# 10209 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10030,51 +10284,52 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _5 =
-            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined3_, _1_inlined5, _1_inlined4) in
-            let _1 =
-              let _3 =
-                let xs =
-                  let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let _5 =
+              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined3_, _1_inlined5, _1_inlined4) in
+              let _1 =
+                let _3 =
+                  let xs =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 10043 "parsing/parser.ml"
-                   in
+# 10298 "parsing/parser.ml"
+                     in
+                    
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 10303 "parsing/parser.ml"
+                    
+                  in
                   
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 10048 "parsing/parser.ml"
+# 10309 "parsing/parser.ml"
                   
                 in
-                
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 10054 "parsing/parser.ml"
-                
-              in
-              let _endpos__3_ = _endpos_xs_ in
-              let _2 =
-                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _endpos__3_ = _endpos_xs_ in
                 let _2 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _2 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 10065 "parsing/parser.ml"
+# 10320 "parsing/parser.ml"
+                    
+                  in
                   
-                in
-                
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 10071 "parsing/parser.ml"
+# 10326 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos__3_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos__3_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -10087,47 +10342,48 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 10091 "parsing/parser.ml"
+# 10346 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 10097 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 10352 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _2 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 10107 "parsing/parser.ml"
+# 10362 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 10368 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 10113 "parsing/parser.ml"
+# 2479 "parsing/parser.mly"
+      ( Pexp_ifthenelse(_3, _5, None), _2 )
+# 10374 "parsing/parser.ml"
             
           in
-          
-# 2457 "parsing/parser.mly"
-      ( Pexp_ifthenelse(_3, _5, None), _2 )
-# 10119 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos_xs_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos_xs_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 10130 "parsing/parser.ml"
-         in
+# 10385 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10190,44 +10446,46 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 = 
-# 2470 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 = 
+# 2492 "parsing/parser.mly"
       ( e )
-# 10198 "parsing/parser.ml"
-           in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+# 10455 "parsing/parser.ml"
+             in
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 10207 "parsing/parser.ml"
+# 10464 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 10470 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 10213 "parsing/parser.ml"
+# 2481 "parsing/parser.mly"
+      ( Pexp_while(_3, _4), _2 )
+# 10476 "parsing/parser.ml"
             
           in
-          
-# 2459 "parsing/parser.mly"
-      ( Pexp_while(_3, _4), _2 )
-# 10219 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__3_inlined1_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__3_inlined1_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 10230 "parsing/parser.ml"
-         in
+# 10487 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10290,49 +10548,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 =
-            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in
-            let _loc__2_ = (_startpos__2_, _endpos__2_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2472 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 =
+              let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in
+              let _loc__2_ = (_startpos__2_, _endpos__2_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 2494 "parsing/parser.mly"
       ( unclosed "do" _loc__1_ "done" _loc__2_ )
-# 10302 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 10561 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _2 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 10312 "parsing/parser.ml"
+# 10571 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 10577 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 10318 "parsing/parser.ml"
+# 2481 "parsing/parser.mly"
+      ( Pexp_while(_3, _4), _2 )
+# 10583 "parsing/parser.ml"
             
           in
-          
-# 2459 "parsing/parser.mly"
-      ( Pexp_while(_3, _4), _2 )
-# 10324 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__3_inlined1_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__3_inlined1_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 10335 "parsing/parser.ml"
-         in
+# 10594 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10423,44 +10683,46 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _8 = 
-# 2470 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _8 = 
+# 2492 "parsing/parser.mly"
       ( e )
-# 10431 "parsing/parser.ml"
-           in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+# 10692 "parsing/parser.ml"
+             in
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 10440 "parsing/parser.ml"
+# 10701 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 10707 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 10446 "parsing/parser.ml"
+# 2484 "parsing/parser.mly"
+      ( Pexp_for(_3, _5, _7, _6, _8), _2 )
+# 10713 "parsing/parser.ml"
             
           in
-          
-# 2462 "parsing/parser.mly"
-      ( Pexp_for(_3, _5, _7, _6, _8), _2 )
-# 10452 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__3_inlined1_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__3_inlined1_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 10463 "parsing/parser.ml"
-         in
+# 10724 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10551,49 +10813,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _8 =
-            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in
-            let _loc__2_ = (_startpos__2_, _endpos__2_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2472 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _8 =
+              let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in
+              let _loc__2_ = (_startpos__2_, _endpos__2_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 2494 "parsing/parser.mly"
       ( unclosed "do" _loc__1_ "done" _loc__2_ )
-# 10563 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 10826 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _2 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 10573 "parsing/parser.ml"
+# 10836 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 10842 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 10579 "parsing/parser.ml"
+# 2484 "parsing/parser.mly"
+      ( Pexp_for(_3, _5, _7, _6, _8), _2 )
+# 10848 "parsing/parser.ml"
             
           in
-          
-# 2462 "parsing/parser.mly"
-      ( Pexp_for(_3, _5, _7, _6, _8), _2 )
-# 10585 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__3_inlined1_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__3_inlined1_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 10596 "parsing/parser.ml"
-         in
+# 10859 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10635,39 +10899,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+        let _v =
+          let _1 =
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 10647 "parsing/parser.ml"
+# 10912 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 10918 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 10653 "parsing/parser.ml"
+# 2486 "parsing/parser.mly"
+      ( Pexp_assert _3, _2 )
+# 10924 "parsing/parser.ml"
             
           in
-          
-# 2464 "parsing/parser.mly"
-      ( Pexp_assert _3, _2 )
-# 10659 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__3_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__3_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 10670 "parsing/parser.ml"
-         in
+# 10935 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10709,39 +10975,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+        let _v =
+          let _1 =
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 10721 "parsing/parser.ml"
+# 10988 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 10994 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 10727 "parsing/parser.ml"
+# 2488 "parsing/parser.mly"
+      ( Pexp_lazy _3, _2 )
+# 11000 "parsing/parser.ml"
             
           in
-          
-# 2466 "parsing/parser.mly"
-      ( Pexp_lazy _3, _2 )
-# 10733 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__3_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2401 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__3_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2423 "parsing/parser.mly"
       ( let desc, attrs = _1 in
         mkexp_attrs ~loc:_sloc desc attrs )
-# 10744 "parsing/parser.ml"
-         in
+# 11011 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10769,41 +11037,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let _2 =
+                let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 10779 "parsing/parser.ml"
-               in
-              
-# 1062 "parsing/parser.mly"
+# 11048 "parsing/parser.ml"
+                 in
+                
+# 1086 "parsing/parser.mly"
     ( xs )
-# 10784 "parsing/parser.ml"
+# 11053 "parsing/parser.ml"
+                
+              in
+              
+# 2498 "parsing/parser.mly"
+      ( Pexp_apply(_1, _2) )
+# 11059 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos_xs_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2476 "parsing/parser.mly"
-      ( Pexp_apply(_1, _2) )
-# 10790 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 11069 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_xs_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 10800 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 10806 "parsing/parser.ml"
-         in
+# 11075 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10824,48 +11094,50 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let es =
-                let xs = 
-# 253 "<standard.mly>"
+              let _1 =
+                let es =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 10835 "parsing/parser.ml"
-                 in
-                
-# 1143 "parsing/parser.mly"
+# 11106 "parsing/parser.ml"
+                   in
+                  
+# 1167 "parsing/parser.mly"
     ( xs )
-# 10840 "parsing/parser.ml"
+# 11111 "parsing/parser.ml"
+                  
+                in
+                
+# 2833 "parsing/parser.mly"
+    ( es )
+# 11117 "parsing/parser.ml"
                 
               in
               
-# 2791 "parsing/parser.mly"
-    ( es )
-# 10846 "parsing/parser.ml"
+# 2500 "parsing/parser.mly"
+      ( Pexp_tuple(_1) )
+# 11123 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2478 "parsing/parser.mly"
-      ( Pexp_tuple(_1) )
-# 10852 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 11133 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 10862 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 10868 "parsing/parser.ml"
-         in
+# 11139 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10893,39 +11165,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 10906 "parsing/parser.ml"
+# 11179 "parsing/parser.ml"
+                
+              in
+              
+# 2502 "parsing/parser.mly"
+      ( Pexp_construct(_1, Some _2) )
+# 11185 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2480 "parsing/parser.mly"
-      ( Pexp_construct(_1, Some _2) )
-# 10912 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 11195 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 10922 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 10928 "parsing/parser.ml"
-         in
+# 11201 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -10953,27 +11227,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _1 = 
-# 2482 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2504 "parsing/parser.mly"
       ( Pexp_variant(_1, Some _2) )
-# 10961 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 11236 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 10970 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+# 11245 "parsing/parser.ml"
+            
+          in
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 10976 "parsing/parser.ml"
-         in
+# 11251 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -11004,65 +11280,67 @@ module Tables = struct
         } = _menhir_stack in
         let _1 : (Parsetree.expression) = Obj.magic _1 in
         let op : (
-# 754 "parsing/parser.mly"
+# 773 "parsing/parser.mly"
        (string)
-# 11010 "parsing/parser.ml"
+# 11286 "parsing/parser.ml"
         ) = Obj.magic op in
         let e1 : (Parsetree.expression) = Obj.magic e1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 11022 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 11299 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 11027 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3770 "parsing/parser.mly"
+# 11304 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3822 "parsing/parser.mly"
                   ( op )
-# 11034 "parsing/parser.ml"
-               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 11311 "parsing/parser.ml"
+                 in
+                let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 11043 "parsing/parser.ml"
+# 11320 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 11326 "parsing/parser.ml"
               
             in
+            let _startpos__1_ = _startpos_e1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 11049 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 11336 "parsing/parser.ml"
             
           in
-          let _startpos__1_ = _startpos_e1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 11059 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 11065 "parsing/parser.ml"
-         in
+# 11342 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -11114,59 +11392,60 @@ module Tables = struct
         let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
         let _1 : unit = Obj.magic _1 in
         let op : (
-# 754 "parsing/parser.mly"
+# 773 "parsing/parser.mly"
        (string)
-# 11120 "parsing/parser.ml"
+# 11398 "parsing/parser.ml"
         ) = Obj.magic op in
         let e1 : (Parsetree.expression) = Obj.magic e1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 11135 "parsing/parser.ml"
-                     in
+# 11414 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 11419 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 11140 "parsing/parser.ml"
+# 11425 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 11146 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 11157 "parsing/parser.ml"
+# 11436 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 11163 "parsing/parser.ml"
+# 11442 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -11179,52 +11458,53 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 11183 "parsing/parser.ml"
+# 11462 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 11189 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3770 "parsing/parser.mly"
+# 11468 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3822 "parsing/parser.mly"
                   ( op )
-# 11196 "parsing/parser.ml"
-               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 11475 "parsing/parser.ml"
+                 in
+                let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 11205 "parsing/parser.ml"
+# 11484 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 11490 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 11211 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 11500 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 11221 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 11227 "parsing/parser.ml"
-         in
+# 11506 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -11255,65 +11535,67 @@ module Tables = struct
         } = _menhir_stack in
         let _1 : (Parsetree.expression) = Obj.magic _1 in
         let op : (
-# 755 "parsing/parser.mly"
+# 774 "parsing/parser.mly"
        (string)
-# 11261 "parsing/parser.ml"
+# 11541 "parsing/parser.ml"
         ) = Obj.magic op in
         let e1 : (Parsetree.expression) = Obj.magic e1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 11273 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 11554 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 11278 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3771 "parsing/parser.mly"
+# 11559 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3823 "parsing/parser.mly"
                   ( op )
-# 11285 "parsing/parser.ml"
-               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 11566 "parsing/parser.ml"
+                 in
+                let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 11294 "parsing/parser.ml"
+# 11575 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 11581 "parsing/parser.ml"
               
             in
+            let _startpos__1_ = _startpos_e1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 11300 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 11591 "parsing/parser.ml"
             
           in
-          let _startpos__1_ = _startpos_e1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 11310 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 11316 "parsing/parser.ml"
-         in
+# 11597 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -11365,59 +11647,60 @@ module Tables = struct
         let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
         let _1 : unit = Obj.magic _1 in
         let op : (
-# 755 "parsing/parser.mly"
+# 774 "parsing/parser.mly"
        (string)
-# 11371 "parsing/parser.ml"
+# 11653 "parsing/parser.ml"
         ) = Obj.magic op in
         let e1 : (Parsetree.expression) = Obj.magic e1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 11386 "parsing/parser.ml"
-                     in
+# 11669 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 11674 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 11391 "parsing/parser.ml"
+# 11680 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 11397 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 11408 "parsing/parser.ml"
+# 11691 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 11414 "parsing/parser.ml"
+# 11697 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -11430,52 +11713,53 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 11434 "parsing/parser.ml"
+# 11717 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 11440 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3771 "parsing/parser.mly"
+# 11723 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3823 "parsing/parser.mly"
                   ( op )
-# 11447 "parsing/parser.ml"
-               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 11730 "parsing/parser.ml"
+                 in
+                let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 11456 "parsing/parser.ml"
+# 11739 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 11745 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 11462 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 11755 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 11472 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 11478 "parsing/parser.ml"
-         in
+# 11761 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -11506,65 +11790,67 @@ module Tables = struct
         } = _menhir_stack in
         let _1 : (Parsetree.expression) = Obj.magic _1 in
         let op : (
-# 756 "parsing/parser.mly"
+# 775 "parsing/parser.mly"
        (string)
-# 11512 "parsing/parser.ml"
+# 11796 "parsing/parser.ml"
         ) = Obj.magic op in
         let e1 : (Parsetree.expression) = Obj.magic e1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 11524 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 11809 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 11529 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3772 "parsing/parser.mly"
+# 11814 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3824 "parsing/parser.mly"
                   ( op )
-# 11536 "parsing/parser.ml"
-               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 11821 "parsing/parser.ml"
+                 in
+                let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 11545 "parsing/parser.ml"
+# 11830 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 11836 "parsing/parser.ml"
               
             in
+            let _startpos__1_ = _startpos_e1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 11551 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 11846 "parsing/parser.ml"
             
           in
-          let _startpos__1_ = _startpos_e1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 11561 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 11567 "parsing/parser.ml"
-         in
+# 11852 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -11616,59 +11902,60 @@ module Tables = struct
         let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
         let _1 : unit = Obj.magic _1 in
         let op : (
-# 756 "parsing/parser.mly"
+# 775 "parsing/parser.mly"
        (string)
-# 11622 "parsing/parser.ml"
+# 11908 "parsing/parser.ml"
         ) = Obj.magic op in
         let e1 : (Parsetree.expression) = Obj.magic e1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 11637 "parsing/parser.ml"
-                     in
+# 11924 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 11929 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 11642 "parsing/parser.ml"
+# 11935 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 11648 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 11659 "parsing/parser.ml"
+# 11946 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 11665 "parsing/parser.ml"
+# 11952 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -11681,52 +11968,53 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 11685 "parsing/parser.ml"
+# 11972 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 11691 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3772 "parsing/parser.mly"
+# 11978 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3824 "parsing/parser.mly"
                   ( op )
-# 11698 "parsing/parser.ml"
-               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 11985 "parsing/parser.ml"
+                 in
+                let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 11707 "parsing/parser.ml"
+# 11994 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 12000 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 11713 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 12010 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 11723 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 11729 "parsing/parser.ml"
-         in
+# 12016 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -11757,65 +12045,67 @@ module Tables = struct
         } = _menhir_stack in
         let _1 : (Parsetree.expression) = Obj.magic _1 in
         let op : (
-# 757 "parsing/parser.mly"
+# 776 "parsing/parser.mly"
        (string)
-# 11763 "parsing/parser.ml"
+# 12051 "parsing/parser.ml"
         ) = Obj.magic op in
         let e1 : (Parsetree.expression) = Obj.magic e1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 11775 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 12064 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 11780 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3773 "parsing/parser.mly"
+# 12069 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3825 "parsing/parser.mly"
                   ( op )
-# 11787 "parsing/parser.ml"
-               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 12076 "parsing/parser.ml"
+                 in
+                let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 11796 "parsing/parser.ml"
+# 12085 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 12091 "parsing/parser.ml"
               
             in
+            let _startpos__1_ = _startpos_e1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 11802 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 12101 "parsing/parser.ml"
             
           in
-          let _startpos__1_ = _startpos_e1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 11812 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 11818 "parsing/parser.ml"
-         in
+# 12107 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -11867,59 +12157,60 @@ module Tables = struct
         let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
         let _1 : unit = Obj.magic _1 in
         let op : (
-# 757 "parsing/parser.mly"
+# 776 "parsing/parser.mly"
        (string)
-# 11873 "parsing/parser.ml"
+# 12163 "parsing/parser.ml"
         ) = Obj.magic op in
         let e1 : (Parsetree.expression) = Obj.magic e1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 11888 "parsing/parser.ml"
-                     in
+# 12179 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 12184 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 11893 "parsing/parser.ml"
+# 12190 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 11899 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 11910 "parsing/parser.ml"
+# 12201 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 11916 "parsing/parser.ml"
+# 12207 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -11932,52 +12223,53 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 11936 "parsing/parser.ml"
+# 12227 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 11942 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3773 "parsing/parser.mly"
+# 12233 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3825 "parsing/parser.mly"
                   ( op )
-# 11949 "parsing/parser.ml"
-               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 12240 "parsing/parser.ml"
+                 in
+                let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 11958 "parsing/parser.ml"
+# 12249 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 12255 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 11964 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 12265 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 11974 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 11980 "parsing/parser.ml"
-         in
+# 12271 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -12008,65 +12300,67 @@ module Tables = struct
         } = _menhir_stack in
         let _1 : (Parsetree.expression) = Obj.magic _1 in
         let op : (
-# 758 "parsing/parser.mly"
+# 777 "parsing/parser.mly"
        (string)
-# 12014 "parsing/parser.ml"
+# 12306 "parsing/parser.ml"
         ) = Obj.magic op in
         let e1 : (Parsetree.expression) = Obj.magic e1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 12026 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 12319 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 12031 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3774 "parsing/parser.mly"
+# 12324 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3826 "parsing/parser.mly"
                   ( op )
-# 12038 "parsing/parser.ml"
-               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 12331 "parsing/parser.ml"
+                 in
+                let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 12047 "parsing/parser.ml"
+# 12340 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 12346 "parsing/parser.ml"
               
             in
+            let _startpos__1_ = _startpos_e1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 12053 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 12356 "parsing/parser.ml"
             
           in
-          let _startpos__1_ = _startpos_e1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 12063 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 12069 "parsing/parser.ml"
-         in
+# 12362 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -12118,59 +12412,60 @@ module Tables = struct
         let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
         let _1 : unit = Obj.magic _1 in
         let op : (
-# 758 "parsing/parser.mly"
+# 777 "parsing/parser.mly"
        (string)
-# 12124 "parsing/parser.ml"
+# 12418 "parsing/parser.ml"
         ) = Obj.magic op in
         let e1 : (Parsetree.expression) = Obj.magic e1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 12139 "parsing/parser.ml"
-                     in
+# 12434 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 12439 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 12144 "parsing/parser.ml"
+# 12445 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 12150 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 12161 "parsing/parser.ml"
+# 12456 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 12167 "parsing/parser.ml"
+# 12462 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -12183,52 +12478,53 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 12187 "parsing/parser.ml"
+# 12482 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 12193 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3774 "parsing/parser.mly"
+# 12488 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3826 "parsing/parser.mly"
                   ( op )
-# 12200 "parsing/parser.ml"
-               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 12495 "parsing/parser.ml"
+                 in
+                let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 12209 "parsing/parser.ml"
+# 12504 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 12510 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 12215 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 12520 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 12225 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 12231 "parsing/parser.ml"
-         in
+# 12526 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -12263,57 +12559,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 12274 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 12571 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 12279 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3775 "parsing/parser.mly"
+# 12576 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3827 "parsing/parser.mly"
                    ("+")
-# 12286 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 12583 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 12294 "parsing/parser.ml"
+# 12591 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 12597 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 12300 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 12607 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 12310 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 12316 "parsing/parser.ml"
-         in
+# 12613 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -12369,52 +12667,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 12383 "parsing/parser.ml"
-                     in
+# 12682 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 12687 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 12388 "parsing/parser.ml"
+# 12693 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 12394 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 12405 "parsing/parser.ml"
+# 12704 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 12411 "parsing/parser.ml"
+# 12710 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -12427,51 +12726,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 12431 "parsing/parser.ml"
+# 12730 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 12437 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3775 "parsing/parser.mly"
+# 12736 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3827 "parsing/parser.mly"
                    ("+")
-# 12444 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 12743 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 12452 "parsing/parser.ml"
+# 12751 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 12757 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 12458 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 12767 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 12468 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 12474 "parsing/parser.ml"
-         in
+# 12773 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -12506,57 +12806,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 12517 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 12818 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 12522 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3776 "parsing/parser.mly"
+# 12823 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3828 "parsing/parser.mly"
                   ("+.")
-# 12529 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 12830 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 12537 "parsing/parser.ml"
+# 12838 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 12844 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 12543 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 12854 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 12553 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 12559 "parsing/parser.ml"
-         in
+# 12860 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -12612,52 +12914,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 12626 "parsing/parser.ml"
-                     in
+# 12929 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 12934 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 12631 "parsing/parser.ml"
+# 12940 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 12637 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 12648 "parsing/parser.ml"
+# 12951 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 12654 "parsing/parser.ml"
+# 12957 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -12670,51 +12973,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 12674 "parsing/parser.ml"
+# 12977 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 12680 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3776 "parsing/parser.mly"
+# 12983 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3828 "parsing/parser.mly"
                   ("+.")
-# 12687 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 12990 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 12695 "parsing/parser.ml"
+# 12998 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 13004 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 12701 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 13014 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 12711 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 12717 "parsing/parser.ml"
-         in
+# 13020 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -12749,57 +13053,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 12760 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 13065 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 12765 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3777 "parsing/parser.mly"
+# 13070 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3829 "parsing/parser.mly"
                   ("+=")
-# 12772 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 13077 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 12780 "parsing/parser.ml"
+# 13085 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 13091 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 12786 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 13101 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 12796 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 12802 "parsing/parser.ml"
-         in
+# 13107 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -12855,52 +13161,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 12869 "parsing/parser.ml"
-                     in
+# 13176 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 13181 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 12874 "parsing/parser.ml"
+# 13187 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 12880 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 12891 "parsing/parser.ml"
+# 13198 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 12897 "parsing/parser.ml"
+# 13204 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -12913,51 +13220,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 12917 "parsing/parser.ml"
+# 13224 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 12923 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3777 "parsing/parser.mly"
+# 13230 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3829 "parsing/parser.mly"
                   ("+=")
-# 12930 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 13237 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 12938 "parsing/parser.ml"
+# 13245 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 13251 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 12944 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 13261 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 12954 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 12960 "parsing/parser.ml"
-         in
+# 13267 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -12992,57 +13300,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 13003 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 13312 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 13008 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3778 "parsing/parser.mly"
+# 13317 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3830 "parsing/parser.mly"
                    ("-")
-# 13015 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 13324 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 13023 "parsing/parser.ml"
+# 13332 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 13338 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 13029 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 13348 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 13039 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 13045 "parsing/parser.ml"
-         in
+# 13354 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -13098,52 +13408,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 13112 "parsing/parser.ml"
-                     in
+# 13423 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 13428 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 13117 "parsing/parser.ml"
+# 13434 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 13123 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 13134 "parsing/parser.ml"
+# 13445 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 13140 "parsing/parser.ml"
+# 13451 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -13156,51 +13467,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 13160 "parsing/parser.ml"
+# 13471 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 13166 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3778 "parsing/parser.mly"
+# 13477 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3830 "parsing/parser.mly"
                    ("-")
-# 13173 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 13484 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 13181 "parsing/parser.ml"
+# 13492 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 13498 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 13187 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 13508 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 13197 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 13203 "parsing/parser.ml"
-         in
+# 13514 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -13235,57 +13547,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 13246 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 13559 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 13251 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3779 "parsing/parser.mly"
+# 13564 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3831 "parsing/parser.mly"
                   ("-.")
-# 13258 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 13571 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 13266 "parsing/parser.ml"
+# 13579 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 13585 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 13272 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 13595 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 13282 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 13288 "parsing/parser.ml"
-         in
+# 13601 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -13341,52 +13655,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 13355 "parsing/parser.ml"
-                     in
+# 13670 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 13675 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 13360 "parsing/parser.ml"
+# 13681 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 13366 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 13377 "parsing/parser.ml"
+# 13692 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 13383 "parsing/parser.ml"
+# 13698 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -13399,51 +13714,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 13403 "parsing/parser.ml"
+# 13718 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 13409 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3779 "parsing/parser.mly"
+# 13724 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3831 "parsing/parser.mly"
                   ("-.")
-# 13416 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 13731 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 13424 "parsing/parser.ml"
+# 13739 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 13745 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 13430 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 13755 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 13440 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 13446 "parsing/parser.ml"
-         in
+# 13761 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -13478,57 +13794,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 13489 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 13806 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 13494 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3780 "parsing/parser.mly"
+# 13811 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3832 "parsing/parser.mly"
                    ("*")
-# 13501 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 13818 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 13509 "parsing/parser.ml"
+# 13826 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 13832 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 13515 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 13842 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 13525 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 13531 "parsing/parser.ml"
-         in
+# 13848 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -13584,52 +13902,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 13598 "parsing/parser.ml"
-                     in
+# 13917 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 13922 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 13603 "parsing/parser.ml"
+# 13928 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 13609 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 13620 "parsing/parser.ml"
+# 13939 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 13626 "parsing/parser.ml"
+# 13945 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -13642,51 +13961,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 13646 "parsing/parser.ml"
+# 13965 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 13971 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3832 "parsing/parser.mly"
+                   ("*")
+# 13978 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
+   ( mkoperator ~loc:_sloc _1 )
+# 13986 "parsing/parser.ml"
                 
               in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 13652 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3780 "parsing/parser.mly"
-                   ("*")
-# 13659 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
-   ( mkoperator ~loc:_sloc _1 )
-# 13667 "parsing/parser.ml"
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 13992 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 13673 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 14002 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 13683 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 13689 "parsing/parser.ml"
-         in
+# 14008 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -13721,57 +14041,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 13732 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 14053 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 13737 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3781 "parsing/parser.mly"
+# 14058 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3833 "parsing/parser.mly"
                    ("%")
-# 13744 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 14065 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 13752 "parsing/parser.ml"
+# 14073 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 14079 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 13758 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 14089 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 13768 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 13774 "parsing/parser.ml"
-         in
+# 14095 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -13827,52 +14149,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 13841 "parsing/parser.ml"
-                     in
+# 14164 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 14169 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 13846 "parsing/parser.ml"
+# 14175 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 13852 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 13863 "parsing/parser.ml"
+# 14186 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 13869 "parsing/parser.ml"
+# 14192 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -13885,51 +14208,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 13889 "parsing/parser.ml"
+# 14212 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 13895 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3781 "parsing/parser.mly"
+# 14218 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3833 "parsing/parser.mly"
                    ("%")
-# 13902 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 14225 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 13910 "parsing/parser.ml"
+# 14233 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 14239 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 13916 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 14249 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 13926 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 13932 "parsing/parser.ml"
-         in
+# 14255 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -13964,57 +14288,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 13975 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 14300 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 13980 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3782 "parsing/parser.mly"
+# 14305 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3834 "parsing/parser.mly"
                    ("=")
-# 13987 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 14312 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 13995 "parsing/parser.ml"
+# 14320 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 14326 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 14001 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 14336 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 14011 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 14017 "parsing/parser.ml"
-         in
+# 14342 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -14070,52 +14396,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 14084 "parsing/parser.ml"
-                     in
+# 14411 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 14416 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 14089 "parsing/parser.ml"
+# 14422 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 14095 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 14106 "parsing/parser.ml"
+# 14433 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 14112 "parsing/parser.ml"
+# 14439 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -14128,51 +14455,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 14132 "parsing/parser.ml"
+# 14459 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 14138 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3782 "parsing/parser.mly"
+# 14465 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3834 "parsing/parser.mly"
                    ("=")
-# 14145 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 14472 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 14153 "parsing/parser.ml"
+# 14480 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 14486 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 14159 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 14496 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 14169 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 14175 "parsing/parser.ml"
-         in
+# 14502 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -14207,57 +14535,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 14218 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 14547 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 14223 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3783 "parsing/parser.mly"
+# 14552 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3835 "parsing/parser.mly"
                    ("<")
-# 14230 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 14559 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 14238 "parsing/parser.ml"
+# 14567 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 14573 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 14244 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 14583 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 14254 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 14260 "parsing/parser.ml"
-         in
+# 14589 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -14313,52 +14643,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 14327 "parsing/parser.ml"
-                     in
+# 14658 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 14663 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 14332 "parsing/parser.ml"
+# 14669 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 14338 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 14349 "parsing/parser.ml"
+# 14680 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 14355 "parsing/parser.ml"
+# 14686 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -14371,51 +14702,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 14375 "parsing/parser.ml"
+# 14706 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 14381 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3783 "parsing/parser.mly"
+# 14712 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3835 "parsing/parser.mly"
                    ("<")
-# 14388 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 14719 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 14396 "parsing/parser.ml"
+# 14727 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 14733 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 14402 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 14743 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 14412 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 14418 "parsing/parser.ml"
-         in
+# 14749 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -14450,57 +14782,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 14461 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 14794 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 14466 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3784 "parsing/parser.mly"
+# 14799 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3836 "parsing/parser.mly"
                    (">")
-# 14473 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 14806 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 14481 "parsing/parser.ml"
+# 14814 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 14820 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 14487 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 14830 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 14497 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 14503 "parsing/parser.ml"
-         in
+# 14836 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -14556,52 +14890,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 14570 "parsing/parser.ml"
-                     in
+# 14905 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 14910 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 14575 "parsing/parser.ml"
+# 14916 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 14581 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 14592 "parsing/parser.ml"
+# 14927 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 14598 "parsing/parser.ml"
+# 14933 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -14614,51 +14949,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 14618 "parsing/parser.ml"
+# 14953 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 14624 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3784 "parsing/parser.mly"
+# 14959 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3836 "parsing/parser.mly"
                    (">")
-# 14631 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 14966 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 14639 "parsing/parser.ml"
+# 14974 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 14980 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 14645 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 14990 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 14655 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 14661 "parsing/parser.ml"
-         in
+# 14996 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -14693,57 +15029,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 14704 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 15041 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 14709 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3785 "parsing/parser.mly"
+# 15046 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3837 "parsing/parser.mly"
                   ("or")
-# 14716 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 15053 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 14724 "parsing/parser.ml"
+# 15061 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 15067 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 14730 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 15077 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 14740 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 14746 "parsing/parser.ml"
-         in
+# 15083 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -14799,52 +15137,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 14813 "parsing/parser.ml"
-                     in
+# 15152 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 15157 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 14818 "parsing/parser.ml"
+# 15163 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 14824 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 14835 "parsing/parser.ml"
+# 15174 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 14841 "parsing/parser.ml"
+# 15180 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -14857,51 +15196,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 14861 "parsing/parser.ml"
+# 15200 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 14867 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3785 "parsing/parser.mly"
+# 15206 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3837 "parsing/parser.mly"
                   ("or")
-# 14874 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 15213 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 14882 "parsing/parser.ml"
+# 15221 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 15227 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 14888 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 15237 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 14898 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 14904 "parsing/parser.ml"
-         in
+# 15243 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -14936,57 +15276,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 14947 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 15288 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 14952 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3786 "parsing/parser.mly"
+# 15293 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3838 "parsing/parser.mly"
                   ("||")
-# 14959 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 15300 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 14967 "parsing/parser.ml"
+# 15308 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 15314 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 14973 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 15324 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 14983 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 14989 "parsing/parser.ml"
-         in
+# 15330 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -15042,52 +15384,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 15056 "parsing/parser.ml"
-                     in
+# 15399 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 15404 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 15061 "parsing/parser.ml"
+# 15410 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 15067 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 15078 "parsing/parser.ml"
+# 15421 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 15084 "parsing/parser.ml"
+# 15427 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -15100,51 +15443,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 15104 "parsing/parser.ml"
+# 15447 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 15110 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3786 "parsing/parser.mly"
+# 15453 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3838 "parsing/parser.mly"
                   ("||")
-# 15117 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 15460 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 15125 "parsing/parser.ml"
+# 15468 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 15474 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 15131 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 15484 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 15141 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 15147 "parsing/parser.ml"
-         in
+# 15490 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -15179,57 +15523,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 15190 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 15535 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 15195 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3787 "parsing/parser.mly"
+# 15540 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3839 "parsing/parser.mly"
                    ("&")
-# 15202 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 15547 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 15210 "parsing/parser.ml"
+# 15555 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 15561 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 15216 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 15571 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 15226 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 15232 "parsing/parser.ml"
-         in
+# 15577 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -15285,52 +15631,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 15299 "parsing/parser.ml"
-                     in
+# 15646 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 15651 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 15304 "parsing/parser.ml"
+# 15657 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 15310 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 15321 "parsing/parser.ml"
+# 15668 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 15327 "parsing/parser.ml"
+# 15674 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -15343,51 +15690,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 15347 "parsing/parser.ml"
+# 15694 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 15353 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3787 "parsing/parser.mly"
+# 15700 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3839 "parsing/parser.mly"
                    ("&")
-# 15360 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 15707 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 15368 "parsing/parser.ml"
+# 15715 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 15721 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 15374 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 15731 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 15384 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 15390 "parsing/parser.ml"
-         in
+# 15737 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -15422,57 +15770,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 15433 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 15782 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 15438 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3788 "parsing/parser.mly"
+# 15787 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3840 "parsing/parser.mly"
                   ("&&")
-# 15445 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 15794 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 15453 "parsing/parser.ml"
+# 15802 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 15808 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 15459 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 15818 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 15469 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 15475 "parsing/parser.ml"
-         in
+# 15824 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -15528,52 +15878,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 15542 "parsing/parser.ml"
-                     in
+# 15893 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 15898 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 15547 "parsing/parser.ml"
+# 15904 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 15553 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 15564 "parsing/parser.ml"
+# 15915 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 15570 "parsing/parser.ml"
+# 15921 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -15586,51 +15937,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 15590 "parsing/parser.ml"
+# 15941 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 15596 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3788 "parsing/parser.mly"
+# 15947 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3840 "parsing/parser.mly"
                   ("&&")
-# 15603 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 15954 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 15611 "parsing/parser.ml"
+# 15962 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 15968 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 15617 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 15978 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 15627 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 15633 "parsing/parser.ml"
-         in
+# 15984 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -15665,57 +16017,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let e2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 15676 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 16029 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 15681 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3789 "parsing/parser.mly"
+# 16034 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3841 "parsing/parser.mly"
                   (":=")
-# 15688 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 16041 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 15696 "parsing/parser.ml"
+# 16049 "parsing/parser.ml"
+                
+              in
+              
+# 2506 "parsing/parser.mly"
+      ( mkinfix e1 op e2 )
+# 16055 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2484 "parsing/parser.mly"
-      ( mkinfix e1 op e2 )
-# 15702 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 16065 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 15712 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 15718 "parsing/parser.ml"
-         in
+# 16071 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -15771,52 +16125,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let e2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let e2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 15785 "parsing/parser.ml"
-                     in
+# 16140 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 16145 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 15790 "parsing/parser.ml"
+# 16151 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 15796 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 15807 "parsing/parser.ml"
+# 16162 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 15813 "parsing/parser.ml"
+# 16168 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -15829,51 +16184,52 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 15833 "parsing/parser.ml"
+# 16188 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 15839 "parsing/parser.ml"
-              
-            in
-            let op =
-              let _1 = 
-# 3789 "parsing/parser.mly"
+# 16194 "parsing/parser.ml"
+                
+              in
+              let op =
+                let _1 = 
+# 3841 "parsing/parser.mly"
                   (":=")
-# 15846 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 16201 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 15854 "parsing/parser.ml"
+# 16209 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2484 "parsing/parser.mly"
+# 2506 "parsing/parser.mly"
       ( mkinfix e1 op e2 )
-# 15860 "parsing/parser.ml"
+# 16215 "parsing/parser.ml"
+              
+            in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_e1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 15870 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+# 16225 "parsing/parser.ml"
+            
+          in
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 15876 "parsing/parser.ml"
-         in
+# 16231 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -15901,43 +16257,49 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let _2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 15912 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 16269 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 15917 "parsing/parser.ml"
+# 16274 "parsing/parser.ml"
+                
+              in
+              let _endpos__2_ = _endpos__1_inlined1_ in
+              let _endpos = _endpos__2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 2508 "parsing/parser.mly"
+      ( mkuminus ~sloc:_sloc ~oploc:_loc__1_ _1 _2 )
+# 16285 "parsing/parser.ml"
               
             in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            let _endpos__1_ = _endpos__1_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2486 "parsing/parser.mly"
-      ( mkuminus ~oploc:_loc__1_ _1 _2 )
-# 15924 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 16295 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 15934 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 15940 "parsing/parser.ml"
-         in
+# 16301 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -15986,52 +16348,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let _2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 16000 "parsing/parser.ml"
-                     in
+# 16363 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 16368 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 16005 "parsing/parser.ml"
+# 16374 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 16011 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 16022 "parsing/parser.ml"
+# 16385 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 16028 "parsing/parser.ml"
+# 16391 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -16044,37 +16407,42 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 16048 "parsing/parser.ml"
+# 16411 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 16417 "parsing/parser.ml"
                 
               in
+              let _endpos__2_ = _endpos_xs_ in
+              let _endpos = _endpos__2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 16054 "parsing/parser.ml"
+# 2508 "parsing/parser.mly"
+      ( mkuminus ~sloc:_sloc ~oploc:_loc__1_ _1 _2 )
+# 16428 "parsing/parser.ml"
               
             in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            let _endpos__1_ = _endpos_xs_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2486 "parsing/parser.mly"
-      ( mkuminus ~oploc:_loc__1_ _1 _2 )
-# 16061 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 16438 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_xs_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 16071 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 16077 "parsing/parser.ml"
-         in
+# 16444 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -16102,43 +16470,49 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 =
+              let _2 =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 16113 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 16482 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 16118 "parsing/parser.ml"
+# 16487 "parsing/parser.ml"
+                
+              in
+              let _endpos__2_ = _endpos__1_inlined1_ in
+              let _endpos = _endpos__2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 2510 "parsing/parser.mly"
+      ( mkuplus ~sloc:_sloc ~oploc:_loc__1_ _1 _2 )
+# 16498 "parsing/parser.ml"
               
             in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            let _endpos__1_ = _endpos__1_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2488 "parsing/parser.mly"
-      ( mkuplus ~oploc:_loc__1_ _1 _2 )
-# 16125 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 16508 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 16135 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 16141 "parsing/parser.ml"
-         in
+# 16514 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -16187,52 +16561,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let _2 =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 16201 "parsing/parser.ml"
-                     in
+# 16576 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 16581 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 16206 "parsing/parser.ml"
+# 16587 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 16212 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 16223 "parsing/parser.ml"
+# 16598 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 16229 "parsing/parser.ml"
+# 16604 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -16245,37 +16620,42 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 16249 "parsing/parser.ml"
+# 16624 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 16630 "parsing/parser.ml"
                 
               in
+              let _endpos__2_ = _endpos_xs_ in
+              let _endpos = _endpos__2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 16255 "parsing/parser.ml"
+# 2510 "parsing/parser.mly"
+      ( mkuplus ~sloc:_sloc ~oploc:_loc__1_ _1 _2 )
+# 16641 "parsing/parser.ml"
               
             in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            let _endpos__1_ = _endpos_xs_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2488 "parsing/parser.mly"
-      ( mkuplus ~oploc:_loc__1_ _1 _2 )
-# 16262 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 16651 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_xs_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 16272 "parsing/parser.ml"
-          
-        in
-        
-# 2404 "parsing/parser.mly"
+          (
+# 2426 "parsing/parser.mly"
       ( _1 )
-# 16278 "parsing/parser.ml"
-         in
+# 16657 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -16310,14 +16690,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2406 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2428 "parsing/parser.mly"
       ( expr_of_let_bindings ~loc:_sloc _1 _3 )
-# 16320 "parsing/parser.ml"
-         in
+# 16701 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -16356,36 +16738,38 @@ module Tables = struct
         let _3 : unit = Obj.magic _3 in
         let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in
         let _1 : (
-# 760 "parsing/parser.mly"
+# 779 "parsing/parser.mly"
        (string)
-# 16362 "parsing/parser.ml"
+# 16744 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_body_ in
-        let _v : (Parsetree.expression) = let pbop_op =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let pbop_op =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 16374 "parsing/parser.ml"
-          
-        in
-        let _startpos_pbop_op_ = _startpos__1_ in
-        let _endpos = _endpos_body_ in
-        let _symbolstartpos = _startpos_pbop_op_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2408 "parsing/parser.mly"
+# 16757 "parsing/parser.ml"
+            
+          in
+          let _startpos_pbop_op_ = _startpos__1_ in
+          let _endpos = _endpos_body_ in
+          let _symbolstartpos = _startpos_pbop_op_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2430 "parsing/parser.mly"
       ( let (pbop_pat, pbop_exp, rev_ands) = bindings in
         let ands = List.rev rev_ands in
         let pbop_loc = make_loc _sloc in
         let let_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
         mkexp ~loc:_sloc (Pexp_letop{ let_; ands; body}) )
-# 16388 "parsing/parser.ml"
-         in
+# 16771 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -16420,29 +16804,31 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _3 =
-          let _1 = _1_inlined1 in
-          let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _3 =
+            let _1 = _1_inlined1 in
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 16429 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 16814 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 16434 "parsing/parser.ml"
-          
-        in
-        let _endpos__3_ = _endpos__1_inlined1_ in
-        let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _loc__2_ = (_startpos__2_, _endpos__2_) in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2414 "parsing/parser.mly"
+# 16819 "parsing/parser.ml"
+            
+          in
+          let _endpos__3_ = _endpos__1_inlined1_ in
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _loc__2_ = (_startpos__2_, _endpos__2_) in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2436 "parsing/parser.mly"
       ( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) )
-# 16445 "parsing/parser.ml"
-         in
+# 16830 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -16498,50 +16884,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _3 =
-          let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _3 =
+            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 16510 "parsing/parser.ml"
-                 in
+# 16897 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 16902 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 16515 "parsing/parser.ml"
+# 16908 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 16521 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 16532 "parsing/parser.ml"
+# 16919 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 16538 "parsing/parser.ml"
+# 16925 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -16554,25 +16941,26 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 16558 "parsing/parser.ml"
+# 16945 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 16564 "parsing/parser.ml"
-          
-        in
-        let _endpos__3_ = _endpos_xs_ in
-        let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _loc__2_ = (_startpos__2_, _endpos__2_) in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2414 "parsing/parser.mly"
+# 16951 "parsing/parser.ml"
+            
+          in
+          let _endpos__3_ = _endpos_xs_ in
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _loc__2_ = (_startpos__2_, _endpos__2_) in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2436 "parsing/parser.mly"
       ( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) )
-# 16575 "parsing/parser.ml"
-         in
+# 16962 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -16604,50 +16992,52 @@ module Tables = struct
         let _1_inlined1 : (Parsetree.expression) = Obj.magic _1_inlined1 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 16610 "parsing/parser.ml"
+# 16998 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _3 =
-          let _1 = _1_inlined1 in
-          let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _3 =
+            let _1 = _1_inlined1 in
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 16620 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 17009 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 16625 "parsing/parser.ml"
-          
-        in
-        let _endpos__3_ = _endpos__1_inlined1_ in
-        let _1 =
-          let _1 = 
-# 3720 "parsing/parser.mly"
+# 17014 "parsing/parser.ml"
+            
+          in
+          let _endpos__3_ = _endpos__1_inlined1_ in
+          let _1 =
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 16633 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
+# 17022 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 17030 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__3_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 16641 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2416 "parsing/parser.mly"
+          (
+# 2438 "parsing/parser.mly"
       ( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) )
-# 16650 "parsing/parser.ml"
-         in
+# 17039 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -16700,57 +17090,58 @@ module Tables = struct
         let _1_inlined1 : unit = Obj.magic _1_inlined1 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 16706 "parsing/parser.ml"
+# 17096 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _3 =
-          let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _3 =
+            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 16719 "parsing/parser.ml"
-                 in
+# 17110 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 17115 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 16724 "parsing/parser.ml"
+# 17121 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 16730 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 16741 "parsing/parser.ml"
+# 17132 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 16747 "parsing/parser.ml"
+# 17138 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -16763,39 +17154,40 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 16767 "parsing/parser.ml"
+# 17158 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 16773 "parsing/parser.ml"
-          
-        in
-        let _endpos__3_ = _endpos_xs_ in
-        let _1 =
-          let _1 = 
-# 3720 "parsing/parser.mly"
+# 17164 "parsing/parser.ml"
+            
+          in
+          let _endpos__3_ = _endpos_xs_ in
+          let _1 =
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 16781 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
+# 17172 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 17180 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__3_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 16789 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2416 "parsing/parser.mly"
+          (
+# 2438 "parsing/parser.mly"
       ( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) )
-# 16798 "parsing/parser.ml"
-         in
+# 17189 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -16844,39 +17236,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.expression) = let _5 =
-          let _1 = _1_inlined2 in
-          let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _5 =
+            let _1 = _1_inlined2 in
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 16853 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 17246 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 16858 "parsing/parser.ml"
-          
-        in
-        let _endpos__5_ = _endpos__1_inlined2_ in
-        let _3 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+# 17251 "parsing/parser.ml"
+            
+          in
+          let _endpos__5_ = _endpos__1_inlined2_ in
+          let _3 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 17263 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 16870 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2418 "parsing/parser.mly"
+          (
+# 2440 "parsing/parser.mly"
       ( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) )
-# 16879 "parsing/parser.ml"
-         in
+# 17272 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -16946,50 +17340,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _5 =
-          let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _5 =
+            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 16958 "parsing/parser.ml"
-                 in
+# 17353 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 17358 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 16963 "parsing/parser.ml"
+# 17364 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 16969 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 16980 "parsing/parser.ml"
+# 17375 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 16986 "parsing/parser.ml"
+# 17381 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -17002,35 +17397,36 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 17006 "parsing/parser.ml"
+# 17401 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 17012 "parsing/parser.ml"
-          
-        in
-        let _endpos__5_ = _endpos_xs_ in
-        let _3 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+# 17407 "parsing/parser.ml"
+            
+          in
+          let _endpos__5_ = _endpos_xs_ in
+          let _3 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 17419 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 17024 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2418 "parsing/parser.mly"
+          (
+# 2440 "parsing/parser.mly"
       ( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) )
-# 17033 "parsing/parser.ml"
-         in
+# 17428 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -17093,42 +17489,44 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 17104 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 17501 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 17109 "parsing/parser.ml"
+# 17506 "parsing/parser.ml"
+                
+              in
+              
+# 2441 "parsing/parser.mly"
+                                                 (Some v)
+# 17512 "parsing/parser.ml"
               
             in
             
-# 2419 "parsing/parser.mly"
-                                                 (Some v)
-# 17115 "parsing/parser.ml"
+# 2401 "parsing/parser.mly"
+    ( array, d, Paren,   i, r )
+# 17518 "parsing/parser.ml"
             
           in
-          
-# 2379 "parsing/parser.mly"
-    ( array, d, Paren,   i, r )
-# 17121 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2420 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2442 "parsing/parser.mly"
     ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 17131 "parsing/parser.ml"
-         in
+# 17528 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -17212,52 +17610,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 17226 "parsing/parser.ml"
-                     in
+# 17625 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 17630 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 17231 "parsing/parser.ml"
+# 17636 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 17237 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 17248 "parsing/parser.ml"
+# 17647 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 17254 "parsing/parser.ml"
+# 17653 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -17270,36 +17669,37 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 17274 "parsing/parser.ml"
+# 17673 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 17679 "parsing/parser.ml"
                 
               in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 17280 "parsing/parser.ml"
+# 2441 "parsing/parser.mly"
+                                                 (Some v)
+# 17685 "parsing/parser.ml"
               
             in
             
-# 2419 "parsing/parser.mly"
-                                                 (Some v)
-# 17286 "parsing/parser.ml"
+# 2401 "parsing/parser.mly"
+    ( array, d, Paren,   i, r )
+# 17691 "parsing/parser.ml"
             
           in
-          
-# 2379 "parsing/parser.mly"
-    ( array, d, Paren,   i, r )
-# 17292 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2420 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2442 "parsing/parser.mly"
     ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 17302 "parsing/parser.ml"
-         in
+# 17701 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -17362,42 +17762,44 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 17373 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 17774 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 17378 "parsing/parser.ml"
+# 17779 "parsing/parser.ml"
+                
+              in
+              
+# 2441 "parsing/parser.mly"
+                                                 (Some v)
+# 17785 "parsing/parser.ml"
               
             in
             
-# 2419 "parsing/parser.mly"
-                                                 (Some v)
-# 17384 "parsing/parser.ml"
+# 2403 "parsing/parser.mly"
+    ( array, d, Brace,   i, r )
+# 17791 "parsing/parser.ml"
             
           in
-          
-# 2381 "parsing/parser.mly"
-    ( array, d, Brace,   i, r )
-# 17390 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2420 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2442 "parsing/parser.mly"
     ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 17400 "parsing/parser.ml"
-         in
+# 17801 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -17481,52 +17883,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 17495 "parsing/parser.ml"
-                     in
+# 17898 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 17903 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 17500 "parsing/parser.ml"
+# 17909 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 17506 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 17517 "parsing/parser.ml"
+# 17920 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 17523 "parsing/parser.ml"
+# 17926 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -17539,36 +17942,37 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 17543 "parsing/parser.ml"
+# 17946 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 17952 "parsing/parser.ml"
                 
               in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 17549 "parsing/parser.ml"
+# 2441 "parsing/parser.mly"
+                                                 (Some v)
+# 17958 "parsing/parser.ml"
               
             in
             
-# 2419 "parsing/parser.mly"
-                                                 (Some v)
-# 17555 "parsing/parser.ml"
+# 2403 "parsing/parser.mly"
+    ( array, d, Brace,   i, r )
+# 17964 "parsing/parser.ml"
             
           in
-          
-# 2381 "parsing/parser.mly"
-    ( array, d, Brace,   i, r )
-# 17561 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2420 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2442 "parsing/parser.mly"
     ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 17571 "parsing/parser.ml"
-         in
+# 17974 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -17631,42 +18035,44 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 17642 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 18047 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 17647 "parsing/parser.ml"
+# 18052 "parsing/parser.ml"
+                
+              in
+              
+# 2441 "parsing/parser.mly"
+                                                 (Some v)
+# 18058 "parsing/parser.ml"
               
             in
             
-# 2419 "parsing/parser.mly"
-                                                 (Some v)
-# 17653 "parsing/parser.ml"
+# 2405 "parsing/parser.mly"
+    ( array, d, Bracket, i, r )
+# 18064 "parsing/parser.ml"
             
           in
-          
-# 2383 "parsing/parser.mly"
-    ( array, d, Bracket, i, r )
-# 17659 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2420 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2442 "parsing/parser.mly"
     ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 17669 "parsing/parser.ml"
-         in
+# 18074 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -17750,52 +18156,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 17764 "parsing/parser.ml"
-                     in
+# 18171 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 18176 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 17769 "parsing/parser.ml"
+# 18182 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 17775 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 17786 "parsing/parser.ml"
+# 18193 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 17792 "parsing/parser.ml"
+# 18199 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -17808,36 +18215,37 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 17812 "parsing/parser.ml"
+# 18219 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 18225 "parsing/parser.ml"
                 
               in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 17818 "parsing/parser.ml"
+# 2441 "parsing/parser.mly"
+                                                 (Some v)
+# 18231 "parsing/parser.ml"
               
             in
             
-# 2419 "parsing/parser.mly"
-                                                 (Some v)
-# 17824 "parsing/parser.ml"
+# 2405 "parsing/parser.mly"
+    ( array, d, Bracket, i, r )
+# 18237 "parsing/parser.ml"
             
           in
-          
-# 2383 "parsing/parser.mly"
-    ( array, d, Bracket, i, r )
-# 17830 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2420 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2442 "parsing/parser.mly"
     ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 17840 "parsing/parser.ml"
-         in
+# 18247 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -17896,67 +18304,69 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 17902 "parsing/parser.ml"
+# 18310 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let array : (Parsetree.expression) = Obj.magic array in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 17915 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 18324 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 17920 "parsing/parser.ml"
+# 18329 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2421 "parsing/parser.mly"
+# 2443 "parsing/parser.mly"
                                                                    (Some v)
-# 17926 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 18335 "parsing/parser.ml"
+              
+            in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 17932 "parsing/parser.ml"
-           in
-          let d =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 17938 "parsing/parser.ml"
+# 18341 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let d =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 18347 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 17943 "parsing/parser.ml"
+# 18352 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2379 "parsing/parser.mly"
+# 2401 "parsing/parser.mly"
     ( array, d, Paren,   i, r )
-# 17949 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+# 18358 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 17959 "parsing/parser.ml"
-         in
+# 18368 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -18036,60 +18446,61 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 18042 "parsing/parser.ml"
+# 18452 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let array : (Parsetree.expression) = Obj.magic array in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 18058 "parsing/parser.ml"
-                     in
+# 18469 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 18474 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 18063 "parsing/parser.ml"
+# 18480 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 18069 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 18080 "parsing/parser.ml"
+# 18491 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 18086 "parsing/parser.ml"
+# 18497 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -18102,53 +18513,54 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 18106 "parsing/parser.ml"
+# 18517 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 18523 "parsing/parser.ml"
                 
               in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 18112 "parsing/parser.ml"
+# 2443 "parsing/parser.mly"
+                                                                   (Some v)
+# 18529 "parsing/parser.ml"
               
             in
-            
-# 2421 "parsing/parser.mly"
-                                                                   (Some v)
-# 18118 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 18124 "parsing/parser.ml"
-           in
-          let d =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 18130 "parsing/parser.ml"
+# 18535 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let d =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 18541 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 18135 "parsing/parser.ml"
+# 18546 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2379 "parsing/parser.mly"
+# 2401 "parsing/parser.mly"
     ( array, d, Paren,   i, r )
-# 18141 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+# 18552 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18151 "parsing/parser.ml"
-         in
+# 18562 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -18219,9 +18631,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 18225 "parsing/parser.ml"
+# 18637 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1 : unit = Obj.magic _1 in
@@ -18229,68 +18641,70 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let _1_inlined1 = _1_inlined2 in
-            let v =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r =
+              let _1_inlined1 = _1_inlined2 in
+              let v =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 18241 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 18654 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 18246 "parsing/parser.ml"
+# 18659 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2421 "parsing/parser.mly"
+# 2443 "parsing/parser.mly"
                                                                    (Some v)
-# 18252 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 18665 "parsing/parser.ml"
+              
+            in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 18258 "parsing/parser.ml"
-           in
-          let d =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 18671 "parsing/parser.ml"
+             in
+            let d =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 18266 "parsing/parser.ml"
-               in
-              
+# 18679 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 18271 "parsing/parser.ml"
+# 18684 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 18690 "parsing/parser.ml"
               
             in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 18277 "parsing/parser.ml"
+# 2401 "parsing/parser.mly"
+    ( array, d, Paren,   i, r )
+# 18696 "parsing/parser.ml"
             
           in
-          
-# 2379 "parsing/parser.mly"
-    ( array, d, Paren,   i, r )
-# 18283 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18293 "parsing/parser.ml"
-         in
+# 18706 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -18382,9 +18796,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 18388 "parsing/parser.ml"
+# 18802 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1 : unit = Obj.magic _1 in
@@ -18392,53 +18806,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
-            let v =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let r =
+              let (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
+              let v =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 18407 "parsing/parser.ml"
-                     in
+# 18822 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 18827 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 18412 "parsing/parser.ml"
+# 18833 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 18418 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 18429 "parsing/parser.ml"
+# 18844 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 18435 "parsing/parser.ml"
+# 18850 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -18451,61 +18866,62 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 18455 "parsing/parser.ml"
+# 18870 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 18876 "parsing/parser.ml"
                 
               in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 18461 "parsing/parser.ml"
+# 2443 "parsing/parser.mly"
+                                                                   (Some v)
+# 18882 "parsing/parser.ml"
               
             in
-            
-# 2421 "parsing/parser.mly"
-                                                                   (Some v)
-# 18467 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 18473 "parsing/parser.ml"
-           in
-          let d =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 18888 "parsing/parser.ml"
+             in
+            let d =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 18481 "parsing/parser.ml"
-               in
-              
+# 18896 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 18486 "parsing/parser.ml"
+# 18901 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 18907 "parsing/parser.ml"
               
             in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 18492 "parsing/parser.ml"
+# 2401 "parsing/parser.mly"
+    ( array, d, Paren,   i, r )
+# 18913 "parsing/parser.ml"
             
           in
-          
-# 2379 "parsing/parser.mly"
-    ( array, d, Paren,   i, r )
-# 18498 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18508 "parsing/parser.ml"
-         in
+# 18923 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -18564,67 +18980,69 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 18570 "parsing/parser.ml"
+# 18986 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let array : (Parsetree.expression) = Obj.magic array in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 18583 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 19000 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 18588 "parsing/parser.ml"
+# 19005 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2421 "parsing/parser.mly"
+# 2443 "parsing/parser.mly"
                                                                    (Some v)
-# 18594 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 19011 "parsing/parser.ml"
+              
+            in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 18600 "parsing/parser.ml"
-           in
-          let d =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 18606 "parsing/parser.ml"
+# 19017 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let d =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 19023 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 18611 "parsing/parser.ml"
+# 19028 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2381 "parsing/parser.mly"
+# 2403 "parsing/parser.mly"
     ( array, d, Brace,   i, r )
-# 18617 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+# 19034 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18627 "parsing/parser.ml"
-         in
+# 19044 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -18704,60 +19122,61 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 18710 "parsing/parser.ml"
+# 19128 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let array : (Parsetree.expression) = Obj.magic array in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 18726 "parsing/parser.ml"
-                     in
+# 19145 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 19150 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 18731 "parsing/parser.ml"
+# 19156 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 18737 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 18748 "parsing/parser.ml"
+# 19167 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 18754 "parsing/parser.ml"
+# 19173 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -18770,53 +19189,54 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 18774 "parsing/parser.ml"
+# 19193 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 19199 "parsing/parser.ml"
                 
               in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 18780 "parsing/parser.ml"
+# 2443 "parsing/parser.mly"
+                                                                   (Some v)
+# 19205 "parsing/parser.ml"
               
             in
-            
-# 2421 "parsing/parser.mly"
-                                                                   (Some v)
-# 18786 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 18792 "parsing/parser.ml"
-           in
-          let d =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 18798 "parsing/parser.ml"
+# 19211 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let d =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 19217 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 18803 "parsing/parser.ml"
+# 19222 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2381 "parsing/parser.mly"
+# 2403 "parsing/parser.mly"
     ( array, d, Brace,   i, r )
-# 18809 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+# 19228 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18819 "parsing/parser.ml"
-         in
+# 19238 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -18887,9 +19307,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 18893 "parsing/parser.ml"
+# 19313 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1 : unit = Obj.magic _1 in
@@ -18897,68 +19317,70 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let _1_inlined1 = _1_inlined2 in
-            let v =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r =
+              let _1_inlined1 = _1_inlined2 in
+              let v =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 18909 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 19330 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 18914 "parsing/parser.ml"
+# 19335 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2421 "parsing/parser.mly"
+# 2443 "parsing/parser.mly"
                                                                    (Some v)
-# 18920 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 19341 "parsing/parser.ml"
+              
+            in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 18926 "parsing/parser.ml"
-           in
-          let d =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 19347 "parsing/parser.ml"
+             in
+            let d =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 18934 "parsing/parser.ml"
-               in
-              
+# 19355 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 18939 "parsing/parser.ml"
+# 19360 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 19366 "parsing/parser.ml"
               
             in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 18945 "parsing/parser.ml"
+# 2403 "parsing/parser.mly"
+    ( array, d, Brace,   i, r )
+# 19372 "parsing/parser.ml"
             
           in
-          
-# 2381 "parsing/parser.mly"
-    ( array, d, Brace,   i, r )
-# 18951 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 18961 "parsing/parser.ml"
-         in
+# 19382 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -19050,9 +19472,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 19056 "parsing/parser.ml"
+# 19478 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1 : unit = Obj.magic _1 in
@@ -19060,53 +19482,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
-            let v =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let r =
+              let (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
+              let v =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 19075 "parsing/parser.ml"
-                     in
+# 19498 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 19503 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 19080 "parsing/parser.ml"
+# 19509 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 19086 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 19097 "parsing/parser.ml"
+# 19520 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 19103 "parsing/parser.ml"
+# 19526 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -19119,61 +19542,62 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 19123 "parsing/parser.ml"
+# 19546 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 19552 "parsing/parser.ml"
                 
               in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 19129 "parsing/parser.ml"
+# 2443 "parsing/parser.mly"
+                                                                   (Some v)
+# 19558 "parsing/parser.ml"
               
             in
-            
-# 2421 "parsing/parser.mly"
-                                                                   (Some v)
-# 19135 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 19141 "parsing/parser.ml"
-           in
-          let d =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 19564 "parsing/parser.ml"
+             in
+            let d =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 19149 "parsing/parser.ml"
-               in
-              
+# 19572 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 19154 "parsing/parser.ml"
+# 19577 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 19583 "parsing/parser.ml"
               
             in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 19160 "parsing/parser.ml"
+# 2403 "parsing/parser.mly"
+    ( array, d, Brace,   i, r )
+# 19589 "parsing/parser.ml"
             
           in
-          
-# 2381 "parsing/parser.mly"
-    ( array, d, Brace,   i, r )
-# 19166 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 19176 "parsing/parser.ml"
-         in
+# 19599 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -19232,67 +19656,69 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 19238 "parsing/parser.ml"
+# 19662 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let array : (Parsetree.expression) = Obj.magic array in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 19251 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 19676 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 19256 "parsing/parser.ml"
+# 19681 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2421 "parsing/parser.mly"
+# 2443 "parsing/parser.mly"
                                                                    (Some v)
-# 19262 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 19687 "parsing/parser.ml"
+              
+            in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 19268 "parsing/parser.ml"
-           in
-          let d =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 19274 "parsing/parser.ml"
+# 19693 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let d =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 19699 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 19279 "parsing/parser.ml"
+# 19704 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2383 "parsing/parser.mly"
+# 2405 "parsing/parser.mly"
     ( array, d, Bracket, i, r )
-# 19285 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+# 19710 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined1_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 19295 "parsing/parser.ml"
-         in
+# 19720 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -19372,60 +19798,61 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 19378 "parsing/parser.ml"
+# 19804 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let array : (Parsetree.expression) = Obj.magic array in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let v =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let r =
+              let v =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 19394 "parsing/parser.ml"
-                     in
+# 19821 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 19826 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 19399 "parsing/parser.ml"
+# 19832 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 19405 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 19416 "parsing/parser.ml"
+# 19843 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 19422 "parsing/parser.ml"
+# 19849 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -19438,53 +19865,54 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 19442 "parsing/parser.ml"
+# 19869 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 19875 "parsing/parser.ml"
                 
               in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 19448 "parsing/parser.ml"
+# 2443 "parsing/parser.mly"
+                                                                   (Some v)
+# 19881 "parsing/parser.ml"
               
             in
-            
-# 2421 "parsing/parser.mly"
-                                                                   (Some v)
-# 19454 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 19460 "parsing/parser.ml"
-           in
-          let d =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 19466 "parsing/parser.ml"
+# 19887 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let d =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 19893 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 19471 "parsing/parser.ml"
+# 19898 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2383 "parsing/parser.mly"
+# 2405 "parsing/parser.mly"
     ( array, d, Bracket, i, r )
-# 19477 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+# 19904 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 19487 "parsing/parser.ml"
-         in
+# 19914 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -19555,9 +19983,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 19561 "parsing/parser.ml"
+# 19989 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1 : unit = Obj.magic _1 in
@@ -19565,68 +19993,70 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let _1_inlined1 = _1_inlined2 in
-            let v =
-              let _1 = _1_inlined1 in
-              let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r =
+              let _1_inlined1 = _1_inlined2 in
+              let v =
+                let _1 = _1_inlined1 in
+                let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 19577 "parsing/parser.ml"
-               in
-              
-# 2431 "parsing/parser.mly"
+# 20006 "parsing/parser.ml"
+                 in
+                
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 19582 "parsing/parser.ml"
+# 20011 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2421 "parsing/parser.mly"
+# 2443 "parsing/parser.mly"
                                                                    (Some v)
-# 19588 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 20017 "parsing/parser.ml"
+              
+            in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 19594 "parsing/parser.ml"
-           in
-          let d =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 20023 "parsing/parser.ml"
+             in
+            let d =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 19602 "parsing/parser.ml"
-               in
-              
+# 20031 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 19607 "parsing/parser.ml"
+# 20036 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 20042 "parsing/parser.ml"
               
             in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 19613 "parsing/parser.ml"
+# 2405 "parsing/parser.mly"
+    ( array, d, Bracket, i, r )
+# 20048 "parsing/parser.ml"
             
           in
-          
-# 2383 "parsing/parser.mly"
-    ( array, d, Bracket, i, r )
-# 19619 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 19629 "parsing/parser.ml"
-         in
+# 20058 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -19718,9 +20148,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 19724 "parsing/parser.ml"
+# 20154 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1 : unit = Obj.magic _1 in
@@ -19728,53 +20158,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r =
-            let (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
-            let v =
-              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-              let _1 =
-                let _3 =
-                  let xs =
-                    let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let r =
+              let (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
+              let v =
+                let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+                let _1 =
+                  let _3 =
+                    let xs =
+                      let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 19743 "parsing/parser.ml"
-                     in
+# 20174 "parsing/parser.ml"
+                       in
+                      
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 20179 "parsing/parser.ml"
+                      
+                    in
                     
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 19748 "parsing/parser.ml"
+# 20185 "parsing/parser.ml"
                     
                   in
-                  
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 19754 "parsing/parser.ml"
-                  
-                in
-                let _endpos__3_ = _endpos_xs_ in
-                let _2 =
-                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _endpos__3_ = _endpos_xs_ in
                   let _2 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+                    let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                    let _2 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 19765 "parsing/parser.ml"
+# 20196 "parsing/parser.ml"
+                      
+                    in
                     
-                  in
-                  
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 19771 "parsing/parser.ml"
+# 20202 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos__3_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos__3_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -19787,61 +20218,62 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 19791 "parsing/parser.ml"
+# 20222 "parsing/parser.ml"
+                  
+                in
+                
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 20228 "parsing/parser.ml"
                 
               in
               
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 19797 "parsing/parser.ml"
+# 2443 "parsing/parser.mly"
+                                                                   (Some v)
+# 20234 "parsing/parser.ml"
               
             in
-            
-# 2421 "parsing/parser.mly"
-                                                                   (Some v)
-# 19803 "parsing/parser.ml"
-            
-          in
-          let i = 
-# 2831 "parsing/parser.mly"
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 19809 "parsing/parser.ml"
-           in
-          let d =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 20240 "parsing/parser.ml"
+             in
+            let d =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 19817 "parsing/parser.ml"
-               in
-              
+# 20248 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 19822 "parsing/parser.ml"
+# 20253 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 20259 "parsing/parser.ml"
               
             in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 19828 "parsing/parser.ml"
+# 2405 "parsing/parser.mly"
+    ( array, d, Bracket, i, r )
+# 20265 "parsing/parser.ml"
             
           in
-          
-# 2383 "parsing/parser.mly"
-    ( array, d, Bracket, i, r )
-# 19834 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2422 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2444 "parsing/parser.mly"
     ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 19844 "parsing/parser.ml"
-         in
+# 20275 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -19870,9 +20302,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.expression) = 
-# 2424 "parsing/parser.mly"
+# 2446 "parsing/parser.mly"
       ( Exp.attr _1 _2 )
-# 19876 "parsing/parser.ml"
+# 20308 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -19894,12 +20326,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 2427 "parsing/parser.mly"
+        let _v =
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 2449 "parsing/parser.mly"
      ( not_expecting _loc__1_ "wildcard \"_\"" )
-# 19902 "parsing/parser.ml"
-         in
+# 20335 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -19941,16 +20375,17 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.function_param list) = let ty_params = 
-# 2637 "parsing/parser.mly"
+        let _v =
+          let ty_params = 
+# 2679 "parsing/parser.mly"
     ( xs )
-# 19948 "parsing/parser.ml"
-         in
-        let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2768 "parsing/parser.mly"
+# 20383 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2810 "parsing/parser.mly"
       ( (* We desugar (type a b c) to (type a) (type b) (type c).
            If we do this desugaring, the loc for each parameter is a ghost.
         *)
@@ -19964,8 +20399,9 @@ module Tables = struct
           (fun x -> { pparam_loc = loc; pparam_desc = Pparam_newtype x })
           ty_params
       )
-# 19968 "parsing/parser.ml"
-         in
+# 20403 "parsing/parser.ml"
+           : (Parsetree.function_param list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -19986,16 +20422,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.function_param list) = let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2782 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2824 "parsing/parser.mly"
       ( let a, b, c = _1 in
         [ { pparam_loc = make_loc _sloc; pparam_desc = Pparam_val (a, b, c) } ]
       )
-# 19998 "parsing/parser.ml"
-         in
+# 20435 "parsing/parser.ml"
+           : (Parsetree.function_param list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20016,23 +20454,25 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.function_param list) = let _1 =
-          let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 20024 "parsing/parser.ml"
-           in
-          
-# 1083 "parsing/parser.mly"
+# 20463 "parsing/parser.ml"
+             in
+            
+# 1107 "parsing/parser.mly"
     ( xs )
-# 20029 "parsing/parser.ml"
-          
-        in
-        
-# 2787 "parsing/parser.mly"
+# 20468 "parsing/parser.ml"
+            
+          in
+          (
+# 2829 "parsing/parser.mly"
                                        ( _1 )
-# 20035 "parsing/parser.ml"
-         in
+# 20474 "parsing/parser.ml"
+           : (Parsetree.function_param list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20054,9 +20494,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.expression) = 
-# 2314 "parsing/parser.mly"
+# 2336 "parsing/parser.mly"
                                   ( _1 )
-# 20060 "parsing/parser.ml"
+# 20500 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -20086,9 +20526,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.expression) = 
-# 2315 "parsing/parser.mly"
+# 2337 "parsing/parser.mly"
                                   ( _1 )
-# 20092 "parsing/parser.ml"
+# 20532 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -20124,27 +20564,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _1 = 
-# 2317 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2339 "parsing/parser.mly"
     ( Pexp_sequence(_1, _3) )
-# 20132 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 20573 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 20141 "parsing/parser.ml"
-          
-        in
-        
-# 2318 "parsing/parser.mly"
+# 20582 "parsing/parser.ml"
+            
+          in
+          (
+# 2340 "parsing/parser.mly"
     ( _1 )
-# 20147 "parsing/parser.ml"
-         in
+# 20588 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20193,16 +20635,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2320 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2342 "parsing/parser.mly"
     ( let seq = mkexp ~loc:_sloc (Pexp_sequence (_1, _5)) in
       let payload = PStr [mkstrexp seq []] in
       mkexp ~loc:_sloc (Pexp_extension (_4, payload)) )
-# 20205 "parsing/parser.ml"
-         in
+# 20648 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20224,9 +20668,9 @@ module Tables = struct
         let _startpos = _startpos_ty_ in
         let _endpos = _endpos_ty_ in
         let _v : (Parsetree.core_type) = 
-# 3486 "parsing/parser.mly"
+# 3531 "parsing/parser.mly"
       ( ty )
-# 20230 "parsing/parser.ml"
+# 20674 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -20269,39 +20713,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_label_ in
         let _endpos = _endpos_codomain_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let domain = 
-# 958 "parsing/parser.mly"
+            let _1 =
+              let domain = 
+# 982 "parsing/parser.mly"
                               ( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 20278 "parsing/parser.ml"
-             in
-            let label = 
-# 3498 "parsing/parser.mly"
+# 20723 "parsing/parser.ml"
+               in
+              let label = 
+# 3543 "parsing/parser.mly"
       ( Optional label )
-# 20283 "parsing/parser.ml"
-             in
-            
-# 3492 "parsing/parser.mly"
+# 20728 "parsing/parser.ml"
+               in
+              
+# 3537 "parsing/parser.mly"
         ( Ptyp_arrow(label, domain, codomain) )
-# 20288 "parsing/parser.ml"
+# 20733 "parsing/parser.ml"
+              
+            in
+            let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 20298 "parsing/parser.ml"
-          
-        in
-        
-# 3494 "parsing/parser.mly"
+# 20743 "parsing/parser.ml"
+            
+          in
+          (
+# 3539 "parsing/parser.mly"
     ( _1 )
-# 20304 "parsing/parser.ml"
-         in
+# 20749 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20347,46 +20793,48 @@ module Tables = struct
         let _1 : (Parsetree.core_type) = Obj.magic _1 in
         let _2 : unit = Obj.magic _2 in
         let label : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 20353 "parsing/parser.ml"
+# 20799 "parsing/parser.ml"
         ) = Obj.magic label in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_label_ in
         let _endpos = _endpos_codomain_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let domain = 
-# 958 "parsing/parser.mly"
+            let _1 =
+              let domain = 
+# 982 "parsing/parser.mly"
                               ( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 20363 "parsing/parser.ml"
-             in
-            let label = 
-# 3500 "parsing/parser.mly"
+# 20810 "parsing/parser.ml"
+               in
+              let label = 
+# 3545 "parsing/parser.mly"
       ( Labelled label )
-# 20368 "parsing/parser.ml"
-             in
-            
-# 3492 "parsing/parser.mly"
+# 20815 "parsing/parser.ml"
+               in
+              
+# 3537 "parsing/parser.mly"
         ( Ptyp_arrow(label, domain, codomain) )
-# 20373 "parsing/parser.ml"
+# 20820 "parsing/parser.ml"
+              
+            in
+            let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 20383 "parsing/parser.ml"
-          
-        in
-        
-# 3494 "parsing/parser.mly"
+# 20830 "parsing/parser.ml"
+            
+          in
+          (
+# 3539 "parsing/parser.mly"
     ( _1 )
-# 20389 "parsing/parser.ml"
-         in
+# 20836 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20421,39 +20869,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_codomain_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let domain = 
-# 958 "parsing/parser.mly"
+            let _1 =
+              let domain = 
+# 982 "parsing/parser.mly"
                               ( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 20430 "parsing/parser.ml"
-             in
-            let label = 
-# 3502 "parsing/parser.mly"
+# 20879 "parsing/parser.ml"
+               in
+              let label = 
+# 3547 "parsing/parser.mly"
       ( Nolabel )
-# 20435 "parsing/parser.ml"
-             in
-            
-# 3492 "parsing/parser.mly"
+# 20884 "parsing/parser.ml"
+               in
+              
+# 3537 "parsing/parser.mly"
         ( Ptyp_arrow(label, domain, codomain) )
-# 20440 "parsing/parser.ml"
+# 20889 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos_codomain_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos_codomain_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 20450 "parsing/parser.ml"
-          
-        in
-        
-# 3494 "parsing/parser.mly"
+# 20899 "parsing/parser.ml"
+            
+          in
+          (
+# 3539 "parsing/parser.mly"
     ( _1 )
-# 20456 "parsing/parser.ml"
-         in
+# 20905 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20481,12 +20931,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Lexing.position * Parsetree.functor_parameter) = let _startpos = _startpos__1_ in
-        
-# 1369 "parsing/parser.mly"
+        let _v =
+          let _startpos = _startpos__1_ in
+          (
+# 1393 "parsing/parser.mly"
       ( _startpos, Unit )
-# 20489 "parsing/parser.ml"
-         in
+# 20940 "parsing/parser.ml"
+           : (Lexing.position * Parsetree.functor_parameter))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20535,23 +20987,25 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Lexing.position * Parsetree.functor_parameter) = let x =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let x =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 20547 "parsing/parser.ml"
-          
-        in
-        let _startpos = _startpos__1_ in
-        
-# 1372 "parsing/parser.mly"
+# 21000 "parsing/parser.ml"
+            
+          in
+          let _startpos = _startpos__1_ in
+          (
+# 1396 "parsing/parser.mly"
       ( _startpos, Named (x, mty) )
-# 20554 "parsing/parser.ml"
-         in
+# 21007 "parsing/parser.ml"
+           : (Lexing.position * Parsetree.functor_parameter))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20567,9 +21021,9 @@ module Tables = struct
         let _endpos = _startpos in
         let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
   Parsetree.core_type option) = 
-# 3285 "parsing/parser.mly"
+# 3330 "parsing/parser.mly"
                                   ( ([],Pcstr_tuple [],None) )
-# 20573 "parsing/parser.ml"
+# 21027 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -20600,9 +21054,9 @@ module Tables = struct
         let _endpos = _endpos__2_ in
         let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
   Parsetree.core_type option) = 
-# 3286 "parsing/parser.mly"
+# 3331 "parsing/parser.mly"
                                   ( ([],_2,None) )
-# 20606 "parsing/parser.ml"
+# 21060 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -20647,9 +21101,9 @@ module Tables = struct
         let _endpos = _endpos__4_ in
         let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
   Parsetree.core_type option) = 
-# 3288 "parsing/parser.mly"
+# 3333 "parsing/parser.mly"
                                   ( ([],_2,Some _4) )
-# 20653 "parsing/parser.ml"
+# 21107 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -20706,31 +21160,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
-  Parsetree.core_type option) = let _2 =
-          let _1 =
-            let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _2 =
+            let _1 =
+              let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 20716 "parsing/parser.ml"
-             in
-            
-# 1062 "parsing/parser.mly"
+# 21170 "parsing/parser.ml"
+               in
+              
+# 1086 "parsing/parser.mly"
     ( xs )
-# 20721 "parsing/parser.ml"
+# 21175 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3421 "parsing/parser.mly"
+# 3466 "parsing/parser.mly"
     ( _1 )
-# 20727 "parsing/parser.ml"
-          
-        in
-        
-# 3291 "parsing/parser.mly"
+# 21181 "parsing/parser.ml"
+            
+          in
+          (
+# 3336 "parsing/parser.mly"
                                   ( (_2,_4,Some _6) )
-# 20733 "parsing/parser.ml"
-         in
+# 21187 "parsing/parser.ml"
+           : (Ast_helper.str list * Parsetree.constructor_arguments *
+  Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20760,9 +21216,9 @@ module Tables = struct
         let _endpos = _endpos__2_ in
         let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
   Parsetree.core_type option) = 
-# 3293 "parsing/parser.mly"
+# 3338 "parsing/parser.mly"
                                   ( ([],Pcstr_tuple [],Some _2) )
-# 20766 "parsing/parser.ml"
+# 21222 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -20805,31 +21261,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Ast_helper.str list * Parsetree.constructor_arguments *
-  Parsetree.core_type option) = let _2 =
-          let _1 =
-            let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _2 =
+            let _1 =
+              let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 20815 "parsing/parser.ml"
-             in
-            
-# 1062 "parsing/parser.mly"
+# 21271 "parsing/parser.ml"
+               in
+              
+# 1086 "parsing/parser.mly"
     ( xs )
-# 20820 "parsing/parser.ml"
+# 21276 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3421 "parsing/parser.mly"
+# 3466 "parsing/parser.mly"
     ( _1 )
-# 20826 "parsing/parser.ml"
-          
-        in
-        
-# 3295 "parsing/parser.mly"
+# 21282 "parsing/parser.ml"
+            
+          in
+          (
+# 3340 "parsing/parser.mly"
                                   ( (_2,Pcstr_tuple [],Some _4) )
-# 20832 "parsing/parser.ml"
-         in
+# 21288 "parsing/parser.ml"
+           : (Ast_helper.str list * Parsetree.constructor_arguments *
+  Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20872,41 +21330,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
-  Parsetree.core_type option * Parsetree.attributes * Location.t *
-  Docstrings.info) = let attrs =
-          let _1 = _1_inlined2 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let attrs =
+            let _1 = _1_inlined2 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 20883 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs_ = _endpos__1_inlined2_ in
-        let cid =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+# 21340 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs_ = _endpos__1_inlined2_ in
+          let cid =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 21352 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 20895 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3233 "parsing/parser.mly"
+          (
+# 3278 "parsing/parser.mly"
     (
       let vars, args, res = vars_args_res in
       let info = symbol_info _endpos in
       let loc = make_loc _sloc in
       cid, vars, args, res, attrs, loc, info
     )
-# 20909 "parsing/parser.ml"
-         in
+# 21366 "parsing/parser.ml"
+           : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -20942,46 +21402,48 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
-  Parsetree.core_type option * Parsetree.attributes * Location.t *
-  Docstrings.info) = let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 20953 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs_ = _endpos__1_inlined1_ in
-        let cid =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 21412 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs_ = _endpos__1_inlined1_ in
+          let cid =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 20964 "parsing/parser.ml"
-          
-        in
-        let _startpos_cid_ = _startpos__1_ in
-        let _1 = 
-# 3883 "parsing/parser.mly"
+# 21423 "parsing/parser.ml"
+            
+          in
+          let _startpos_cid_ = _startpos__1_ in
+          let _1 = 
+# 3935 "parsing/parser.mly"
     ( () )
-# 20971 "parsing/parser.ml"
-         in
-        let _endpos = _endpos_attrs_ in
-        let _symbolstartpos = _startpos_cid_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3233 "parsing/parser.mly"
+# 21430 "parsing/parser.ml"
+           in
+          let _endpos = _endpos_attrs_ in
+          let _symbolstartpos = _startpos_cid_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3278 "parsing/parser.mly"
     (
       let vars, args, res = vars_args_res in
       let info = symbol_info _endpos in
       let loc = make_loc _sloc in
       cid, vars, args, res, attrs, loc, info
     )
-# 20984 "parsing/parser.ml"
-         in
+# 21443 "parsing/parser.ml"
+           : (Ast_helper.str * Ast_helper.str list * Parsetree.constructor_arguments *
+  Parsetree.core_type option * Parsetree.attributes * Location.t *
+  Docstrings.info))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -21051,9 +21513,9 @@ module Tables = struct
         let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
         let _1_inlined3 : unit = Obj.magic _1_inlined3 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 21057 "parsing/parser.ml"
+# 21519 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -21062,69 +21524,69 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : ((Asttypes.rec_flag * string Asttypes.loc option) *
-  Parsetree.type_declaration) = let attrs2 =
-          let _1 = _1_inlined4 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined4 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 21072 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined4_ in
-        let cstrs =
-          let _1 =
-            let xs = 
-# 253 "<standard.mly>"
-    ( List.rev xs )
-# 21081 "parsing/parser.ml"
-             in
+# 21534 "parsing/parser.ml"
             
-# 1044 "parsing/parser.mly"
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined4_ in
+          let cstrs =
+            let _1 =
+              let xs = 
+# 264 "<standard.mly>"
+    ( List.rev xs )
+# 21543 "parsing/parser.ml"
+               in
+              
+# 1068 "parsing/parser.mly"
     ( xs )
-# 21086 "parsing/parser.ml"
+# 21548 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3138 "parsing/parser.mly"
+# 3183 "parsing/parser.mly"
     ( _1 )
-# 21092 "parsing/parser.ml"
-          
-        in
-        let kind_priv_manifest = 
-# 3173 "parsing/parser.mly"
+# 21554 "parsing/parser.ml"
+            
+          in
+          let kind_priv_manifest = 
+# 3218 "parsing/parser.mly"
       ( _2 )
-# 21098 "parsing/parser.ml"
-         in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 21560 "parsing/parser.ml"
+           in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 21108 "parsing/parser.ml"
-          
-        in
-        let flag = 
-# 3903 "parsing/parser.mly"
+# 21570 "parsing/parser.ml"
+            
+          in
+          let flag = 
+# 3955 "parsing/parser.mly"
                 ( Recursive )
-# 21114 "parsing/parser.ml"
-         in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 21576 "parsing/parser.ml"
+           in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 21121 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3110 "parsing/parser.mly"
+# 21583 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3155 "parsing/parser.mly"
     (
       let (kind, priv, manifest) = kind_priv_manifest in
       let docs = symbol_docs _sloc in
@@ -21133,8 +21595,10 @@ module Tables = struct
       (flag, ext),
       Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
     )
-# 21137 "parsing/parser.ml"
-         in
+# 21599 "parsing/parser.ml"
+           : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -21210,9 +21674,9 @@ module Tables = struct
         let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
         let _1_inlined4 : unit = Obj.magic _1_inlined4 in
         let _1_inlined3 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 21216 "parsing/parser.ml"
+# 21680 "parsing/parser.ml"
         ) = Obj.magic _1_inlined3 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let _1_inlined2 : unit = Obj.magic _1_inlined2 in
@@ -21222,75 +21686,75 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined5_ in
-        let _v : ((Asttypes.rec_flag * string Asttypes.loc option) *
-  Parsetree.type_declaration) = let attrs2 =
-          let _1 = _1_inlined5 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined5 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 21232 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined5_ in
-        let cstrs =
-          let _1 =
-            let xs = 
-# 253 "<standard.mly>"
-    ( List.rev xs )
-# 21241 "parsing/parser.ml"
-             in
+# 21696 "parsing/parser.ml"
             
-# 1044 "parsing/parser.mly"
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined5_ in
+          let cstrs =
+            let _1 =
+              let xs = 
+# 264 "<standard.mly>"
+    ( List.rev xs )
+# 21705 "parsing/parser.ml"
+               in
+              
+# 1068 "parsing/parser.mly"
     ( xs )
-# 21246 "parsing/parser.ml"
+# 21710 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3138 "parsing/parser.mly"
+# 3183 "parsing/parser.mly"
     ( _1 )
-# 21252 "parsing/parser.ml"
-          
-        in
-        let kind_priv_manifest = 
-# 3173 "parsing/parser.mly"
+# 21716 "parsing/parser.ml"
+            
+          in
+          let kind_priv_manifest = 
+# 3218 "parsing/parser.mly"
       ( _2 )
-# 21258 "parsing/parser.ml"
-         in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 21722 "parsing/parser.ml"
+           in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 21268 "parsing/parser.ml"
-          
-        in
-        let flag =
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
-          let _endpos = _endpos__1_ in
-          let _startpos = _startpos__1_ in
-          let _loc = (_startpos, _endpos) in
-          
-# 3905 "parsing/parser.mly"
+# 21732 "parsing/parser.ml"
+            
+          in
+          let flag =
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
+            let _endpos = _endpos__1_ in
+            let _startpos = _startpos__1_ in
+            let _loc = (_startpos, _endpos) in
+            
+# 3957 "parsing/parser.mly"
                 ( not_expecting _loc "nonrec flag" )
-# 21279 "parsing/parser.ml"
-          
-        in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 21743 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 21287 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3110 "parsing/parser.mly"
+# 21751 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3155 "parsing/parser.mly"
     (
       let (kind, priv, manifest) = kind_priv_manifest in
       let docs = symbol_docs _sloc in
@@ -21299,8 +21763,10 @@ module Tables = struct
       (flag, ext),
       Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
     )
-# 21303 "parsing/parser.ml"
-         in
+# 21767 "parsing/parser.ml"
+           : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -21363,9 +21829,9 @@ module Tables = struct
         let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
         let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 21369 "parsing/parser.ml"
+# 21835 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -21374,64 +21840,64 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : ((Asttypes.rec_flag * string Asttypes.loc option) *
-  Parsetree.type_declaration) = let attrs2 =
-          let _1 = _1_inlined3 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 21384 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined3_ in
-        let cstrs =
-          let _1 =
-            let xs = 
-# 253 "<standard.mly>"
-    ( List.rev xs )
-# 21393 "parsing/parser.ml"
-             in
+# 21850 "parsing/parser.ml"
             
-# 1044 "parsing/parser.mly"
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined3_ in
+          let cstrs =
+            let _1 =
+              let xs = 
+# 264 "<standard.mly>"
+    ( List.rev xs )
+# 21859 "parsing/parser.ml"
+               in
+              
+# 1068 "parsing/parser.mly"
     ( xs )
-# 21398 "parsing/parser.ml"
+# 21864 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3138 "parsing/parser.mly"
+# 3183 "parsing/parser.mly"
     ( _1 )
-# 21404 "parsing/parser.ml"
-          
-        in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 21870 "parsing/parser.ml"
+            
+          in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 21415 "parsing/parser.ml"
-          
-        in
-        let flag = 
-# 3899 "parsing/parser.mly"
+# 21881 "parsing/parser.ml"
+            
+          in
+          let flag = 
+# 3951 "parsing/parser.mly"
                                                 ( Recursive )
-# 21421 "parsing/parser.ml"
-         in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 21887 "parsing/parser.ml"
+           in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 21428 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3110 "parsing/parser.mly"
+# 21894 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3155 "parsing/parser.mly"
     (
       let (kind, priv, manifest) = kind_priv_manifest in
       let docs = symbol_docs _sloc in
@@ -21440,8 +21906,10 @@ module Tables = struct
       (flag, ext),
       Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
     )
-# 21444 "parsing/parser.ml"
-         in
+# 21910 "parsing/parser.ml"
+           : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -21510,9 +21978,9 @@ module Tables = struct
         let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
         let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
         let _1_inlined3 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 21516 "parsing/parser.ml"
+# 21984 "parsing/parser.ml"
         ) = Obj.magic _1_inlined3 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let _1_inlined2 : unit = Obj.magic _1_inlined2 in
@@ -21522,64 +21990,64 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : ((Asttypes.rec_flag * string Asttypes.loc option) *
-  Parsetree.type_declaration) = let attrs2 =
-          let _1 = _1_inlined4 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined4 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 21532 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined4_ in
-        let cstrs =
-          let _1 =
-            let xs = 
-# 253 "<standard.mly>"
-    ( List.rev xs )
-# 21541 "parsing/parser.ml"
-             in
+# 22000 "parsing/parser.ml"
             
-# 1044 "parsing/parser.mly"
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined4_ in
+          let cstrs =
+            let _1 =
+              let xs = 
+# 264 "<standard.mly>"
+    ( List.rev xs )
+# 22009 "parsing/parser.ml"
+               in
+              
+# 1068 "parsing/parser.mly"
     ( xs )
-# 21546 "parsing/parser.ml"
+# 22014 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3138 "parsing/parser.mly"
+# 3183 "parsing/parser.mly"
     ( _1 )
-# 21552 "parsing/parser.ml"
-          
-        in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 22020 "parsing/parser.ml"
+            
+          in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 21563 "parsing/parser.ml"
-          
-        in
-        let flag = 
-# 3900 "parsing/parser.mly"
+# 22031 "parsing/parser.ml"
+            
+          in
+          let flag = 
+# 3952 "parsing/parser.mly"
                                                 ( Nonrecursive )
-# 21569 "parsing/parser.ml"
-         in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 22037 "parsing/parser.ml"
+           in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 21576 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3110 "parsing/parser.mly"
+# 22044 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3155 "parsing/parser.mly"
     (
       let (kind, priv, manifest) = kind_priv_manifest in
       let docs = symbol_docs _sloc in
@@ -21588,8 +22056,10 @@ module Tables = struct
       (flag, ext),
       Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
     )
-# 21592 "parsing/parser.ml"
-         in
+# 22060 "parsing/parser.ml"
+           : ((Asttypes.rec_flag * string Asttypes.loc option) *
+  Parsetree.type_declaration))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -21607,17 +22077,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 21613 "parsing/parser.ml"
+# 22083 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3742 "parsing/parser.mly"
+# 3794 "parsing/parser.mly"
                               ( _1 )
-# 21621 "parsing/parser.ml"
+# 22091 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -21636,17 +22106,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 21642 "parsing/parser.ml"
+# 22112 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3743 "parsing/parser.mly"
+# 3795 "parsing/parser.mly"
                               ( _1 )
-# 21650 "parsing/parser.ml"
+# 22120 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -21676,9 +22146,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.structure) = 
-# 1236 "parsing/parser.mly"
+# 1260 "parsing/parser.mly"
     ( _1 )
-# 21682 "parsing/parser.ml"
+# 22152 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -21694,9 +22164,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (string) = 
-# 3792 "parsing/parser.mly"
+# 3844 "parsing/parser.mly"
   ( "" )
-# 21700 "parsing/parser.ml"
+# 22170 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -21726,9 +22196,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (string) = 
-# 3793 "parsing/parser.mly"
+# 3845 "parsing/parser.mly"
               ( ";.." )
-# 21732 "parsing/parser.ml"
+# 22202 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -21758,9 +22228,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.signature) = 
-# 1243 "parsing/parser.mly"
+# 1267 "parsing/parser.mly"
     ( _1 )
-# 21764 "parsing/parser.ml"
+# 22234 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -21804,9 +22274,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
         let _v : (Parsetree.extension) = 
-# 4083 "parsing/parser.mly"
+# 4135 "parsing/parser.mly"
                                                     ( (_2, _3) )
-# 21810 "parsing/parser.ml"
+# 22280 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -21825,21 +22295,23 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 820 "parsing/parser.mly"
+# 839 "parsing/parser.mly"
        (string * Location.t * string * Location.t * string option)
-# 21831 "parsing/parser.ml"
+# 22301 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.extension) = let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 4085 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 4137 "parsing/parser.mly"
     ( mk_quotedext ~loc:_sloc _1 )
-# 21842 "parsing/parser.ml"
-         in
+# 22313 "parsing/parser.ml"
+           : (Parsetree.extension))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -21884,60 +22356,62 @@ module Tables = struct
         let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
         let _3 : unit = Obj.magic _3 in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 21890 "parsing/parser.ml"
+# 22362 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.label_declaration) = let _5 =
-          let _1 = _1_inlined3 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _5 =
+            let _1 = _1_inlined3 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 21901 "parsing/parser.ml"
-          
-        in
-        let _endpos__5_ = _endpos__1_inlined3_ in
-        let _4 =
-          let _1 = _1_inlined2 in
-          
-# 3439 "parsing/parser.mly"
+# 22374 "parsing/parser.ml"
+            
+          in
+          let _endpos__5_ = _endpos__1_inlined3_ in
+          let _4 =
+            let _1 = _1_inlined2 in
+            
+# 3484 "parsing/parser.mly"
     ( _1 )
-# 21910 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+# 22383 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 21918 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 22391 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 21926 "parsing/parser.ml"
-          
-        in
-        let _startpos__2_ = _startpos__1_inlined1_ in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
-          _startpos__1_
-        else
-          _startpos__2_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3312 "parsing/parser.mly"
+# 22399 "parsing/parser.ml"
+            
+          in
+          let _startpos__2_ = _startpos__1_inlined1_ in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
+            _startpos__1_
+          else
+            _startpos__2_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3357 "parsing/parser.mly"
       ( let info = symbol_info _endpos in
         Type.field _2 _4 ~mut:_1 ~attrs:_5 ~loc:(make_loc _sloc) ~info )
-# 21940 "parsing/parser.ml"
-         in
+# 22413 "parsing/parser.ml"
+           : (Parsetree.label_declaration))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -21996,73 +22470,75 @@ module Tables = struct
         let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
         let _3 : unit = Obj.magic _3 in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 22002 "parsing/parser.ml"
+# 22476 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : (Parsetree.label_declaration) = let _7 =
-          let _1 = _1_inlined4 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _7 =
+            let _1 = _1_inlined4 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 22013 "parsing/parser.ml"
-          
-        in
-        let _endpos__7_ = _endpos__1_inlined4_ in
-        let _5 =
-          let _1 = _1_inlined3 in
-          
-# 4062 "parsing/parser.mly"
+# 22488 "parsing/parser.ml"
+            
+          in
+          let _endpos__7_ = _endpos__1_inlined4_ in
+          let _5 =
+            let _1 = _1_inlined3 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 22022 "parsing/parser.ml"
-          
-        in
-        let _endpos__5_ = _endpos__1_inlined3_ in
-        let _4 =
-          let _1 = _1_inlined2 in
-          
-# 3439 "parsing/parser.mly"
+# 22497 "parsing/parser.ml"
+            
+          in
+          let _endpos__5_ = _endpos__1_inlined3_ in
+          let _4 =
+            let _1 = _1_inlined2 in
+            
+# 3484 "parsing/parser.mly"
     ( _1 )
-# 22031 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+# 22506 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 22039 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 22514 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 22047 "parsing/parser.ml"
-          
-        in
-        let _startpos__2_ = _startpos__1_inlined1_ in
-        let _endpos = _endpos__7_ in
-        let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
-          _startpos__1_
-        else
-          _startpos__2_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3317 "parsing/parser.mly"
+# 22522 "parsing/parser.ml"
+            
+          in
+          let _startpos__2_ = _startpos__1_inlined1_ in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
+            _startpos__1_
+          else
+            _startpos__2_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3362 "parsing/parser.mly"
       ( let info =
           match rhs_info _endpos__5_ with
           | Some _ as info_before_semi -> info_before_semi
           | None -> symbol_info _endpos
        in
        Type.field _2 _4 ~mut:_1 ~attrs:(_5 @ _7) ~loc:(make_loc _sloc) ~info )
-# 22065 "parsing/parser.ml"
-         in
+# 22540 "parsing/parser.ml"
+           : (Parsetree.label_declaration))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22084,9 +22560,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.label_declaration list) = 
-# 3306 "parsing/parser.mly"
+# 3351 "parsing/parser.mly"
                                                 ( [_1] )
-# 22090 "parsing/parser.ml"
+# 22566 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22109,9 +22585,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.label_declaration list) = 
-# 3307 "parsing/parser.mly"
+# 3352 "parsing/parser.mly"
                                                 ( [_1] )
-# 22115 "parsing/parser.ml"
+# 22591 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22141,9 +22617,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.label_declaration list) = 
-# 3308 "parsing/parser.mly"
+# 3353 "parsing/parser.mly"
                                                 ( _1 :: _2 )
-# 22147 "parsing/parser.ml"
+# 22623 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22162,38 +22638,40 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 22168 "parsing/parser.ml"
+# 22644 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (string * Parsetree.pattern) = let x =
-          let _1 =
+        let _v =
+          let x =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 22658 "parsing/parser.ml"
+              
+            in
             let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 22181 "parsing/parser.ml"
+# 2389 "parsing/parser.mly"
+      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
+# 22667 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2367 "parsing/parser.mly"
-      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 22190 "parsing/parser.ml"
-          
-        in
-        
-# 2359 "parsing/parser.mly"
+          (
+# 2381 "parsing/parser.mly"
       ( x )
-# 22196 "parsing/parser.ml"
-         in
+# 22673 "parsing/parser.ml"
+           : (string * Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22225,44 +22703,46 @@ module Tables = struct
         let cty : (Parsetree.core_type) = Obj.magic cty in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 22231 "parsing/parser.ml"
+# 22709 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_cty_ in
-        let _v : (string * Parsetree.pattern) = let x =
-          let _1 =
+        let _v =
+          let x =
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 22723 "parsing/parser.ml"
+              
+            in
             let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 22244 "parsing/parser.ml"
+# 2389 "parsing/parser.mly"
+      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
+# 22732 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
+          let _startpos_x_ = _startpos__1_ in
+          let _endpos = _endpos_cty_ in
+          let _symbolstartpos = _startpos_x_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2367 "parsing/parser.mly"
-      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 22253 "parsing/parser.ml"
-          
-        in
-        let _startpos_x_ = _startpos__1_ in
-        let _endpos = _endpos_cty_ in
-        let _symbolstartpos = _startpos_x_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2361 "parsing/parser.mly"
+          (
+# 2383 "parsing/parser.mly"
       ( let lab, pat = x in
         lab,
         mkpat ~loc:_sloc (Ppat_constraint (pat, cty)) )
-# 22265 "parsing/parser.ml"
-         in
+# 22744 "parsing/parser.ml"
+           : (string * Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22284,9 +22764,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3824 "parsing/parser.mly"
+# 3876 "parsing/parser.mly"
                                         ( _1 )
-# 22290 "parsing/parser.ml"
+# 22770 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22309,9 +22789,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.arg_label * Parsetree.expression) = 
-# 2620 "parsing/parser.mly"
+# 2662 "parsing/parser.mly"
       ( (Nolabel, _1) )
-# 22315 "parsing/parser.ml"
+# 22795 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22337,17 +22817,17 @@ module Tables = struct
         } = _menhir_stack in
         let _2 : (Parsetree.expression) = Obj.magic _2 in
         let _1 : (
-# 765 "parsing/parser.mly"
+# 784 "parsing/parser.mly"
        (string)
-# 22343 "parsing/parser.ml"
+# 22823 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.arg_label * Parsetree.expression) = 
-# 2622 "parsing/parser.mly"
+# 2664 "parsing/parser.mly"
       ( (Labelled _1, _2) )
-# 22351 "parsing/parser.ml"
+# 22831 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22372,21 +22852,23 @@ module Tables = struct
           };
         } = _menhir_stack in
         let label : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 22378 "parsing/parser.ml"
+# 22858 "parsing/parser.ml"
         ) = Obj.magic label in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_label_ in
-        let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in
-        
-# 2624 "parsing/parser.mly"
+        let _v =
+          let _loc_label_ = (_startpos_label_, _endpos_label_) in
+          (
+# 2666 "parsing/parser.mly"
       ( let loc = _loc_label_ in
         (Labelled label, mkexpvar ~loc label) )
-# 22389 "parsing/parser.ml"
-         in
+# 22870 "parsing/parser.ml"
+           : (Asttypes.arg_label * Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22430,23 +22912,25 @@ module Tables = struct
         let _5 : unit = Obj.magic _5 in
         let ty : (Parsetree.type_constraint) = Obj.magic ty in
         let label : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 22436 "parsing/parser.ml"
+# 22918 "parsing/parser.ml"
         ) = Obj.magic label in
         let _2 : unit = Obj.magic _2 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Asttypes.arg_label * Parsetree.expression) = let _endpos = _endpos__5_ in
-        let _loc_label_ = (_startpos_label_, _endpos_label_) in
-        
-# 2627 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__5_ in
+          let _loc_label_ = (_startpos_label_, _endpos_label_) in
+          (
+# 2669 "parsing/parser.mly"
       ( (Labelled label, mkexp_constraint ~loc:(_startpos__2_, _endpos)
                            (mkexpvar ~loc:_loc_label_ label) ty) )
-# 22449 "parsing/parser.ml"
-         in
+# 22932 "parsing/parser.ml"
+           : (Asttypes.arg_label * Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22470,21 +22954,23 @@ module Tables = struct
           };
         } = _menhir_stack in
         let label : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 22476 "parsing/parser.ml"
+# 22960 "parsing/parser.ml"
         ) = Obj.magic label in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_label_ in
-        let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in
-        
-# 2630 "parsing/parser.mly"
+        let _v =
+          let _loc_label_ = (_startpos_label_, _endpos_label_) in
+          (
+# 2672 "parsing/parser.mly"
       ( let loc = _loc_label_ in
         (Optional label, mkexpvar ~loc label) )
-# 22487 "parsing/parser.ml"
-         in
+# 22972 "parsing/parser.ml"
+           : (Asttypes.arg_label * Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22509,17 +22995,17 @@ module Tables = struct
         } = _menhir_stack in
         let _2 : (Parsetree.expression) = Obj.magic _2 in
         let _1 : (
-# 795 "parsing/parser.mly"
+# 814 "parsing/parser.mly"
        (string)
-# 22515 "parsing/parser.ml"
+# 23001 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.arg_label * Parsetree.expression) = 
-# 2633 "parsing/parser.mly"
+# 2675 "parsing/parser.mly"
       ( (Optional _1, _2) )
-# 22523 "parsing/parser.ml"
+# 23009 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22569,19 +23055,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
-          let _1 = _1_inlined1 in
-          
-# 2355 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined1 in
+            
+# 2377 "parsing/parser.mly"
     ( _1 )
-# 22578 "parsing/parser.ml"
-          
-        in
-        
-# 2329 "parsing/parser.mly"
+# 23065 "parsing/parser.ml"
+            
+          in
+          (
+# 2351 "parsing/parser.mly"
       ( (Optional (fst _3), _4, snd _3) )
-# 22584 "parsing/parser.ml"
-         in
+# 23071 "parsing/parser.ml"
+           : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22605,40 +23093,42 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 22611 "parsing/parser.ml"
+# 23099 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _2 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 =
+        let _v =
+          let _2 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 23115 "parsing/parser.ml"
+              
+            in
             let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 22626 "parsing/parser.ml"
+# 2389 "parsing/parser.mly"
+      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
+# 23124 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2367 "parsing/parser.mly"
-      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 22635 "parsing/parser.ml"
-          
-        in
-        
-# 2331 "parsing/parser.mly"
+          (
+# 2353 "parsing/parser.mly"
       ( (Optional (fst _2), None, snd _2) )
-# 22641 "parsing/parser.ml"
-         in
+# 23130 "parsing/parser.ml"
+           : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22684,26 +23174,28 @@ module Tables = struct
         let _3 : (Parsetree.pattern) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 795 "parsing/parser.mly"
+# 814 "parsing/parser.mly"
        (string)
-# 22690 "parsing/parser.ml"
+# 23180 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
-          let _1 = _1_inlined1 in
-          
-# 2355 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined1 in
+            
+# 2377 "parsing/parser.mly"
     ( _1 )
-# 22700 "parsing/parser.ml"
-          
-        in
-        
-# 2333 "parsing/parser.mly"
+# 23191 "parsing/parser.ml"
+            
+          in
+          (
+# 2355 "parsing/parser.mly"
       ( (Optional _1, _4, _3) )
-# 22706 "parsing/parser.ml"
-         in
+# 23197 "parsing/parser.ml"
+           : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22728,17 +23220,17 @@ module Tables = struct
         } = _menhir_stack in
         let _2 : (Parsetree.pattern) = Obj.magic _2 in
         let _1 : (
-# 795 "parsing/parser.mly"
+# 814 "parsing/parser.mly"
        (string)
-# 22734 "parsing/parser.ml"
+# 23226 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = 
-# 2335 "parsing/parser.mly"
+# 2357 "parsing/parser.mly"
       ( (Optional _1, None, _2) )
-# 22742 "parsing/parser.ml"
+# 23234 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22782,9 +23274,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
         let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = 
-# 2337 "parsing/parser.mly"
+# 2359 "parsing/parser.mly"
       ( (Labelled (fst _3), None, snd _3) )
-# 22788 "parsing/parser.ml"
+# 23280 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22809,40 +23301,42 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 22815 "parsing/parser.ml"
+# 23307 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _2 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 =
+        let _v =
+          let _2 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 23323 "parsing/parser.ml"
+              
+            in
             let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 22830 "parsing/parser.ml"
+# 2389 "parsing/parser.mly"
+      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
+# 23332 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2367 "parsing/parser.mly"
-      ( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 22839 "parsing/parser.ml"
-          
-        in
-        
-# 2339 "parsing/parser.mly"
+          (
+# 2361 "parsing/parser.mly"
       ( (Labelled (fst _2), None, snd _2) )
-# 22845 "parsing/parser.ml"
-         in
+# 23338 "parsing/parser.ml"
+           : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22867,17 +23361,17 @@ module Tables = struct
         } = _menhir_stack in
         let _2 : (Parsetree.pattern) = Obj.magic _2 in
         let _1 : (
-# 765 "parsing/parser.mly"
+# 784 "parsing/parser.mly"
        (string)
-# 22873 "parsing/parser.ml"
+# 23367 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = 
-# 2341 "parsing/parser.mly"
+# 2363 "parsing/parser.mly"
       ( (Labelled _1, None, _2) )
-# 22881 "parsing/parser.ml"
+# 23375 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22900,9 +23394,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = 
-# 2343 "parsing/parser.mly"
+# 2365 "parsing/parser.mly"
       ( (Nolabel, None, _1) )
-# 22906 "parsing/parser.ml"
+# 23400 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22927,9 +23421,9 @@ module Tables = struct
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.pattern * Parsetree.expression *
   Parsetree.value_constraint option * bool) = 
-# 2672 "parsing/parser.mly"
+# 2714 "parsing/parser.mly"
       ( let p,e,c = _1 in (p,e,c,false) )
-# 22933 "parsing/parser.ml"
+# 23427 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -22951,15 +23445,17 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern * Parsetree.expression *
-  Parsetree.value_constraint option * bool) = let _endpos = _endpos__1_ in
-        let _startpos = _startpos__1_ in
-        let _loc = (_startpos, _endpos) in
-        
-# 2675 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _startpos = _startpos__1_ in
+          let _loc = (_startpos, _endpos) in
+          (
+# 2717 "parsing/parser.mly"
       ( (mkpatvar ~loc:_loc _1, mkexpvar ~loc:_loc _1, None, true) )
-# 22962 "parsing/parser.ml"
-         in
+# 23456 "parsing/parser.ml"
+           : (Parsetree.pattern * Parsetree.expression *
+  Parsetree.value_constraint option * bool))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -22987,22 +23483,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.pattern * Parsetree.expression *
-  Parsetree.value_constraint option) = let _1 =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2640 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2682 "parsing/parser.mly"
               ( mkpatvar ~loc:_sloc _1 )
-# 22999 "parsing/parser.ml"
-          
-        in
-        
-# 2644 "parsing/parser.mly"
+# 23495 "parsing/parser.ml"
+            
+          in
+          (
+# 2686 "parsing/parser.mly"
       ( (_1, _2, None) )
-# 23005 "parsing/parser.ml"
-         in
+# 23501 "parsing/parser.ml"
+           : (Parsetree.pattern * Parsetree.expression *
+  Parsetree.value_constraint option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -23044,19 +23542,19 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.pattern * Parsetree.expression *
-  Parsetree.value_constraint option) = let _1 =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2640 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2682 "parsing/parser.mly"
               ( mkpatvar ~loc:_sloc _1 )
-# 23056 "parsing/parser.ml"
-          
-        in
-        
-# 2646 "parsing/parser.mly"
+# 23554 "parsing/parser.ml"
+            
+          in
+          (
+# 2688 "parsing/parser.mly"
       ( let v = _1 in (* PR#7344 *)
         let t =
           match _2 with
@@ -23066,8 +23564,10 @@ module Tables = struct
         in
         (v, _4, Some t)
         )
-# 23070 "parsing/parser.ml"
-         in
+# 23568 "parsing/parser.ml"
+           : (Parsetree.pattern * Parsetree.expression *
+  Parsetree.value_constraint option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -23130,53 +23630,55 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.pattern * Parsetree.expression *
-  Parsetree.value_constraint option) = let _3 =
-          let _1 =
+        let _v =
+          let _3 =
             let _1 =
-              let xs = 
-# 253 "<standard.mly>"
+              let _1 =
+                let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 23141 "parsing/parser.ml"
-               in
-              
-# 1062 "parsing/parser.mly"
+# 23641 "parsing/parser.ml"
+                 in
+                
+# 1086 "parsing/parser.mly"
     ( xs )
-# 23146 "parsing/parser.ml"
+# 23646 "parsing/parser.ml"
+                
+              in
+              
+# 3466 "parsing/parser.mly"
+    ( _1 )
+# 23652 "parsing/parser.ml"
               
             in
             
-# 3421 "parsing/parser.mly"
-    ( _1 )
-# 23152 "parsing/parser.ml"
+# 3470 "parsing/parser.mly"
+    ( Ptyp_poly(_1, _3) )
+# 23658 "parsing/parser.ml"
             
           in
-          
-# 3425 "parsing/parser.mly"
-    ( Ptyp_poly(_1, _3) )
-# 23158 "parsing/parser.ml"
-          
-        in
-        let _startpos__3_ = _startpos_xs_ in
-        let _1 =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2640 "parsing/parser.mly"
+          let _startpos__3_ = _startpos_xs_ in
+          let _1 =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2682 "parsing/parser.mly"
               ( mkpatvar ~loc:_sloc _1 )
-# 23169 "parsing/parser.ml"
-          
-        in
-        let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        
-# 2656 "parsing/parser.mly"
+# 23669 "parsing/parser.ml"
+            
+          in
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          (
+# 2698 "parsing/parser.mly"
     (
       let t = ghtyp ~loc:(_loc__3_) _3 in
       (_1, _5, Some (Pvc_constraint { locally_abstract_univars = []; typ=t }))
     )
-# 23179 "parsing/parser.ml"
-         in
+# 23679 "parsing/parser.ml"
+           : (Parsetree.pattern * Parsetree.expression *
+  Parsetree.value_constraint option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -23246,30 +23748,32 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__8_ in
-        let _v : (Parsetree.pattern * Parsetree.expression *
-  Parsetree.value_constraint option) = let _4 = 
-# 2637 "parsing/parser.mly"
+        let _v =
+          let _4 = 
+# 2679 "parsing/parser.mly"
     ( xs )
-# 23254 "parsing/parser.ml"
-         in
-        let _1 =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2640 "parsing/parser.mly"
+# 23756 "parsing/parser.ml"
+           in
+          let _1 =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2682 "parsing/parser.mly"
               ( mkpatvar ~loc:_sloc _1 )
-# 23263 "parsing/parser.ml"
-          
-        in
-        
-# 2661 "parsing/parser.mly"
+# 23765 "parsing/parser.ml"
+            
+          in
+          (
+# 2703 "parsing/parser.mly"
     ( let constraint' =
         Pvc_constraint { locally_abstract_univars=_4; typ = _6}
       in
       (_1, _8, Some constraint') )
-# 23272 "parsing/parser.ml"
-         in
+# 23774 "parsing/parser.ml"
+           : (Parsetree.pattern * Parsetree.expression *
+  Parsetree.value_constraint option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -23306,9 +23810,9 @@ module Tables = struct
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.pattern * Parsetree.expression *
   Parsetree.value_constraint option) = 
-# 2666 "parsing/parser.mly"
+# 2708 "parsing/parser.mly"
       ( (_1, _3, None) )
-# 23312 "parsing/parser.ml"
+# 23816 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -23360,9 +23864,9 @@ module Tables = struct
         let _endpos = _endpos__5_ in
         let _v : (Parsetree.pattern * Parsetree.expression *
   Parsetree.value_constraint option) = 
-# 2668 "parsing/parser.mly"
+# 2710 "parsing/parser.mly"
       ( (_1, _5, Some(Pvc_constraint { locally_abstract_univars=[]; typ=_3 })) )
-# 23366 "parsing/parser.ml"
+# 23870 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -23420,41 +23924,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (let_bindings) = let _1 =
-          let attrs2 =
-            let _1 = _1_inlined2 in
-            
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let attrs2 =
+              let _1 = _1_inlined2 in
+              
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 23430 "parsing/parser.ml"
-            
-          in
-          let _endpos_attrs2_ = _endpos__1_inlined2_ in
-          let attrs1 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+# 23935 "parsing/parser.ml"
+              
+            in
+            let _endpos_attrs2_ = _endpos__1_inlined2_ in
+            let attrs1 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 23439 "parsing/parser.ml"
+# 23944 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos_attrs2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos = _endpos_attrs2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2695 "parsing/parser.mly"
+# 2737 "parsing/parser.mly"
     (
       let attrs = attrs1 @ attrs2 in
       mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
     )
-# 23451 "parsing/parser.ml"
-          
-        in
-        
-# 2685 "parsing/parser.mly"
+# 23956 "parsing/parser.ml"
+            
+          in
+          (
+# 2727 "parsing/parser.mly"
                                                 ( _1 )
-# 23457 "parsing/parser.ml"
-         in
+# 23962 "parsing/parser.ml"
+           : (let_bindings))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -23483,9 +23989,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (let_bindings) = 
-# 2686 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
                                                 ( addlb _1 _2 )
-# 23489 "parsing/parser.ml"
+# 23995 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -23536,46 +24042,48 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (let_bindings) = let _1 =
-          let attrs2 =
-            let _1 = _1_inlined2 in
-            
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let attrs2 =
+              let _1 = _1_inlined2 in
+              
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 23546 "parsing/parser.ml"
-            
-          in
-          let _endpos_attrs2_ = _endpos__1_inlined2_ in
-          let attrs1 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+# 24053 "parsing/parser.ml"
+              
+            in
+            let _endpos_attrs2_ = _endpos__1_inlined2_ in
+            let attrs1 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 23555 "parsing/parser.ml"
-            
-          in
-          let ext = 
-# 4069 "parsing/parser.mly"
+# 24062 "parsing/parser.ml"
+              
+            in
+            let ext = 
+# 4121 "parsing/parser.mly"
                     ( None )
-# 23561 "parsing/parser.ml"
-           in
-          let _endpos = _endpos_attrs2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2695 "parsing/parser.mly"
+# 24068 "parsing/parser.ml"
+             in
+            let _endpos = _endpos_attrs2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2737 "parsing/parser.mly"
     (
       let attrs = attrs1 @ attrs2 in
       mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
     )
-# 23572 "parsing/parser.ml"
-          
-        in
-        
-# 2685 "parsing/parser.mly"
+# 24079 "parsing/parser.ml"
+            
+          in
+          (
+# 2727 "parsing/parser.mly"
                                                 ( _1 )
-# 23578 "parsing/parser.ml"
-         in
+# 24085 "parsing/parser.ml"
+           : (let_bindings))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -23639,52 +24147,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (let_bindings) = let _1 =
-          let attrs2 =
-            let _1 = _1_inlined3 in
-            
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let attrs2 =
+              let _1 = _1_inlined3 in
+              
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 23649 "parsing/parser.ml"
-            
-          in
-          let _endpos_attrs2_ = _endpos__1_inlined3_ in
-          let attrs1 =
-            let _1 = _1_inlined2 in
-            
-# 4062 "parsing/parser.mly"
+# 24158 "parsing/parser.ml"
+              
+            in
+            let _endpos_attrs2_ = _endpos__1_inlined3_ in
+            let attrs1 =
+              let _1 = _1_inlined2 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 23658 "parsing/parser.ml"
-            
-          in
-          let ext =
-            let _startpos__1_ = _startpos__1_inlined1_ in
-            let _endpos = _endpos__2_ in
-            let _startpos = _startpos__1_ in
-            let _loc = (_startpos, _endpos) in
-            
-# 4071 "parsing/parser.mly"
+# 24167 "parsing/parser.ml"
+              
+            in
+            let ext =
+              let _startpos__1_ = _startpos__1_inlined1_ in
+              let _endpos = _endpos__2_ in
+              let _startpos = _startpos__1_ in
+              let _loc = (_startpos, _endpos) in
+              
+# 4123 "parsing/parser.mly"
                     ( not_expecting _loc "extension" )
-# 23669 "parsing/parser.ml"
+# 24178 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos_attrs2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos = _endpos_attrs2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2695 "parsing/parser.mly"
+# 2737 "parsing/parser.mly"
     (
       let attrs = attrs1 @ attrs2 in
       mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
     )
-# 23681 "parsing/parser.ml"
-          
-        in
-        
-# 2685 "parsing/parser.mly"
+# 24190 "parsing/parser.ml"
+            
+          in
+          (
+# 2727 "parsing/parser.mly"
                                                 ( _1 )
-# 23687 "parsing/parser.ml"
-         in
+# 24196 "parsing/parser.ml"
+           : (let_bindings))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -23713,9 +24223,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (let_bindings) = 
-# 2686 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
                                                 ( addlb _1 _2 )
-# 23719 "parsing/parser.ml"
+# 24229 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -23738,9 +24248,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.pattern) = 
-# 2371 "parsing/parser.mly"
+# 2393 "parsing/parser.mly"
       ( _1 )
-# 23744 "parsing/parser.ml"
+# 24254 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -23776,27 +24286,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2373 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2395 "parsing/parser.mly"
       ( Ppat_constraint(_1, _3) )
-# 23784 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 24295 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 23793 "parsing/parser.ml"
-          
-        in
-        
-# 2374 "parsing/parser.mly"
+# 24304 "parsing/parser.ml"
+            
+          in
+          (
+# 2396 "parsing/parser.mly"
       ( _1 )
-# 23799 "parsing/parser.ml"
-         in
+# 24310 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -23824,21 +24336,23 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_exp_ in
-        let _v : (Parsetree.pattern * Parsetree.expression) = let pat =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2640 "parsing/parser.mly"
+        let _v =
+          let pat =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2682 "parsing/parser.mly"
               ( mkpatvar ~loc:_sloc _1 )
-# 23835 "parsing/parser.ml"
-          
-        in
-        
-# 2712 "parsing/parser.mly"
+# 24348 "parsing/parser.ml"
+            
+          in
+          (
+# 2754 "parsing/parser.mly"
       ( (pat, exp) )
-# 23841 "parsing/parser.ml"
-         in
+# 24354 "parsing/parser.ml"
+           : (Parsetree.pattern * Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -23859,14 +24373,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern * Parsetree.expression) = let _endpos = _endpos__1_ in
-        let _startpos = _startpos__1_ in
-        let _loc = (_startpos, _endpos) in
-        
-# 2715 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _startpos = _startpos__1_ in
+          let _loc = (_startpos, _endpos) in
+          (
+# 2757 "parsing/parser.mly"
       ( (mkpatvar ~loc:_loc _1, mkexpvar ~loc:_loc _1) )
-# 23869 "parsing/parser.ml"
-         in
+# 24384 "parsing/parser.ml"
+           : (Parsetree.pattern * Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -23916,10 +24432,10 @@ module Tables = struct
         let _startpos = _startpos_pat_ in
         let _endpos = _endpos_exp_ in
         let _v : (Parsetree.pattern * Parsetree.expression) = 
-# 2717 "parsing/parser.mly"
+# 2759 "parsing/parser.mly"
       ( let loc = (_startpos_pat_, _endpos_typ_) in
         (ghpat ~loc (Ppat_constraint(pat, typ)), exp) )
-# 23923 "parsing/parser.ml"
+# 24439 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -23956,9 +24472,9 @@ module Tables = struct
         let _startpos = _startpos_pat_ in
         let _endpos = _endpos_exp_ in
         let _v : (Parsetree.pattern * Parsetree.expression) = 
-# 2720 "parsing/parser.mly"
+# 2762 "parsing/parser.mly"
       ( (pat, exp) )
-# 23962 "parsing/parser.ml"
+# 24478 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -23981,10 +24497,10 @@ module Tables = struct
         let _startpos = _startpos_body_ in
         let _endpos = _endpos_body_ in
         let _v : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = 
-# 2724 "parsing/parser.mly"
+# 2766 "parsing/parser.mly"
       ( let let_pat, let_exp = body in
         let_pat, let_exp, [] )
-# 23988 "parsing/parser.ml"
+# 24504 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -24016,36 +24532,38 @@ module Tables = struct
         } = _menhir_stack in
         let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
         let _1 : (
-# 761 "parsing/parser.mly"
+# 780 "parsing/parser.mly"
        (string)
-# 24022 "parsing/parser.ml"
+# 24538 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_bindings_ in
         let _endpos = _endpos_body_ in
-        let _v : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = let pbop_op =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let pbop_op =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 24035 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_body_ in
-        let _symbolstartpos = _startpos_bindings_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2727 "parsing/parser.mly"
+# 24552 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_body_ in
+          let _symbolstartpos = _startpos_bindings_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2769 "parsing/parser.mly"
       ( let let_pat, let_exp, rev_ands = bindings in
         let pbop_pat, pbop_exp = body in
         let pbop_loc = make_loc _sloc in
         let and_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
         let_pat, let_exp, and_ :: rev_ands )
-# 24048 "parsing/parser.ml"
-         in
+# 24565 "parsing/parser.ml"
+           : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -24060,9 +24578,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.class_declaration list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 24066 "parsing/parser.ml"
+# 24584 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -24126,9 +24644,9 @@ module Tables = struct
         let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
         let body : (Parsetree.class_expr) = Obj.magic body in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 24132 "parsing/parser.ml"
+# 24650 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -24137,40 +24655,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.class_declaration list) = let x =
-          let attrs2 =
-            let _1 = _1_inlined3 in
-            
-# 4058 "parsing/parser.mly"
+        let _v =
+          let x =
+            let attrs2 =
+              let _1 = _1_inlined3 in
+              
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 24147 "parsing/parser.ml"
-            
-          in
-          let _endpos_attrs2_ = _endpos__1_inlined3_ in
-          let id =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 24666 "parsing/parser.ml"
+              
+            in
+            let _endpos_attrs2_ = _endpos__1_inlined3_ in
+            let id =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 24159 "parsing/parser.ml"
-            
-          in
-          let attrs1 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+# 24678 "parsing/parser.ml"
+              
+            in
+            let attrs1 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 24167 "parsing/parser.ml"
+# 24686 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos_attrs2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos = _endpos_attrs2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1944 "parsing/parser.mly"
+# 1966 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
@@ -24178,14 +24697,15 @@ module Tables = struct
     let text = symbol_text _symbolstartpos in
     Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs
   )
-# 24182 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 24701 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 24188 "parsing/parser.ml"
-         in
+# 24707 "parsing/parser.ml"
+           : (Parsetree.class_declaration list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -24200,9 +24720,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.class_description list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 24206 "parsing/parser.ml"
+# 24726 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -24273,9 +24793,9 @@ module Tables = struct
         let cty : (Parsetree.class_type) = Obj.magic cty in
         let _6 : unit = Obj.magic _6 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 24279 "parsing/parser.ml"
+# 24799 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -24284,40 +24804,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.class_description list) = let x =
-          let attrs2 =
-            let _1 = _1_inlined3 in
-            
-# 4058 "parsing/parser.mly"
+        let _v =
+          let x =
+            let attrs2 =
+              let _1 = _1_inlined3 in
+              
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 24294 "parsing/parser.ml"
-            
-          in
-          let _endpos_attrs2_ = _endpos__1_inlined3_ in
-          let id =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 24815 "parsing/parser.ml"
+              
+            in
+            let _endpos_attrs2_ = _endpos__1_inlined3_ in
+            let id =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 24306 "parsing/parser.ml"
-            
-          in
-          let attrs1 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+# 24827 "parsing/parser.ml"
+              
+            in
+            let attrs1 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 24314 "parsing/parser.ml"
+# 24835 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos_attrs2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos = _endpos_attrs2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2235 "parsing/parser.mly"
+# 2257 "parsing/parser.mly"
     (
       let attrs = attrs1 @ attrs2 in
       let loc = make_loc _sloc in
@@ -24325,14 +24846,15 @@ module Tables = struct
       let text = symbol_text _symbolstartpos in
       Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs
     )
-# 24329 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 24850 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 24335 "parsing/parser.ml"
-         in
+# 24856 "parsing/parser.ml"
+           : (Parsetree.class_description list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -24347,9 +24869,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.class_type_declaration list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 24353 "parsing/parser.ml"
+# 24875 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -24420,9 +24942,9 @@ module Tables = struct
         let csig : (Parsetree.class_type) = Obj.magic csig in
         let _6 : unit = Obj.magic _6 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 24426 "parsing/parser.ml"
+# 24948 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -24431,40 +24953,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.class_type_declaration list) = let x =
-          let attrs2 =
-            let _1 = _1_inlined3 in
-            
-# 4058 "parsing/parser.mly"
+        let _v =
+          let x =
+            let attrs2 =
+              let _1 = _1_inlined3 in
+              
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 24441 "parsing/parser.ml"
-            
-          in
-          let _endpos_attrs2_ = _endpos__1_inlined3_ in
-          let id =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 24964 "parsing/parser.ml"
+              
+            in
+            let _endpos_attrs2_ = _endpos__1_inlined3_ in
+            let id =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 24453 "parsing/parser.ml"
-            
-          in
-          let attrs1 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+# 24976 "parsing/parser.ml"
+              
+            in
+            let attrs1 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 24461 "parsing/parser.ml"
+# 24984 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos_attrs2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos = _endpos_attrs2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2274 "parsing/parser.mly"
+# 2296 "parsing/parser.mly"
     (
       let attrs = attrs1 @ attrs2 in
       let loc = make_loc _sloc in
@@ -24472,14 +24995,15 @@ module Tables = struct
       let text = symbol_text _symbolstartpos in
       Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs
     )
-# 24476 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 24999 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 24482 "parsing/parser.ml"
-         in
+# 25005 "parsing/parser.ml"
+           : (Parsetree.class_type_declaration list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -24494,9 +25018,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.module_binding list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 24500 "parsing/parser.ml"
+# 25024 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -24553,40 +25077,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.module_binding list) = let x =
-          let attrs2 =
-            let _1 = _1_inlined3 in
-            
-# 4058 "parsing/parser.mly"
+        let _v =
+          let x =
+            let attrs2 =
+              let _1 = _1_inlined3 in
+              
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 24563 "parsing/parser.ml"
-            
-          in
-          let _endpos_attrs2_ = _endpos__1_inlined3_ in
-          let name =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 25088 "parsing/parser.ml"
+              
+            in
+            let _endpos_attrs2_ = _endpos__1_inlined3_ in
+            let name =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 24575 "parsing/parser.ml"
-            
-          in
-          let attrs1 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+# 25100 "parsing/parser.ml"
+              
+            in
+            let attrs1 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 24583 "parsing/parser.ml"
+# 25108 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos_attrs2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos = _endpos_attrs2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1600 "parsing/parser.mly"
+# 1624 "parsing/parser.mly"
   (
     let loc = make_loc _sloc in
     let attrs = attrs1 @ attrs2 in
@@ -24594,14 +25119,15 @@ module Tables = struct
     let text = symbol_text _symbolstartpos in
     Mb.mk name body ~attrs ~loc ~text ~docs
   )
-# 24598 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 25123 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 24604 "parsing/parser.ml"
-         in
+# 25129 "parsing/parser.ml"
+           : (Parsetree.module_binding list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -24616,9 +25142,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.module_declaration list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 24622 "parsing/parser.ml"
+# 25148 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -24682,40 +25208,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.module_declaration list) = let x =
-          let attrs2 =
-            let _1 = _1_inlined3 in
-            
-# 4058 "parsing/parser.mly"
+        let _v =
+          let x =
+            let attrs2 =
+              let _1 = _1_inlined3 in
+              
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 24692 "parsing/parser.ml"
-            
-          in
-          let _endpos_attrs2_ = _endpos__1_inlined3_ in
-          let name =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 25219 "parsing/parser.ml"
+              
+            in
+            let _endpos_attrs2_ = _endpos__1_inlined3_ in
+            let name =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 24704 "parsing/parser.ml"
-            
-          in
-          let attrs1 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+# 25231 "parsing/parser.ml"
+              
+            in
+            let attrs1 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 24712 "parsing/parser.ml"
+# 25239 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos_attrs2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos = _endpos_attrs2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1885 "parsing/parser.mly"
+# 1907 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let docs = symbol_docs _sloc in
@@ -24723,14 +25250,15 @@ module Tables = struct
     let text = symbol_text _symbolstartpos in
     Md.mk name mty ~attrs ~loc ~text ~docs
   )
-# 24727 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 25254 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 24733 "parsing/parser.ml"
-         in
+# 25260 "parsing/parser.ml"
+           : (Parsetree.module_declaration list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -24745,9 +25273,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.attributes) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 24751 "parsing/parser.ml"
+# 25279 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -24777,9 +25305,9 @@ module Tables = struct
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_xs_ in
         let _v : (Parsetree.attributes) = 
-# 213 "<standard.mly>"
+# 219 "<standard.mly>"
     ( x :: xs )
-# 24783 "parsing/parser.ml"
+# 25311 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -24795,9 +25323,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.type_declaration list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 24801 "parsing/parser.ml"
+# 25329 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -24862,9 +25390,9 @@ module Tables = struct
         let xs_inlined1 : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs_inlined1 in
         let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 24868 "parsing/parser.ml"
+# 25396 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -24872,60 +25400,61 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.type_declaration list) = let x =
-          let xs = xs_inlined1 in
-          let attrs2 =
-            let _1 = _1_inlined3 in
-            
-# 4058 "parsing/parser.mly"
+        let _v =
+          let x =
+            let xs = xs_inlined1 in
+            let attrs2 =
+              let _1 = _1_inlined3 in
+              
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 24883 "parsing/parser.ml"
-            
-          in
-          let _endpos_attrs2_ = _endpos__1_inlined3_ in
-          let cstrs =
-            let _1 =
-              let xs = 
-# 253 "<standard.mly>"
-    ( List.rev xs )
-# 24892 "parsing/parser.ml"
-               in
+# 25412 "parsing/parser.ml"
               
-# 1044 "parsing/parser.mly"
+            in
+            let _endpos_attrs2_ = _endpos__1_inlined3_ in
+            let cstrs =
+              let _1 =
+                let xs = 
+# 264 "<standard.mly>"
+    ( List.rev xs )
+# 25421 "parsing/parser.ml"
+                 in
+                
+# 1068 "parsing/parser.mly"
     ( xs )
-# 24897 "parsing/parser.ml"
+# 25426 "parsing/parser.ml"
+                
+              in
+              
+# 3183 "parsing/parser.mly"
+    ( _1 )
+# 25432 "parsing/parser.ml"
               
             in
-            
-# 3138 "parsing/parser.mly"
+            let id =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 25443 "parsing/parser.ml"
+              
+            in
+            let attrs1 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 24903 "parsing/parser.ml"
-            
-          in
-          let id =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-            let _endpos = _endpos__1_ in
+# 25451 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos_attrs2_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 24914 "parsing/parser.ml"
-            
-          in
-          let attrs1 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
-    ( _1 )
-# 24922 "parsing/parser.ml"
-            
-          in
-          let _endpos = _endpos_attrs2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3127 "parsing/parser.mly"
+# 3172 "parsing/parser.mly"
     (
       let (kind, priv, manifest) = kind_priv_manifest in
       let docs = symbol_docs _sloc in
@@ -24934,14 +25463,15 @@ module Tables = struct
       let text = symbol_text _symbolstartpos in
       Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
     )
-# 24938 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 25467 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 24944 "parsing/parser.ml"
-         in
+# 25473 "parsing/parser.ml"
+           : (Parsetree.type_declaration list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -24956,9 +25486,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.type_declaration list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 24962 "parsing/parser.ml"
+# 25492 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -25030,9 +25560,9 @@ module Tables = struct
         let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
         let _1_inlined3 : unit = Obj.magic _1_inlined3 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 25036 "parsing/parser.ml"
+# 25566 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -25040,65 +25570,66 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.type_declaration list) = let x =
-          let xs = xs_inlined1 in
-          let attrs2 =
-            let _1 = _1_inlined4 in
-            
-# 4058 "parsing/parser.mly"
+        let _v =
+          let x =
+            let xs = xs_inlined1 in
+            let attrs2 =
+              let _1 = _1_inlined4 in
+              
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 25051 "parsing/parser.ml"
-            
-          in
-          let _endpos_attrs2_ = _endpos__1_inlined4_ in
-          let cstrs =
-            let _1 =
-              let xs = 
-# 253 "<standard.mly>"
-    ( List.rev xs )
-# 25060 "parsing/parser.ml"
-               in
+# 25582 "parsing/parser.ml"
               
-# 1044 "parsing/parser.mly"
+            in
+            let _endpos_attrs2_ = _endpos__1_inlined4_ in
+            let cstrs =
+              let _1 =
+                let xs = 
+# 264 "<standard.mly>"
+    ( List.rev xs )
+# 25591 "parsing/parser.ml"
+                 in
+                
+# 1068 "parsing/parser.mly"
     ( xs )
-# 25065 "parsing/parser.ml"
+# 25596 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 3138 "parsing/parser.mly"
+# 3183 "parsing/parser.mly"
     ( _1 )
-# 25071 "parsing/parser.ml"
-            
-          in
-          let kind_priv_manifest = 
-# 3173 "parsing/parser.mly"
+# 25602 "parsing/parser.ml"
+              
+            in
+            let kind_priv_manifest = 
+# 3218 "parsing/parser.mly"
       ( _2 )
-# 25077 "parsing/parser.ml"
-           in
-          let id =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 25608 "parsing/parser.ml"
+             in
+            let id =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 25087 "parsing/parser.ml"
-            
-          in
-          let attrs1 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+# 25618 "parsing/parser.ml"
+              
+            in
+            let attrs1 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 25095 "parsing/parser.ml"
+# 25626 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos_attrs2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos = _endpos_attrs2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3127 "parsing/parser.mly"
+# 3172 "parsing/parser.mly"
     (
       let (kind, priv, manifest) = kind_priv_manifest in
       let docs = symbol_docs _sloc in
@@ -25107,14 +25638,15 @@ module Tables = struct
       let text = symbol_text _symbolstartpos in
       Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
     )
-# 25111 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 25642 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25117 "parsing/parser.ml"
-         in
+# 25648 "parsing/parser.ml"
+           : (Parsetree.type_declaration list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -25129,9 +25661,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.attributes) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 25135 "parsing/parser.ml"
+# 25667 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -25161,9 +25693,9 @@ module Tables = struct
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_xs_ in
         let _v : (Parsetree.attributes) = 
-# 213 "<standard.mly>"
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25167 "parsing/parser.ml"
+# 25699 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -25179,9 +25711,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.signature_item list list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 25185 "parsing/parser.ml"
+# 25717 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -25210,26 +25742,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.signature_item list list) = let x =
-          let _1 =
-            let _startpos = _startpos__1_ in
-            
-# 970 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _1 =
+              let _startpos = _startpos__1_ in
+              
+# 994 "parsing/parser.mly"
   ( text_sig _startpos )
-# 25220 "parsing/parser.ml"
+# 25753 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 1742 "parsing/parser.mly"
+# 1764 "parsing/parser.mly"
       ( _1 )
-# 25226 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 25759 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25232 "parsing/parser.ml"
-         in
+# 25765 "parsing/parser.ml"
+           : (Parsetree.signature_item list list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -25257,26 +25791,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.signature_item list list) = let x =
-          let _1 =
-            let _startpos = _startpos__1_ in
-            
-# 968 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _1 =
+              let _startpos = _startpos__1_ in
+              
+# 992 "parsing/parser.mly"
   ( text_sig _startpos @ [_1] )
-# 25267 "parsing/parser.ml"
+# 25802 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 1742 "parsing/parser.mly"
+# 1764 "parsing/parser.mly"
       ( _1 )
-# 25273 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 25808 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25279 "parsing/parser.ml"
-         in
+# 25814 "parsing/parser.ml"
+           : (Parsetree.signature_item list list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -25291,9 +25827,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.structure_item list list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 25297 "parsing/parser.ml"
+# 25833 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -25322,45 +25858,47 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.structure_item list list) = let x =
-          let _1 =
-            let ys =
-              let items = 
-# 1030 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _1 =
+              let ys =
+                let items = 
+# 1054 "parsing/parser.mly"
     ( [] )
-# 25332 "parsing/parser.ml"
-               in
-              
-# 1481 "parsing/parser.mly"
+# 25869 "parsing/parser.ml"
+                 in
+                
+# 1505 "parsing/parser.mly"
     ( items )
-# 25337 "parsing/parser.ml"
-              
-            in
-            let xs =
-              let _startpos = _startpos__1_ in
-              
-# 966 "parsing/parser.mly"
+# 25874 "parsing/parser.ml"
+                
+              in
+              let xs =
+                let _startpos = _startpos__1_ in
+                
+# 990 "parsing/parser.mly"
   ( text_str _startpos )
-# 25345 "parsing/parser.ml"
+# 25882 "parsing/parser.ml"
+                
+              in
+              
+# 278 "<standard.mly>"
+    ( xs @ ys )
+# 25888 "parsing/parser.ml"
               
             in
             
-# 267 "<standard.mly>"
-    ( xs @ ys )
-# 25351 "parsing/parser.ml"
+# 1521 "parsing/parser.mly"
+      ( _1 )
+# 25894 "parsing/parser.ml"
             
           in
-          
-# 1497 "parsing/parser.mly"
-      ( _1 )
-# 25357 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25363 "parsing/parser.ml"
-         in
+# 25900 "parsing/parser.ml"
+           : (Parsetree.structure_item list list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -25402,79 +25940,148 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.structure_item list list) = let x =
-          let _1 =
-            let ys =
-              let (_endpos__1_, _1) = (_endpos__1_inlined1_, _1_inlined1) in
-              let items =
-                let x =
-                  let _1 =
+        let _v =
+          let x =
+            let _1 =
+              let ys =
+                let (_endpos__1_, _1) = (_endpos__1_inlined1_, _1_inlined1) in
+                let items =
+                  let x =
                     let _1 =
-                      let attrs = 
-# 4058 "parsing/parser.mly"
-    ( _1 )
-# 25417 "parsing/parser.ml"
-                       in
-                      
-# 1488 "parsing/parser.mly"
+                      let _1 =
+                        let attrs = 
+# 4110 "parsing/parser.mly"
+    ( _1 )
+# 25956 "parsing/parser.ml"
+                         in
+                        
+# 1512 "parsing/parser.mly"
     ( mkstrexp e attrs )
-# 25422 "parsing/parser.ml"
+# 25961 "parsing/parser.ml"
+                        
+                      in
+                      let _startpos__1_ = _startpos_e_ in
+                      let _startpos = _startpos__1_ in
+                      
+# 988 "parsing/parser.mly"
+  ( text_str _startpos @ [_1] )
+# 25969 "parsing/parser.ml"
                       
                     in
                     let _startpos__1_ = _startpos_e_ in
+                    let _endpos = _endpos__1_ in
                     let _startpos = _startpos__1_ in
                     
-# 964 "parsing/parser.mly"
-  ( text_str _startpos @ [_1] )
-# 25430 "parsing/parser.ml"
+# 1007 "parsing/parser.mly"
+  ( mark_rhs_docs _startpos _endpos;
+    _1 )
+# 25979 "parsing/parser.ml"
                     
                   in
-                  let _startpos__1_ = _startpos_e_ in
-                  let _endpos = _endpos__1_ in
-                  let _startpos = _startpos__1_ in
                   
-# 983 "parsing/parser.mly"
-  ( mark_rhs_docs _startpos _endpos;
-    _1 )
-# 25440 "parsing/parser.ml"
+# 1056 "parsing/parser.mly"
+    ( x )
+# 25985 "parsing/parser.ml"
                   
                 in
                 
-# 1032 "parsing/parser.mly"
-    ( x )
-# 25446 "parsing/parser.ml"
+# 1505 "parsing/parser.mly"
+    ( items )
+# 25991 "parsing/parser.ml"
+                
+              in
+              let xs =
+                let _startpos = _startpos__1_ in
+                
+# 990 "parsing/parser.mly"
+  ( text_str _startpos )
+# 25999 "parsing/parser.ml"
                 
               in
               
-# 1481 "parsing/parser.mly"
-    ( items )
-# 25452 "parsing/parser.ml"
+# 278 "<standard.mly>"
+    ( xs @ ys )
+# 26005 "parsing/parser.ml"
               
             in
-            let xs =
+            
+# 1521 "parsing/parser.mly"
+      ( _1 )
+# 26011 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
+    ( x :: xs )
+# 26017 "parsing/parser.ml"
+           : (Parsetree.structure_item list list))
+        in
+        {
+          MenhirLib.EngineTypes.state = _menhir_s;
+          MenhirLib.EngineTypes.semv = Obj.repr _v;
+          MenhirLib.EngineTypes.startp = _startpos;
+          MenhirLib.EngineTypes.endp = _endpos;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        });
+      (fun _menhir_env ->
+        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+        let {
+          MenhirLib.EngineTypes.state = _;
+          MenhirLib.EngineTypes.semv = xs;
+          MenhirLib.EngineTypes.startp = _startpos_xs_;
+          MenhirLib.EngineTypes.endp = _endpos_xs_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let xs : (Parsetree.structure_item list list) = Obj.magic xs in
+        let _1 : (Parsetree.structure_item) = Obj.magic _1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos__1_ in
+        let _endpos = _endpos_xs_ in
+        let _v =
+          let x =
+            let _1 =
               let _startpos = _startpos__1_ in
               
-# 966 "parsing/parser.mly"
-  ( text_str _startpos )
-# 25460 "parsing/parser.ml"
+# 988 "parsing/parser.mly"
+  ( text_str _startpos @ [_1] )
+# 26054 "parsing/parser.ml"
               
             in
             
-# 267 "<standard.mly>"
-    ( xs @ ys )
-# 25466 "parsing/parser.ml"
+# 1521 "parsing/parser.mly"
+      ( _1 )
+# 26060 "parsing/parser.ml"
             
           in
-          
-# 1497 "parsing/parser.mly"
-      ( _1 )
-# 25472 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25478 "parsing/parser.ml"
+# 26066 "parsing/parser.ml"
+           : (Parsetree.structure_item list list))
+        in
+        {
+          MenhirLib.EngineTypes.state = _menhir_s;
+          MenhirLib.EngineTypes.semv = Obj.repr _v;
+          MenhirLib.EngineTypes.startp = _startpos;
+          MenhirLib.EngineTypes.endp = _endpos;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        });
+      (fun _menhir_env ->
+        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+        let _menhir_s = _menhir_env.MenhirLib.EngineTypes.current in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _endpos = _startpos in
+        let _v : (Parsetree.class_type_field list list) = 
+# 216 "<standard.mly>"
+    ( [] )
+# 26085 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -25498,89 +26105,26 @@ module Tables = struct
             MenhirLib.EngineTypes.next = _menhir_stack;
           };
         } = _menhir_stack in
-        let xs : (Parsetree.structure_item list list) = Obj.magic xs in
-        let _1 : (Parsetree.structure_item) = Obj.magic _1 in
+        let xs : (Parsetree.class_type_field list list) = Obj.magic xs in
+        let _1 : (Parsetree.class_type_field) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.structure_item list list) = let x =
-          let _1 =
+        let _v =
+          let x =
             let _startpos = _startpos__1_ in
             
-# 964 "parsing/parser.mly"
-  ( text_str _startpos @ [_1] )
-# 25513 "parsing/parser.ml"
+# 1002 "parsing/parser.mly"
+  ( text_csig _startpos @ [_1] )
+# 26120 "parsing/parser.ml"
             
           in
-          
-# 1497 "parsing/parser.mly"
-      ( _1 )
-# 25519 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25525 "parsing/parser.ml"
-         in
-        {
-          MenhirLib.EngineTypes.state = _menhir_s;
-          MenhirLib.EngineTypes.semv = Obj.repr _v;
-          MenhirLib.EngineTypes.startp = _startpos;
-          MenhirLib.EngineTypes.endp = _endpos;
-          MenhirLib.EngineTypes.next = _menhir_stack;
-        });
-      (fun _menhir_env ->
-        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
-        let _menhir_s = _menhir_env.MenhirLib.EngineTypes.current in
-        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
-        let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
-        let _endpos = _startpos in
-        let _v : (Parsetree.class_type_field list list) = 
-# 211 "<standard.mly>"
-    ( [] )
-# 25543 "parsing/parser.ml"
-         in
-        {
-          MenhirLib.EngineTypes.state = _menhir_s;
-          MenhirLib.EngineTypes.semv = Obj.repr _v;
-          MenhirLib.EngineTypes.startp = _startpos;
-          MenhirLib.EngineTypes.endp = _endpos;
-          MenhirLib.EngineTypes.next = _menhir_stack;
-        });
-      (fun _menhir_env ->
-        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
-        let {
-          MenhirLib.EngineTypes.state = _;
-          MenhirLib.EngineTypes.semv = xs;
-          MenhirLib.EngineTypes.startp = _startpos_xs_;
-          MenhirLib.EngineTypes.endp = _endpos_xs_;
-          MenhirLib.EngineTypes.next = {
-            MenhirLib.EngineTypes.state = _menhir_s;
-            MenhirLib.EngineTypes.semv = _1;
-            MenhirLib.EngineTypes.startp = _startpos__1_;
-            MenhirLib.EngineTypes.endp = _endpos__1_;
-            MenhirLib.EngineTypes.next = _menhir_stack;
-          };
-        } = _menhir_stack in
-        let xs : (Parsetree.class_type_field list list) = Obj.magic xs in
-        let _1 : (Parsetree.class_type_field) = Obj.magic _1 in
-        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
-        let _startpos = _startpos__1_ in
-        let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.class_type_field list list) = let x =
-          let _startpos = _startpos__1_ in
-          
-# 978 "parsing/parser.mly"
-  ( text_csig _startpos @ [_1] )
-# 25577 "parsing/parser.ml"
-          
+# 26126 "parsing/parser.ml"
+           : (Parsetree.class_type_field list list))
         in
-        
-# 213 "<standard.mly>"
-    ( x :: xs )
-# 25583 "parsing/parser.ml"
-         in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -25595,9 +26139,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.class_field list list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 25601 "parsing/parser.ml"
+# 26145 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -25626,19 +26170,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.class_field list list) = let x =
-          let _startpos = _startpos__1_ in
-          
-# 976 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _startpos = _startpos__1_ in
+            
+# 1000 "parsing/parser.mly"
   ( text_cstr _startpos @ [_1] )
-# 25635 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 26180 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25641 "parsing/parser.ml"
-         in
+# 26186 "parsing/parser.ml"
+           : (Parsetree.class_field list list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -25653,9 +26199,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.structure_item list list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 25659 "parsing/parser.ml"
+# 26205 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -25684,19 +26230,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.structure_item list list) = let x =
-          let _startpos = _startpos__1_ in
-          
-# 964 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _startpos = _startpos__1_ in
+            
+# 988 "parsing/parser.mly"
   ( text_str _startpos @ [_1] )
-# 25693 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 26240 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25699 "parsing/parser.ml"
-         in
+# 26246 "parsing/parser.ml"
+           : (Parsetree.structure_item list list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -25711,9 +26259,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.toplevel_phrase list list) = 
-# 211 "<standard.mly>"
+# 216 "<standard.mly>"
     ( [] )
-# 25717 "parsing/parser.ml"
+# 26265 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -25742,37 +26290,39 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.toplevel_phrase list list) = let x =
-          let _1 =
-            let x =
-              let _1 = 
-# 1030 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _1 =
+              let x =
+                let _1 = 
+# 1054 "parsing/parser.mly"
     ( [] )
-# 25752 "parsing/parser.ml"
-               in
-              
-# 1283 "parsing/parser.mly"
+# 26301 "parsing/parser.ml"
+                 in
+                
+# 1307 "parsing/parser.mly"
     ( _1 )
-# 25757 "parsing/parser.ml"
+# 26306 "parsing/parser.ml"
+                
+              in
+              
+# 188 "<standard.mly>"
+    ( x )
+# 26312 "parsing/parser.ml"
               
             in
             
-# 183 "<standard.mly>"
-    ( x )
-# 25763 "parsing/parser.ml"
+# 1319 "parsing/parser.mly"
+      ( _1 )
+# 26318 "parsing/parser.ml"
             
           in
-          
-# 1295 "parsing/parser.mly"
-      ( _1 )
-# 25769 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25775 "parsing/parser.ml"
-         in
+# 26324 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase list list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -25814,68 +26364,70 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.toplevel_phrase list list) = let x =
-          let _1 =
-            let x =
-              let _1 = _1_inlined1 in
-              let _1 =
-                let x =
-                  let _1 =
+        let _v =
+          let x =
+            let _1 =
+              let x =
+                let _1 = _1_inlined1 in
+                let _1 =
+                  let x =
                     let _1 =
-                      let attrs = 
-# 4058 "parsing/parser.mly"
-    ( _1 )
-# 25829 "parsing/parser.ml"
-                       in
-                      
-# 1488 "parsing/parser.mly"
+                      let _1 =
+                        let attrs = 
+# 4110 "parsing/parser.mly"
+    ( _1 )
+# 26380 "parsing/parser.ml"
+                         in
+                        
+# 1512 "parsing/parser.mly"
     ( mkstrexp e attrs )
-# 25834 "parsing/parser.ml"
+# 26385 "parsing/parser.ml"
+                        
+                      in
+                      
+# 998 "parsing/parser.mly"
+  ( Ptop_def [_1] )
+# 26391 "parsing/parser.ml"
                       
                     in
+                    let _startpos__1_ = _startpos_e_ in
+                    let _startpos = _startpos__1_ in
                     
-# 974 "parsing/parser.mly"
-  ( Ptop_def [_1] )
-# 25840 "parsing/parser.ml"
+# 996 "parsing/parser.mly"
+  ( text_def _startpos @ [_1] )
+# 26399 "parsing/parser.ml"
                     
                   in
-                  let _startpos__1_ = _startpos_e_ in
-                  let _startpos = _startpos__1_ in
                   
-# 972 "parsing/parser.mly"
-  ( text_def _startpos @ [_1] )
-# 25848 "parsing/parser.ml"
+# 1056 "parsing/parser.mly"
+    ( x )
+# 26405 "parsing/parser.ml"
                   
                 in
                 
-# 1032 "parsing/parser.mly"
-    ( x )
-# 25854 "parsing/parser.ml"
+# 1307 "parsing/parser.mly"
+    ( _1 )
+# 26411 "parsing/parser.ml"
                 
               in
               
-# 1283 "parsing/parser.mly"
-    ( _1 )
-# 25860 "parsing/parser.ml"
+# 188 "<standard.mly>"
+    ( x )
+# 26417 "parsing/parser.ml"
               
             in
             
-# 183 "<standard.mly>"
-    ( x )
-# 25866 "parsing/parser.ml"
+# 1319 "parsing/parser.mly"
+      ( _1 )
+# 26423 "parsing/parser.ml"
             
           in
-          
-# 1295 "parsing/parser.mly"
-      ( _1 )
-# 25872 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25878 "parsing/parser.ml"
-         in
+# 26429 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase list list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -25903,31 +26455,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.toplevel_phrase list list) = let x =
-          let _1 =
-            let _1 = 
-# 974 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _1 =
+              let _1 = 
+# 998 "parsing/parser.mly"
   ( Ptop_def [_1] )
-# 25912 "parsing/parser.ml"
-             in
-            let _startpos = _startpos__1_ in
-            
-# 972 "parsing/parser.mly"
+# 26465 "parsing/parser.ml"
+               in
+              let _startpos = _startpos__1_ in
+              
+# 996 "parsing/parser.mly"
   ( text_def _startpos @ [_1] )
-# 25918 "parsing/parser.ml"
+# 26471 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 1295 "parsing/parser.mly"
+# 1319 "parsing/parser.mly"
       ( _1 )
-# 25924 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+# 26477 "parsing/parser.ml"
+            
+          in
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25930 "parsing/parser.ml"
-         in
+# 26483 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase list list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -25955,36 +26509,38 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.toplevel_phrase list list) = let x =
-          let _1 =
+        let _v =
+          let x =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _startpos = _startpos__1_ in
-              
-# 983 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _startpos = _startpos__1_ in
+                
+# 1007 "parsing/parser.mly"
   ( mark_rhs_docs _startpos _endpos;
     _1 )
-# 25968 "parsing/parser.ml"
+# 26523 "parsing/parser.ml"
+                
+              in
+              let _startpos = _startpos__1_ in
+              
+# 996 "parsing/parser.mly"
+  ( text_def _startpos @ [_1] )
+# 26530 "parsing/parser.ml"
               
             in
-            let _startpos = _startpos__1_ in
             
-# 972 "parsing/parser.mly"
-  ( text_def _startpos @ [_1] )
-# 25975 "parsing/parser.ml"
+# 1319 "parsing/parser.mly"
+      ( _1 )
+# 26536 "parsing/parser.ml"
             
           in
-          
-# 1295 "parsing/parser.mly"
-      ( _1 )
-# 25981 "parsing/parser.ml"
-          
-        in
-        
-# 213 "<standard.mly>"
+          (
+# 219 "<standard.mly>"
     ( x :: xs )
-# 25987 "parsing/parser.ml"
-         in
+# 26542 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase list list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26019,28 +26575,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_opat_ in
-        let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 = 
-# 124 "<standard.mly>"
+        let _v =
+          let _2 = 
+# 123 "<standard.mly>"
     ( None )
-# 26026 "parsing/parser.ml"
-         in
-        let x =
-          let label =
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 26583 "parsing/parser.ml"
+           in
+          let x =
+            let label =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 26036 "parsing/parser.ml"
+# 26593 "parsing/parser.ml"
+              
+            in
+            let _startpos_label_ = _startpos__1_ in
+            let _endpos = _endpos_opat_ in
+            let _symbolstartpos = _startpos_label_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _startpos_label_ = _startpos__1_ in
-          let _endpos = _endpos_opat_ in
-          let _symbolstartpos = _startpos_label_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3013 "parsing/parser.mly"
+# 3058 "parsing/parser.mly"
     ( let constraint_loc, label, pat =
         match opat with
         | None ->
@@ -26054,14 +26611,15 @@ module Tables = struct
       in
       label, mkpat_opt_constraint ~loc:constraint_loc pat octy
     )
-# 26058 "parsing/parser.ml"
-          
-        in
-        
-# 1220 "parsing/parser.mly"
+# 26615 "parsing/parser.ml"
+            
+          in
+          (
+# 1244 "parsing/parser.mly"
     ( [x], None )
-# 26064 "parsing/parser.ml"
-         in
+# 26621 "parsing/parser.ml"
+           : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26103,28 +26661,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_x_ in
-        let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 = 
+        let _v =
+          let _2 = 
 # 126 "<standard.mly>"
     ( Some x )
-# 26110 "parsing/parser.ml"
-         in
-        let x =
-          let label =
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 26669 "parsing/parser.ml"
+           in
+          let x =
+            let label =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 26120 "parsing/parser.ml"
+# 26679 "parsing/parser.ml"
+              
+            in
+            let _startpos_label_ = _startpos__1_ in
+            let _endpos = _endpos_opat_ in
+            let _symbolstartpos = _startpos_label_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _startpos_label_ = _startpos__1_ in
-          let _endpos = _endpos_opat_ in
-          let _symbolstartpos = _startpos_label_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3013 "parsing/parser.mly"
+# 3058 "parsing/parser.mly"
     ( let constraint_loc, label, pat =
         match opat with
         | None ->
@@ -26138,14 +26697,15 @@ module Tables = struct
       in
       label, mkpat_opt_constraint ~loc:constraint_loc pat octy
     )
-# 26142 "parsing/parser.ml"
-          
-        in
-        
-# 1220 "parsing/parser.mly"
+# 26701 "parsing/parser.ml"
+            
+          in
+          (
+# 1244 "parsing/parser.mly"
     ( [x], None )
-# 26148 "parsing/parser.ml"
-         in
+# 26707 "parsing/parser.ml"
+           : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26201,23 +26761,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let x =
-          let label =
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+        let _v =
+          let x =
+            let label =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 26213 "parsing/parser.ml"
+# 26774 "parsing/parser.ml"
+              
+            in
+            let _startpos_label_ = _startpos__1_ in
+            let _endpos = _endpos_opat_ in
+            let _symbolstartpos = _startpos_label_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _startpos_label_ = _startpos__1_ in
-          let _endpos = _endpos_opat_ in
-          let _symbolstartpos = _startpos_label_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3013 "parsing/parser.mly"
+# 3058 "parsing/parser.mly"
     ( let constraint_loc, label, pat =
         match opat with
         | None ->
@@ -26231,14 +26792,15 @@ module Tables = struct
       in
       label, mkpat_opt_constraint ~loc:constraint_loc pat octy
     )
-# 26235 "parsing/parser.ml"
-          
-        in
-        
-# 1222 "parsing/parser.mly"
+# 26796 "parsing/parser.ml"
+            
+          in
+          (
+# 1246 "parsing/parser.mly"
     ( [x], Some y )
-# 26241 "parsing/parser.ml"
-         in
+# 26802 "parsing/parser.ml"
+           : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26287,23 +26849,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_tail_ in
-        let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let x =
-          let label =
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+        let _v =
+          let x =
+            let label =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 26299 "parsing/parser.ml"
+# 26862 "parsing/parser.ml"
+              
+            in
+            let _startpos_label_ = _startpos__1_ in
+            let _endpos = _endpos_opat_ in
+            let _symbolstartpos = _startpos_label_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _startpos_label_ = _startpos__1_ in
-          let _endpos = _endpos_opat_ in
-          let _symbolstartpos = _startpos_label_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3013 "parsing/parser.mly"
+# 3058 "parsing/parser.mly"
     ( let constraint_loc, label, pat =
         match opat with
         | None ->
@@ -26317,15 +26880,16 @@ module Tables = struct
       in
       label, mkpat_opt_constraint ~loc:constraint_loc pat octy
     )
-# 26321 "parsing/parser.ml"
-          
-        in
-        
-# 1226 "parsing/parser.mly"
+# 26884 "parsing/parser.ml"
+            
+          in
+          (
+# 1250 "parsing/parser.mly"
     ( let xs, y = tail in
       x :: xs, y )
-# 26328 "parsing/parser.ml"
-         in
+# 26891 "parsing/parser.ml"
+           : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26361,9 +26925,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.case) = 
-# 2760 "parsing/parser.mly"
+# 2802 "parsing/parser.mly"
       ( Exp.case _1 _3 )
-# 26367 "parsing/parser.ml"
+# 26931 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -26414,9 +26978,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
         let _v : (Parsetree.case) = 
-# 2762 "parsing/parser.mly"
+# 2804 "parsing/parser.mly"
       ( Exp.case _1 ~guard:_3 _5 )
-# 26420 "parsing/parser.ml"
+# 26984 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -26452,12 +27016,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.case) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        
-# 2764 "parsing/parser.mly"
+        let _v =
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          (
+# 2806 "parsing/parser.mly"
       ( Exp.case _1 (Exp.unreachable ~loc:(make_loc _loc__3_) ()) )
-# 26460 "parsing/parser.ml"
-         in
+# 27025 "parsing/parser.ml"
+           : (Parsetree.case))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26517,60 +27083,61 @@ module Tables = struct
         let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 26523 "parsing/parser.ml"
+# 27089 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_tail_ in
-        let _v : (Parsetree.object_field list * Asttypes.closed_flag) = let head =
-          let _6 =
-            let _1 = _1_inlined3 in
-            
-# 4062 "parsing/parser.mly"
+        let _v =
+          let head =
+            let _6 =
+              let _1 = _1_inlined3 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 26534 "parsing/parser.ml"
-            
-          in
-          let _endpos__6_ = _endpos__1_inlined3_ in
-          let _4 =
-            let _1 = _1_inlined2 in
-            
-# 4062 "parsing/parser.mly"
+# 27101 "parsing/parser.ml"
+              
+            in
+            let _endpos__6_ = _endpos__1_inlined3_ in
+            let _4 =
+              let _1 = _1_inlined2 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 26543 "parsing/parser.ml"
-            
-          in
-          let _endpos__4_ = _endpos__1_inlined2_ in
-          let _3 =
-            let _1 = _1_inlined1 in
-            
-# 3439 "parsing/parser.mly"
+# 27110 "parsing/parser.ml"
+              
+            in
+            let _endpos__4_ = _endpos__1_inlined2_ in
+            let _3 =
+              let _1 = _1_inlined1 in
+              
+# 3484 "parsing/parser.mly"
     ( _1 )
-# 26552 "parsing/parser.ml"
-            
-          in
-          let _1 =
-            let _1 = 
-# 3720 "parsing/parser.mly"
+# 27119 "parsing/parser.ml"
+              
+            in
+            let _1 =
+              let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 26559 "parsing/parser.ml"
-             in
-            let _endpos = _endpos__1_ in
+# 27126 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 27134 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos__6_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 26567 "parsing/parser.ml"
-            
-          in
-          let _endpos = _endpos__6_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3705 "parsing/parser.mly"
+# 3750 "parsing/parser.mly"
     ( let info =
         match rhs_info _endpos__4_ with
         | Some _ as info_before_semi -> info_before_semi
@@ -26578,14 +27145,15 @@ module Tables = struct
       in
       let attrs = add_info_attrs info (_4 @ _6) in
       Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 26582 "parsing/parser.ml"
-          
-        in
-        
-# 3686 "parsing/parser.mly"
+# 27149 "parsing/parser.ml"
+            
+          in
+          (
+# 3731 "parsing/parser.mly"
       ( let (f, c) = tail in (head :: f, c) )
-# 26588 "parsing/parser.ml"
-         in
+# 27155 "parsing/parser.ml"
+           : (Parsetree.object_field list * Asttypes.closed_flag))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26620,21 +27188,23 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_ty_ in
         let _endpos = _endpos_tail_ in
-        let _v : (Parsetree.object_field list * Asttypes.closed_flag) = let head =
-          let _endpos = _endpos_ty_ in
-          let _symbolstartpos = _startpos_ty_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3716 "parsing/parser.mly"
+        let _v =
+          let head =
+            let _endpos = _endpos_ty_ in
+            let _symbolstartpos = _startpos_ty_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 3761 "parsing/parser.mly"
     ( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 26631 "parsing/parser.ml"
-          
-        in
-        
-# 3686 "parsing/parser.mly"
+# 27200 "parsing/parser.ml"
+            
+          in
+          (
+# 3731 "parsing/parser.mly"
       ( let (f, c) = tail in (head :: f, c) )
-# 26637 "parsing/parser.ml"
-         in
+# 27206 "parsing/parser.ml"
+           : (Parsetree.object_field list * Asttypes.closed_flag))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26687,60 +27257,61 @@ module Tables = struct
         let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 26693 "parsing/parser.ml"
+# 27263 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.object_field list * Asttypes.closed_flag) = let head =
-          let _6 =
-            let _1 = _1_inlined3 in
-            
-# 4062 "parsing/parser.mly"
+        let _v =
+          let head =
+            let _6 =
+              let _1 = _1_inlined3 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 26704 "parsing/parser.ml"
-            
-          in
-          let _endpos__6_ = _endpos__1_inlined3_ in
-          let _4 =
-            let _1 = _1_inlined2 in
-            
-# 4062 "parsing/parser.mly"
+# 27275 "parsing/parser.ml"
+              
+            in
+            let _endpos__6_ = _endpos__1_inlined3_ in
+            let _4 =
+              let _1 = _1_inlined2 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 26713 "parsing/parser.ml"
-            
-          in
-          let _endpos__4_ = _endpos__1_inlined2_ in
-          let _3 =
-            let _1 = _1_inlined1 in
-            
-# 3439 "parsing/parser.mly"
+# 27284 "parsing/parser.ml"
+              
+            in
+            let _endpos__4_ = _endpos__1_inlined2_ in
+            let _3 =
+              let _1 = _1_inlined1 in
+              
+# 3484 "parsing/parser.mly"
     ( _1 )
-# 26722 "parsing/parser.ml"
-            
-          in
-          let _1 =
-            let _1 = 
-# 3720 "parsing/parser.mly"
+# 27293 "parsing/parser.ml"
+              
+            in
+            let _1 =
+              let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 26729 "parsing/parser.ml"
-             in
-            let _endpos = _endpos__1_ in
+# 27300 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 27308 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos__6_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 26737 "parsing/parser.ml"
-            
-          in
-          let _endpos = _endpos__6_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3705 "parsing/parser.mly"
+# 3750 "parsing/parser.mly"
     ( let info =
         match rhs_info _endpos__4_ with
         | Some _ as info_before_semi -> info_before_semi
@@ -26748,14 +27319,15 @@ module Tables = struct
       in
       let attrs = add_info_attrs info (_4 @ _6) in
       Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 26752 "parsing/parser.ml"
-          
-        in
-        
-# 3689 "parsing/parser.mly"
+# 27323 "parsing/parser.ml"
+            
+          in
+          (
+# 3734 "parsing/parser.mly"
       ( [head], Closed )
-# 26758 "parsing/parser.ml"
-         in
+# 27329 "parsing/parser.ml"
+           : (Parsetree.object_field list * Asttypes.closed_flag))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26783,21 +27355,23 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_ty_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.object_field list * Asttypes.closed_flag) = let head =
-          let _endpos = _endpos_ty_ in
-          let _symbolstartpos = _startpos_ty_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3716 "parsing/parser.mly"
+        let _v =
+          let head =
+            let _endpos = _endpos_ty_ in
+            let _symbolstartpos = _startpos_ty_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 3761 "parsing/parser.mly"
     ( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 26794 "parsing/parser.ml"
-          
-        in
-        
-# 3689 "parsing/parser.mly"
+# 27367 "parsing/parser.ml"
+            
+          in
+          (
+# 3734 "parsing/parser.mly"
       ( [head], Closed )
-# 26800 "parsing/parser.ml"
-         in
+# 27373 "parsing/parser.ml"
+           : (Parsetree.object_field list * Asttypes.closed_flag))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26836,62 +27410,64 @@ module Tables = struct
         let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 26842 "parsing/parser.ml"
+# 27416 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.object_field list * Asttypes.closed_flag) = let head =
-          let _4 =
-            let _1 = _1_inlined2 in
-            
-# 4062 "parsing/parser.mly"
+        let _v =
+          let head =
+            let _4 =
+              let _1 = _1_inlined2 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 26853 "parsing/parser.ml"
-            
-          in
-          let _endpos__4_ = _endpos__1_inlined2_ in
-          let _3 =
-            let _1 = _1_inlined1 in
-            
-# 3439 "parsing/parser.mly"
+# 27428 "parsing/parser.ml"
+              
+            in
+            let _endpos__4_ = _endpos__1_inlined2_ in
+            let _3 =
+              let _1 = _1_inlined1 in
+              
+# 3484 "parsing/parser.mly"
     ( _1 )
-# 26862 "parsing/parser.ml"
-            
-          in
-          let _1 =
-            let _1 = 
-# 3720 "parsing/parser.mly"
+# 27437 "parsing/parser.ml"
+              
+            in
+            let _1 =
+              let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 26869 "parsing/parser.ml"
-             in
-            let _endpos = _endpos__1_ in
+# 27444 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 27452 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos__4_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 26877 "parsing/parser.ml"
-            
-          in
-          let _endpos = _endpos__4_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3698 "parsing/parser.mly"
+# 3743 "parsing/parser.mly"
     ( let info = symbol_info _endpos in
       let attrs = add_info_attrs info _4 in
       Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 26888 "parsing/parser.ml"
-          
-        in
-        
-# 3692 "parsing/parser.mly"
+# 27463 "parsing/parser.ml"
+            
+          in
+          (
+# 3737 "parsing/parser.mly"
       ( [head], Closed )
-# 26894 "parsing/parser.ml"
-         in
+# 27469 "parsing/parser.ml"
+           : (Parsetree.object_field list * Asttypes.closed_flag))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26912,21 +27488,23 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_ty_ in
         let _endpos = _endpos_ty_ in
-        let _v : (Parsetree.object_field list * Asttypes.closed_flag) = let head =
-          let _endpos = _endpos_ty_ in
-          let _symbolstartpos = _startpos_ty_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3716 "parsing/parser.mly"
+        let _v =
+          let head =
+            let _endpos = _endpos_ty_ in
+            let _symbolstartpos = _startpos_ty_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 3761 "parsing/parser.mly"
     ( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 26923 "parsing/parser.ml"
-          
-        in
-        
-# 3692 "parsing/parser.mly"
+# 27500 "parsing/parser.ml"
+            
+          in
+          (
+# 3737 "parsing/parser.mly"
       ( [head], Closed )
-# 26929 "parsing/parser.ml"
-         in
+# 27506 "parsing/parser.ml"
+           : (Parsetree.object_field list * Asttypes.closed_flag))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -26948,9 +27526,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.object_field list * Asttypes.closed_flag) = 
-# 3694 "parsing/parser.mly"
+# 3739 "parsing/parser.mly"
       ( [], Open )
-# 26954 "parsing/parser.ml"
+# 27532 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -26995,56 +27573,58 @@ module Tables = struct
         let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 27001 "parsing/parser.ml"
+# 27579 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let private_ : (Asttypes.private_flag) = Obj.magic private_ in
         let _1 : (Parsetree.attributes) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let ty =
-          let _1 = _1_inlined2 in
-          
-# 3435 "parsing/parser.mly"
+        let _v =
+          let ty =
+            let _1 = _1_inlined2 in
+            
+# 3480 "parsing/parser.mly"
     ( _1 )
-# 27015 "parsing/parser.ml"
-          
-        in
-        let label =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+# 27592 "parsing/parser.ml"
+            
+          in
+          let label =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 27023 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 27600 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 27031 "parsing/parser.ml"
-          
-        in
-        let attrs = 
-# 4062 "parsing/parser.mly"
+# 27608 "parsing/parser.ml"
+            
+          in
+          let attrs = 
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 27037 "parsing/parser.ml"
-         in
-        let _1 = 
-# 3961 "parsing/parser.mly"
+# 27614 "parsing/parser.ml"
+           in
+          let _1 = 
+# 4013 "parsing/parser.mly"
                                                 ( Fresh )
-# 27042 "parsing/parser.ml"
-         in
-        
-# 2082 "parsing/parser.mly"
+# 27619 "parsing/parser.ml"
+           in
+          (
+# 2104 "parsing/parser.mly"
       ( (label, private_, Cfk_virtual ty), attrs )
-# 27047 "parsing/parser.ml"
-         in
+# 27624 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -27081,51 +27661,53 @@ module Tables = struct
         } = _menhir_stack in
         let _5 : (Parsetree.expression) = Obj.magic _5 in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 27087 "parsing/parser.ml"
+# 27667 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _3 : (Asttypes.private_flag) = Obj.magic _3 in
         let _1 : (Parsetree.attributes) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 27101 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 27680 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 27109 "parsing/parser.ml"
-          
-        in
-        let _2 = 
-# 4062 "parsing/parser.mly"
+# 27688 "parsing/parser.ml"
+            
+          in
+          let _2 = 
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 27115 "parsing/parser.ml"
-         in
-        let _1 = 
-# 3964 "parsing/parser.mly"
+# 27694 "parsing/parser.ml"
+           in
+          let _1 = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 27120 "parsing/parser.ml"
-         in
-        
-# 2084 "parsing/parser.mly"
+# 27699 "parsing/parser.ml"
+           in
+          (
+# 2106 "parsing/parser.mly"
       ( let e = _5 in
         let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in
         (_4, _3,
         Cfk_concrete (_1, ghexp ~loc (Pexp_poly (e, None)))), _2 )
-# 27128 "parsing/parser.ml"
-         in
+# 27707 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -27168,9 +27750,9 @@ module Tables = struct
         } = _menhir_stack in
         let _5 : (Parsetree.expression) = Obj.magic _5 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 27174 "parsing/parser.ml"
+# 27756 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let _3 : (Asttypes.private_flag) = Obj.magic _3 in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -27178,45 +27760,47 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 27189 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 27770 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 27197 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 27778 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 27205 "parsing/parser.ml"
-          
-        in
-        let _1 = 
-# 3965 "parsing/parser.mly"
+# 27786 "parsing/parser.ml"
+            
+          in
+          let _1 = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 27211 "parsing/parser.ml"
-         in
-        
-# 2084 "parsing/parser.mly"
+# 27792 "parsing/parser.ml"
+           in
+          (
+# 2106 "parsing/parser.mly"
       ( let e = _5 in
         let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in
         (_4, _3,
         Cfk_concrete (_1, ghexp ~loc (Pexp_poly (e, None)))), _2 )
-# 27219 "parsing/parser.ml"
-         in
+# 27800 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -27274,60 +27858,62 @@ module Tables = struct
         let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 27280 "parsing/parser.ml"
+# 27864 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _3 : (Asttypes.private_flag) = Obj.magic _3 in
         let _1 : (Parsetree.attributes) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__8_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let _6 =
-          let _1 = _1_inlined2 in
-          
-# 3435 "parsing/parser.mly"
+        let _v =
+          let _6 =
+            let _1 = _1_inlined2 in
+            
+# 3480 "parsing/parser.mly"
     ( _1 )
-# 27294 "parsing/parser.ml"
-          
-        in
-        let _startpos__6_ = _startpos__1_inlined2_ in
-        let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+# 27877 "parsing/parser.ml"
+            
+          in
+          let _startpos__6_ = _startpos__1_inlined2_ in
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 27303 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 27886 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 27311 "parsing/parser.ml"
-          
-        in
-        let _2 = 
-# 4062 "parsing/parser.mly"
+# 27894 "parsing/parser.ml"
+            
+          in
+          let _2 = 
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 27317 "parsing/parser.ml"
-         in
-        let _1 = 
-# 3964 "parsing/parser.mly"
+# 27900 "parsing/parser.ml"
+           in
+          let _1 = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 27322 "parsing/parser.ml"
-         in
-        
-# 2090 "parsing/parser.mly"
+# 27905 "parsing/parser.ml"
+           in
+          (
+# 2112 "parsing/parser.mly"
       ( let poly_exp =
           let loc = (_startpos__6_, _endpos__8_) in
           ghexp ~loc (Pexp_poly(_8, Some _6)) in
         (_4, _3, Cfk_concrete (_1, poly_exp)), _2 )
-# 27330 "parsing/parser.ml"
-         in
+# 27913 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -27391,9 +27977,9 @@ module Tables = struct
         let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 27397 "parsing/parser.ml"
+# 27983 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let _3 : (Asttypes.private_flag) = Obj.magic _3 in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -27401,54 +27987,56 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__8_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let _6 =
-          let _1 = _1_inlined3 in
-          
-# 3435 "parsing/parser.mly"
+        let _v =
+          let _6 =
+            let _1 = _1_inlined3 in
+            
+# 3480 "parsing/parser.mly"
     ( _1 )
-# 27412 "parsing/parser.ml"
-          
-        in
-        let _startpos__6_ = _startpos__1_inlined3_ in
-        let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+# 27997 "parsing/parser.ml"
+            
+          in
+          let _startpos__6_ = _startpos__1_inlined3_ in
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 27421 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 28006 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 27429 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 28014 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 27437 "parsing/parser.ml"
-          
-        in
-        let _1 = 
-# 3965 "parsing/parser.mly"
+# 28022 "parsing/parser.ml"
+            
+          in
+          let _1 = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 27443 "parsing/parser.ml"
-         in
-        
-# 2090 "parsing/parser.mly"
+# 28028 "parsing/parser.ml"
+           in
+          (
+# 2112 "parsing/parser.mly"
       ( let poly_exp =
           let loc = (_startpos__6_, _endpos__8_) in
           ghexp ~loc (Pexp_poly(_8, Some _6)) in
         (_4, _3, Cfk_concrete (_1, poly_exp)), _2 )
-# 27451 "parsing/parser.ml"
-         in
+# 28036 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -27527,66 +28115,65 @@ module Tables = struct
         let _6 : unit = Obj.magic _6 in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 27533 "parsing/parser.ml"
+# 28121 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _3 : (Asttypes.private_flag) = Obj.magic _3 in
         let _1 : (Parsetree.attributes) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__11_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let _7 = 
-# 2637 "parsing/parser.mly"
+        let _v =
+          let _7 = 
+# 2679 "parsing/parser.mly"
     ( xs )
-# 27545 "parsing/parser.ml"
-         in
-        let _startpos__7_ = _startpos_xs_ in
-        let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
-                                                ( _1 )
-# 27553 "parsing/parser.ml"
+# 28132 "parsing/parser.ml"
            in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+          let _startpos__7_ = _startpos_xs_ in
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
+                                                ( _1 )
+# 28140 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 27561 "parsing/parser.ml"
-          
-        in
-        let _startpos__4_ = _startpos__1_inlined1_ in
-        let _2 = 
-# 4062 "parsing/parser.mly"
+# 28148 "parsing/parser.ml"
+            
+          in
+          let _startpos__4_ = _startpos__1_inlined1_ in
+          let _2 = 
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 27568 "parsing/parser.ml"
-         in
-        let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
-        let _1 = 
-# 3964 "parsing/parser.mly"
+# 28155 "parsing/parser.ml"
+           in
+          let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
+          let _1 = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 27574 "parsing/parser.ml"
-         in
-        let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
-        let _endpos = _endpos__11_ in
-        let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
-          _startpos__1_
-        else
-          if _startpos__2_ != _endpos__2_ then
-            _startpos__2_
+# 28161 "parsing/parser.ml"
+           in
+          let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
+          let _endpos = _endpos__11_ in
+          let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
+            _startpos__1_
           else
-            if _startpos__3_ != _endpos__3_ then
-              _startpos__3_
+            if _startpos__2_ != _endpos__2_ then
+              _startpos__2_
             else
-              _startpos__4_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2096 "parsing/parser.mly"
+              if _startpos__3_ != _endpos__3_ then
+                _startpos__3_
+              else
+                _startpos__4_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2118 "parsing/parser.mly"
       ( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
         let poly_exp =
           let exp, poly =
@@ -27597,8 +28184,11 @@ module Tables = struct
           ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
         (_4, _3,
         Cfk_concrete (_1, poly_exp)), _2 )
-# 27601 "parsing/parser.ml"
-         in
+# 28188 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -27683,9 +28273,9 @@ module Tables = struct
         let _6 : unit = Obj.magic _6 in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 27689 "parsing/parser.ml"
+# 28279 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let _3 : (Asttypes.private_flag) = Obj.magic _3 in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -27693,59 +28283,58 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__11_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let _7 = 
-# 2637 "parsing/parser.mly"
+        let _v =
+          let _7 = 
+# 2679 "parsing/parser.mly"
     ( xs )
-# 27702 "parsing/parser.ml"
-         in
-        let _startpos__7_ = _startpos_xs_ in
-        let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
-                                                ( _1 )
-# 27710 "parsing/parser.ml"
+# 28291 "parsing/parser.ml"
            in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+          let _startpos__7_ = _startpos_xs_ in
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
+                                                ( _1 )
+# 28299 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 27718 "parsing/parser.ml"
-          
-        in
-        let _startpos__4_ = _startpos__1_inlined2_ in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 28307 "parsing/parser.ml"
+            
+          in
+          let _startpos__4_ = _startpos__1_inlined2_ in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 27727 "parsing/parser.ml"
-          
-        in
-        let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
-        let _1 = 
-# 3965 "parsing/parser.mly"
+# 28316 "parsing/parser.ml"
+            
+          in
+          let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
+          let _1 = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 27734 "parsing/parser.ml"
-         in
-        let _endpos = _endpos__11_ in
-        let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
-          _startpos__1_
-        else
-          if _startpos__2_ != _endpos__2_ then
-            _startpos__2_
+# 28323 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__11_ in
+          let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
+            _startpos__1_
           else
-            if _startpos__3_ != _endpos__3_ then
-              _startpos__3_
+            if _startpos__2_ != _endpos__2_ then
+              _startpos__2_
             else
-              _startpos__4_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2096 "parsing/parser.mly"
+              if _startpos__3_ != _endpos__3_ then
+                _startpos__3_
+              else
+                _startpos__4_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2118 "parsing/parser.mly"
       ( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
         let poly_exp =
           let exp, poly =
@@ -27756,8 +28345,11 @@ module Tables = struct
           ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
         (_4, _3,
         Cfk_concrete (_1, poly_exp)), _2 )
-# 27760 "parsing/parser.ml"
-         in
+# 28349 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -27775,17 +28367,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 27781 "parsing/parser.ml"
+# 28373 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3817 "parsing/parser.mly"
+# 3869 "parsing/parser.mly"
                       ( Lident _1 )
-# 27789 "parsing/parser.ml"
+# 28381 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -27816,9 +28408,9 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _3 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 27822 "parsing/parser.ml"
+# 28414 "parsing/parser.ml"
         ) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (Longident.t) = Obj.magic _1 in
@@ -27826,9 +28418,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Longident.t) = 
-# 3818 "parsing/parser.mly"
+# 3870 "parsing/parser.mly"
                       ( Ldot(_1,_3) )
-# 27832 "parsing/parser.ml"
+# 28424 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -27847,17 +28439,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 27853 "parsing/parser.ml"
+# 28445 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3817 "parsing/parser.mly"
+# 3869 "parsing/parser.mly"
                       ( Lident _1 )
-# 27861 "parsing/parser.ml"
+# 28453 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -27888,9 +28480,9 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _3 : (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 27894 "parsing/parser.ml"
+# 28486 "parsing/parser.ml"
         ) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (Longident.t) = Obj.magic _1 in
@@ -27898,9 +28490,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Longident.t) = 
-# 3818 "parsing/parser.mly"
+# 3870 "parsing/parser.mly"
                       ( Ldot(_1,_3) )
-# 27904 "parsing/parser.ml"
+# 28496 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -27922,16 +28514,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Longident.t) = let _1 = 
-# 3855 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3907 "parsing/parser.mly"
                                                   ( _1 )
-# 27929 "parsing/parser.ml"
-         in
-        
-# 3817 "parsing/parser.mly"
+# 28522 "parsing/parser.ml"
+           in
+          (
+# 3869 "parsing/parser.mly"
                       ( Lident _1 )
-# 27934 "parsing/parser.ml"
-         in
+# 28527 "parsing/parser.ml"
+           : (Longident.t))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -27966,23 +28560,25 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Longident.t) = let _1 =
-          let _1 = 
-# 3797 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3849 "parsing/parser.mly"
                                                 ( "::" )
-# 27974 "parsing/parser.ml"
-           in
-          
-# 3855 "parsing/parser.mly"
+# 28569 "parsing/parser.ml"
+             in
+            
+# 3907 "parsing/parser.mly"
                                                   ( _1 )
-# 27979 "parsing/parser.ml"
-          
-        in
-        
-# 3817 "parsing/parser.mly"
+# 28574 "parsing/parser.ml"
+            
+          in
+          (
+# 3869 "parsing/parser.mly"
                       ( Lident _1 )
-# 27985 "parsing/parser.ml"
-         in
+# 28580 "parsing/parser.ml"
+           : (Longident.t))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28003,16 +28599,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Longident.t) = let _1 = 
-# 3855 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3907 "parsing/parser.mly"
                                                   ( _1 )
-# 28010 "parsing/parser.ml"
-         in
-        
-# 3817 "parsing/parser.mly"
+# 28607 "parsing/parser.ml"
+           in
+          (
+# 3869 "parsing/parser.mly"
                       ( Lident _1 )
-# 28015 "parsing/parser.ml"
-         in
+# 28612 "parsing/parser.ml"
+           : (Longident.t))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28047,19 +28645,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Longident.t) = let _3 =
-          let _1 = _1_inlined1 in
-          
-# 3855 "parsing/parser.mly"
+        let _v =
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 3907 "parsing/parser.mly"
                                                   ( _1 )
-# 28056 "parsing/parser.ml"
-          
-        in
-        
-# 3818 "parsing/parser.mly"
+# 28655 "parsing/parser.ml"
+            
+          in
+          (
+# 3870 "parsing/parser.mly"
                       ( Ldot(_1,_3) )
-# 28062 "parsing/parser.ml"
-         in
+# 28661 "parsing/parser.ml"
+           : (Longident.t))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28108,23 +28708,25 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Longident.t) = let _3 =
-          let _1 = 
-# 3797 "parsing/parser.mly"
+        let _v =
+          let _3 =
+            let _1 = 
+# 3849 "parsing/parser.mly"
                                                 ( "::" )
-# 28116 "parsing/parser.ml"
-           in
-          
-# 3855 "parsing/parser.mly"
+# 28717 "parsing/parser.ml"
+             in
+            
+# 3907 "parsing/parser.mly"
                                                   ( _1 )
-# 28121 "parsing/parser.ml"
-          
-        in
-        
-# 3818 "parsing/parser.mly"
+# 28722 "parsing/parser.ml"
+            
+          in
+          (
+# 3870 "parsing/parser.mly"
                       ( Ldot(_1,_3) )
-# 28127 "parsing/parser.ml"
-         in
+# 28728 "parsing/parser.ml"
+           : (Longident.t))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28159,19 +28761,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Longident.t) = let _3 =
-          let _1 = _1_inlined1 in
-          
-# 3855 "parsing/parser.mly"
+        let _v =
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 3907 "parsing/parser.mly"
                                                   ( _1 )
-# 28168 "parsing/parser.ml"
-          
-        in
-        
-# 3818 "parsing/parser.mly"
+# 28771 "parsing/parser.ml"
+            
+          in
+          (
+# 3870 "parsing/parser.mly"
                       ( Ldot(_1,_3) )
-# 28174 "parsing/parser.ml"
-         in
+# 28777 "parsing/parser.ml"
+           : (Longident.t))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28193,9 +28797,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3817 "parsing/parser.mly"
+# 3869 "parsing/parser.mly"
                       ( Lident _1 )
-# 28199 "parsing/parser.ml"
+# 28803 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28232,9 +28836,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Longident.t) = 
-# 3818 "parsing/parser.mly"
+# 3870 "parsing/parser.mly"
                       ( Ldot(_1,_3) )
-# 28238 "parsing/parser.ml"
+# 28842 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28253,17 +28857,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 28259 "parsing/parser.ml"
+# 28863 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3817 "parsing/parser.mly"
+# 3869 "parsing/parser.mly"
                       ( Lident _1 )
-# 28267 "parsing/parser.ml"
+# 28871 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28294,9 +28898,9 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _3 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 28300 "parsing/parser.ml"
+# 28904 "parsing/parser.ml"
         ) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (Longident.t) = Obj.magic _1 in
@@ -28304,9 +28908,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Longident.t) = 
-# 3818 "parsing/parser.mly"
+# 3870 "parsing/parser.mly"
                       ( Ldot(_1,_3) )
-# 28310 "parsing/parser.ml"
+# 28914 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28325,17 +28929,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 28331 "parsing/parser.ml"
+# 28935 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3817 "parsing/parser.mly"
+# 3869 "parsing/parser.mly"
                       ( Lident _1 )
-# 28339 "parsing/parser.ml"
+# 28943 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28366,9 +28970,9 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _3 : (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 28372 "parsing/parser.ml"
+# 28976 "parsing/parser.ml"
         ) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (Longident.t) = Obj.magic _1 in
@@ -28376,9 +28980,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Longident.t) = 
-# 3818 "parsing/parser.mly"
+# 3870 "parsing/parser.mly"
                       ( Ldot(_1,_3) )
-# 28382 "parsing/parser.ml"
+# 28986 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28401,9 +29005,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3817 "parsing/parser.mly"
+# 3869 "parsing/parser.mly"
                       ( Lident _1 )
-# 28407 "parsing/parser.ml"
+# 29011 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28440,9 +29044,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Longident.t) = 
-# 3818 "parsing/parser.mly"
+# 3870 "parsing/parser.mly"
                       ( Ldot(_1,_3) )
-# 28446 "parsing/parser.ml"
+# 29050 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28465,9 +29069,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3833 "parsing/parser.mly"
+# 3885 "parsing/parser.mly"
                                             ( _1 )
-# 28471 "parsing/parser.ml"
+# 29075 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28510,14 +29114,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Longident.t) = let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3835 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3887 "parsing/parser.mly"
       ( lapply ~loc:_sloc _1 _3 )
-# 28520 "parsing/parser.ml"
-         in
+# 29125 "parsing/parser.ml"
+           : (Longident.t))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28552,12 +29158,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Longident.t) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        
-# 3837 "parsing/parser.mly"
+        let _v =
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          (
+# 3889 "parsing/parser.mly"
       ( expecting _loc__3_ "module path" )
-# 28560 "parsing/parser.ml"
-         in
+# 29167 "parsing/parser.ml"
+           : (Longident.t))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28579,9 +29187,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3830 "parsing/parser.mly"
+# 3882 "parsing/parser.mly"
                                          ( _1 )
-# 28585 "parsing/parser.ml"
+# 29193 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28611,9 +29219,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_me_ in
         let _v : (Parsetree.module_expr) = 
-# 1557 "parsing/parser.mly"
+# 1581 "parsing/parser.mly"
       ( me )
-# 28617 "parsing/parser.ml"
+# 29225 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28642,12 +29250,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.module_expr) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1559 "parsing/parser.mly"
+        let _v =
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1583 "parsing/parser.mly"
       ( expecting _loc__1_ "=" )
-# 28650 "parsing/parser.ml"
-         in
+# 29259 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28689,27 +29299,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_me_ in
-        let _v : (Parsetree.module_expr) = let _1 =
-          let _1 = 
-# 1562 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1586 "parsing/parser.mly"
         ( Pmod_constraint(me, mty) )
-# 28697 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos_me_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1003 "parsing/parser.mly"
+# 29308 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos_me_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1027 "parsing/parser.mly"
     ( mkmod ~loc:_sloc _1 )
-# 28706 "parsing/parser.ml"
-          
-        in
-        
-# 1566 "parsing/parser.mly"
+# 29317 "parsing/parser.ml"
+            
+          in
+          (
+# 1590 "parsing/parser.mly"
     ( _1 )
-# 28712 "parsing/parser.ml"
-         in
+# 29323 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28737,28 +29349,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_arg_and_pos_ in
         let _endpos = _endpos_body_ in
-        let _v : (Parsetree.module_expr) = let _1 =
-          let _1 = 
-# 1564 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1588 "parsing/parser.mly"
         ( let (_, arg) = arg_and_pos in
           Pmod_functor(arg, body) )
-# 28746 "parsing/parser.ml"
-           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1003 "parsing/parser.mly"
+# 29359 "parsing/parser.ml"
+             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1027 "parsing/parser.mly"
     ( mkmod ~loc:_sloc _1 )
-# 28755 "parsing/parser.ml"
-          
-        in
-        
-# 1566 "parsing/parser.mly"
+# 29368 "parsing/parser.ml"
+            
+          in
+          (
+# 1590 "parsing/parser.mly"
     ( _1 )
-# 28761 "parsing/parser.ml"
-         in
+# 29374 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28787,9 +29401,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_mty_ in
         let _v : (Parsetree.module_type) = 
-# 1809 "parsing/parser.mly"
+# 1831 "parsing/parser.mly"
       ( mty )
-# 28793 "parsing/parser.ml"
+# 29407 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -28818,12 +29432,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.module_type) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1811 "parsing/parser.mly"
+        let _v =
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1833 "parsing/parser.mly"
       ( expecting _loc__1_ ":" )
-# 28826 "parsing/parser.ml"
-         in
+# 29441 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28851,28 +29467,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_arg_and_pos_ in
         let _endpos = _endpos_body_ in
-        let _v : (Parsetree.module_type) = let _1 =
-          let _1 = 
-# 1814 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1836 "parsing/parser.mly"
         ( let (_, arg) = arg_and_pos in
           Pmty_functor(arg, body) )
-# 28860 "parsing/parser.ml"
-           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1005 "parsing/parser.mly"
+# 29477 "parsing/parser.ml"
+             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1029 "parsing/parser.mly"
     ( mkmty ~loc:_sloc _1 )
-# 28869 "parsing/parser.ml"
-          
-        in
-        
-# 1817 "parsing/parser.mly"
+# 29486 "parsing/parser.ml"
+            
+          in
+          (
+# 1839 "parsing/parser.mly"
     ( _1 )
-# 28875 "parsing/parser.ml"
-         in
+# 29492 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28914,22 +29532,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.module_expr) = let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 28923 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1395 "parsing/parser.mly"
+# 29542 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1419 "parsing/parser.mly"
       ( mkmod ~loc:_sloc ~attrs (Pmod_structure s) )
-# 28932 "parsing/parser.ml"
-         in
+# 29551 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -28971,21 +29591,23 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.module_expr) = let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 28980 "parsing/parser.ml"
-          
-        in
-        let _loc__4_ = (_startpos__4_, _endpos__4_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1397 "parsing/parser.mly"
+# 29601 "parsing/parser.ml"
+            
+          in
+          let _loc__4_ = (_startpos__4_, _endpos__4_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1421 "parsing/parser.mly"
       ( unclosed "struct" _loc__1_ "end" _loc__4_ )
-# 28988 "parsing/parser.ml"
-         in
+# 29609 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29013,12 +29635,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.module_expr) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1399 "parsing/parser.mly"
+        let _v =
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1423 "parsing/parser.mly"
       ( expecting _loc__1_ "struct" )
-# 29021 "parsing/parser.ml"
-         in
+# 29644 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29067,34 +29691,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_me_ in
-        let _v : (Parsetree.module_expr) = let args =
-          let _1 = _1_inlined2 in
-          
-# 1361 "parsing/parser.mly"
+        let _v =
+          let args =
+            let _1 = _1_inlined2 in
+            
+# 1385 "parsing/parser.mly"
     ( _1 )
-# 29076 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 29701 "parsing/parser.ml"
+            
+          in
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 29084 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_me_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1401 "parsing/parser.mly"
+# 29709 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_me_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1425 "parsing/parser.mly"
       ( wrap_mod_attrs ~loc:_sloc attrs (
           List.fold_left (fun acc (startpos, arg) ->
             mkmod ~loc:(startpos, _endpos) (Pmod_functor (arg, acc))
           ) me args
         ) )
-# 29097 "parsing/parser.ml"
-         in
+# 29722 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29116,9 +29742,9 @@ module Tables = struct
         let _startpos = _startpos_me_ in
         let _endpos = _endpos_me_ in
         let _v : (Parsetree.module_expr) = 
-# 1407 "parsing/parser.mly"
+# 1431 "parsing/parser.mly"
       ( me )
-# 29122 "parsing/parser.ml"
+# 29748 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -29148,9 +29774,9 @@ module Tables = struct
         let _startpos = _startpos_me_ in
         let _endpos = _endpos_attr_ in
         let _v : (Parsetree.module_expr) = 
-# 1409 "parsing/parser.mly"
+# 1433 "parsing/parser.mly"
       ( Mod.attr me attr )
-# 29154 "parsing/parser.ml"
+# 29780 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -29172,38 +29798,40 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.module_expr) = let _1 =
+        let _v =
           let _1 =
-            let x =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let x =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 29185 "parsing/parser.ml"
+# 29812 "parsing/parser.ml"
+                
+              in
+              
+# 1437 "parsing/parser.mly"
+        ( Pmod_ident x )
+# 29818 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1413 "parsing/parser.mly"
-        ( Pmod_ident x )
-# 29191 "parsing/parser.ml"
+# 1027 "parsing/parser.mly"
+    ( mkmod ~loc:_sloc _1 )
+# 29827 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1003 "parsing/parser.mly"
-    ( mkmod ~loc:_sloc _1 )
-# 29200 "parsing/parser.ml"
-          
-        in
-        
-# 1424 "parsing/parser.mly"
+          (
+# 1448 "parsing/parser.mly"
     ( _1 )
-# 29206 "parsing/parser.ml"
-         in
+# 29833 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29231,27 +29859,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_me1_ in
         let _endpos = _endpos_me2_ in
-        let _v : (Parsetree.module_expr) = let _1 =
-          let _1 = 
-# 1416 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1440 "parsing/parser.mly"
         ( Pmod_apply(me1, me2) )
-# 29239 "parsing/parser.ml"
-           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_me2_, _startpos_me1_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1003 "parsing/parser.mly"
+# 29868 "parsing/parser.ml"
+             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_me2_, _startpos_me1_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1027 "parsing/parser.mly"
     ( mkmod ~loc:_sloc _1 )
-# 29248 "parsing/parser.ml"
-          
-        in
-        
-# 1424 "parsing/parser.mly"
+# 29877 "parsing/parser.ml"
+            
+          in
+          (
+# 1448 "parsing/parser.mly"
     ( _1 )
-# 29254 "parsing/parser.ml"
-         in
+# 29883 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29286,27 +29916,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_me_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.module_expr) = let _1 =
-          let _1 = 
-# 1419 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1443 "parsing/parser.mly"
         ( Pmod_apply_unit me )
-# 29294 "parsing/parser.ml"
-           in
-          let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1003 "parsing/parser.mly"
+# 29925 "parsing/parser.ml"
+             in
+            let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1027 "parsing/parser.mly"
     ( mkmod ~loc:_sloc _1 )
-# 29303 "parsing/parser.ml"
-          
-        in
-        
-# 1424 "parsing/parser.mly"
+# 29934 "parsing/parser.ml"
+            
+          in
+          (
+# 1448 "parsing/parser.mly"
     ( _1 )
-# 29309 "parsing/parser.ml"
-         in
+# 29940 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29327,27 +29959,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_ex_ in
         let _endpos = _endpos_ex_ in
-        let _v : (Parsetree.module_expr) = let _1 =
-          let _1 = 
-# 1422 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1446 "parsing/parser.mly"
         ( Pmod_extension ex )
-# 29335 "parsing/parser.ml"
-           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_ex_, _startpos_ex_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1003 "parsing/parser.mly"
+# 29968 "parsing/parser.ml"
+             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_ex_, _startpos_ex_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1027 "parsing/parser.mly"
     ( mkmod ~loc:_sloc _1 )
-# 29344 "parsing/parser.ml"
-          
-        in
-        
-# 1424 "parsing/parser.mly"
+# 29977 "parsing/parser.ml"
+            
+          in
+          (
+# 1448 "parsing/parser.mly"
     ( _1 )
-# 29350 "parsing/parser.ml"
-         in
+# 29983 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29365,17 +29999,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let x : (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 29371 "parsing/parser.ml"
+# 30005 "parsing/parser.ml"
         ) = Obj.magic x in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
         let _v : (string option) = 
-# 1378 "parsing/parser.mly"
+# 1402 "parsing/parser.mly"
       ( Some x )
-# 29379 "parsing/parser.ml"
+# 30013 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -29398,9 +30032,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string option) = 
-# 1381 "parsing/parser.mly"
+# 1405 "parsing/parser.mly"
       ( None )
-# 29404 "parsing/parser.ml"
+# 30038 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -29458,9 +30092,9 @@ module Tables = struct
         let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined2 : (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 29464 "parsing/parser.ml"
+# 30098 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
         let ext : (string Asttypes.loc option) = Obj.magic ext in
@@ -29468,58 +30102,60 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : (Parsetree.module_substitution * string Asttypes.loc option) = let attrs2 =
-          let _1 = _1_inlined4 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined4 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 29477 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined4_ in
-        let body =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 30112 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined4_ in
+          let body =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 29489 "parsing/parser.ml"
-          
-        in
-        let uid =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 30124 "parsing/parser.ml"
+            
+          in
+          let uid =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 29500 "parsing/parser.ml"
-          
-        in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 30135 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 29508 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1847 "parsing/parser.mly"
+# 30143 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1869 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Ms.mk uid body ~attrs ~loc ~docs, ext
   )
-# 29522 "parsing/parser.ml"
-         in
+# 30157 "parsing/parser.ml"
+           : (Parsetree.module_substitution * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29569,9 +30205,9 @@ module Tables = struct
         let _6 : unit = Obj.magic _6 in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined2 : (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 29575 "parsing/parser.ml"
+# 30211 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
         let _2 : (string Asttypes.loc option) = Obj.magic _2 in
@@ -29579,31 +30215,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : (Parsetree.module_substitution * string Asttypes.loc option) = let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 29591 "parsing/parser.ml"
-          
-        in
-        let _3 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 30228 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 29599 "parsing/parser.ml"
-          
-        in
-        let _loc__6_ = (_startpos__6_, _endpos__6_) in
-        
-# 1854 "parsing/parser.mly"
+# 30236 "parsing/parser.ml"
+            
+          in
+          let _loc__6_ = (_startpos__6_, _endpos__6_) in
+          (
+# 1876 "parsing/parser.mly"
     ( expecting _loc__6_ "module path" )
-# 29606 "parsing/parser.ml"
-         in
+# 30243 "parsing/parser.ml"
+           : (Parsetree.module_substitution * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29645,22 +30283,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.module_type) = let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 29654 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1691 "parsing/parser.mly"
+# 30293 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1715 "parsing/parser.mly"
       ( mkmty ~loc:_sloc ~attrs (Pmty_signature s) )
-# 29663 "parsing/parser.ml"
-         in
+# 30302 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29702,21 +30342,23 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.module_type) = let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 29711 "parsing/parser.ml"
-          
-        in
-        let _loc__4_ = (_startpos__4_, _endpos__4_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1693 "parsing/parser.mly"
+# 30352 "parsing/parser.ml"
+            
+          in
+          let _loc__4_ = (_startpos__4_, _endpos__4_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1717 "parsing/parser.mly"
       ( unclosed "sig" _loc__1_ "end" _loc__4_ )
-# 29719 "parsing/parser.ml"
-         in
+# 30360 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29744,12 +30386,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.module_type) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1695 "parsing/parser.mly"
+        let _v =
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1719 "parsing/parser.mly"
       ( expecting _loc__1_ "sig" )
-# 29752 "parsing/parser.ml"
-         in
+# 30395 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29798,34 +30442,78 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_mty_ in
-        let _v : (Parsetree.module_type) = let args =
-          let _1 = _1_inlined2 in
-          
-# 1361 "parsing/parser.mly"
+        let _v =
+          let args =
+            let _1 = _1_inlined2 in
+            
+# 1385 "parsing/parser.mly"
     ( _1 )
-# 29807 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 30452 "parsing/parser.ml"
+            
+          in
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 29815 "parsing/parser.ml"
-          
+# 30460 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_mty_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1723 "parsing/parser.mly"
+      ( wrap_mty_attrs ~loc:_sloc attrs (mk_functor_typ args mty) )
+# 30469 "parsing/parser.ml"
+           : (Parsetree.module_type))
         in
+        {
+          MenhirLib.EngineTypes.state = _menhir_s;
+          MenhirLib.EngineTypes.semv = Obj.repr _v;
+          MenhirLib.EngineTypes.startp = _startpos;
+          MenhirLib.EngineTypes.endp = _endpos;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        });
+      (fun _menhir_env ->
+        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+        let {
+          MenhirLib.EngineTypes.state = _;
+          MenhirLib.EngineTypes.semv = mty;
+          MenhirLib.EngineTypes.startp = _startpos_mty_;
+          MenhirLib.EngineTypes.endp = _endpos_mty_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _2;
+            MenhirLib.EngineTypes.startp = _startpos__2_;
+            MenhirLib.EngineTypes.endp = _endpos__2_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let mty : (Parsetree.module_type) = Obj.magic mty in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : ((Lexing.position * Parsetree.functor_parameter) list) = Obj.magic _1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos__1_ in
         let _endpos = _endpos_mty_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1699 "parsing/parser.mly"
-      ( wrap_mty_attrs ~loc:_sloc attrs (
-          List.fold_left (fun acc (startpos, arg) ->
-            mkmty ~loc:(startpos, _endpos) (Pmty_functor (arg, acc))
-          ) mty args
-        ) )
-# 29828 "parsing/parser.ml"
-         in
+        let _v =
+          let args = 
+# 1385 "parsing/parser.mly"
+    ( _1 )
+# 30510 "parsing/parser.ml"
+           in
+          (
+# 1727 "parsing/parser.mly"
+      ( mk_functor_typ args mty )
+# 30515 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29874,22 +30562,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_type) = let _4 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 29883 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1705 "parsing/parser.mly"
+# 30572 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1729 "parsing/parser.mly"
       ( mkmty ~loc:_sloc ~attrs:_4 (Pmty_typeof _5) )
-# 29892 "parsing/parser.ml"
-         in
+# 30581 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29925,9 +30615,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.module_type) = 
-# 1707 "parsing/parser.mly"
+# 1731 "parsing/parser.mly"
       ( _2 )
-# 29931 "parsing/parser.ml"
+# 30621 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -29963,13 +30653,15 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.module_type) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1709 "parsing/parser.mly"
+        let _v =
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1733 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 29972 "parsing/parser.ml"
-         in
+# 30663 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -29998,9 +30690,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.module_type) = 
-# 1711 "parsing/parser.mly"
+# 1735 "parsing/parser.mly"
       ( Mty.attr _1 _2 )
-# 30004 "parsing/parser.ml"
+# 30696 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -30022,100 +30714,40 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.module_type) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 30035 "parsing/parser.ml"
+# 30728 "parsing/parser.ml"
+                
+              in
+              
+# 1738 "parsing/parser.mly"
+        ( Pmty_ident _1 )
+# 30734 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1714 "parsing/parser.mly"
-        ( Pmty_ident _1 )
-# 30041 "parsing/parser.ml"
+# 1029 "parsing/parser.mly"
+    ( mkmty ~loc:_sloc _1 )
+# 30743 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1005 "parsing/parser.mly"
-    ( mkmty ~loc:_sloc _1 )
-# 30050 "parsing/parser.ml"
-          
-        in
-        
-# 1727 "parsing/parser.mly"
+          (
+# 1749 "parsing/parser.mly"
     ( _1 )
-# 30056 "parsing/parser.ml"
-         in
-        {
-          MenhirLib.EngineTypes.state = _menhir_s;
-          MenhirLib.EngineTypes.semv = Obj.repr _v;
-          MenhirLib.EngineTypes.startp = _startpos;
-          MenhirLib.EngineTypes.endp = _endpos;
-          MenhirLib.EngineTypes.next = _menhir_stack;
-        });
-      (fun _menhir_env ->
-        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
-        let {
-          MenhirLib.EngineTypes.state = _;
-          MenhirLib.EngineTypes.semv = _4;
-          MenhirLib.EngineTypes.startp = _startpos__4_;
-          MenhirLib.EngineTypes.endp = _endpos__4_;
-          MenhirLib.EngineTypes.next = {
-            MenhirLib.EngineTypes.state = _;
-            MenhirLib.EngineTypes.semv = _3;
-            MenhirLib.EngineTypes.startp = _startpos__3_;
-            MenhirLib.EngineTypes.endp = _endpos__3_;
-            MenhirLib.EngineTypes.next = {
-              MenhirLib.EngineTypes.state = _;
-              MenhirLib.EngineTypes.semv = _2;
-              MenhirLib.EngineTypes.startp = _startpos__2_;
-              MenhirLib.EngineTypes.endp = _endpos__2_;
-              MenhirLib.EngineTypes.next = {
-                MenhirLib.EngineTypes.state = _menhir_s;
-                MenhirLib.EngineTypes.semv = _1;
-                MenhirLib.EngineTypes.startp = _startpos__1_;
-                MenhirLib.EngineTypes.endp = _endpos__1_;
-                MenhirLib.EngineTypes.next = _menhir_stack;
-              };
-            };
-          };
-        } = _menhir_stack in
-        let _4 : (Parsetree.module_type) = Obj.magic _4 in
-        let _3 : unit = Obj.magic _3 in
-        let _2 : unit = Obj.magic _2 in
-        let _1 : unit = Obj.magic _1 in
-        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
-        let _startpos = _startpos__1_ in
-        let _endpos = _endpos__4_ in
-        let _v : (Parsetree.module_type) = let _1 =
-          let _1 = 
-# 1716 "parsing/parser.mly"
-        ( Pmty_functor(Unit, _4) )
-# 30103 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1005 "parsing/parser.mly"
-    ( mkmty ~loc:_sloc _1 )
-# 30112 "parsing/parser.ml"
-          
+# 30749 "parsing/parser.ml"
+           : (Parsetree.module_type))
         in
-        
-# 1727 "parsing/parser.mly"
-    ( _1 )
-# 30118 "parsing/parser.ml"
-         in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30150,27 +30782,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.module_type) = let _1 =
-          let _1 = 
-# 1719 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1741 "parsing/parser.mly"
         ( Pmty_functor(Named (mknoloc None, _1), _3) )
-# 30158 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1005 "parsing/parser.mly"
+# 30791 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1029 "parsing/parser.mly"
     ( mkmty ~loc:_sloc _1 )
-# 30167 "parsing/parser.ml"
-          
-        in
-        
-# 1727 "parsing/parser.mly"
+# 30800 "parsing/parser.ml"
+            
+          in
+          (
+# 1749 "parsing/parser.mly"
     ( _1 )
-# 30173 "parsing/parser.ml"
-         in
+# 30806 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30205,41 +30839,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.module_type) = let _1 =
+        let _v =
           let _1 =
-            let _3 =
-              let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let _3 =
+                let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 30215 "parsing/parser.ml"
-               in
-              
-# 1115 "parsing/parser.mly"
+# 30850 "parsing/parser.ml"
+                 in
+                
+# 1139 "parsing/parser.mly"
     ( xs )
-# 30220 "parsing/parser.ml"
+# 30855 "parsing/parser.ml"
+                
+              in
+              
+# 1743 "parsing/parser.mly"
+        ( Pmty_with(_1, _3) )
+# 30861 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos_xs_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1721 "parsing/parser.mly"
-        ( Pmty_with(_1, _3) )
-# 30226 "parsing/parser.ml"
+# 1029 "parsing/parser.mly"
+    ( mkmty ~loc:_sloc _1 )
+# 30871 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_xs_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1005 "parsing/parser.mly"
-    ( mkmty ~loc:_sloc _1 )
-# 30236 "parsing/parser.ml"
-          
-        in
-        
-# 1727 "parsing/parser.mly"
+          (
+# 1749 "parsing/parser.mly"
     ( _1 )
-# 30242 "parsing/parser.ml"
-         in
+# 30877 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30260,26 +30896,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.module_type) = let _1 =
-          let _1 = 
-# 1725 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1747 "parsing/parser.mly"
         ( Pmty_extension _1 )
-# 30268 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1005 "parsing/parser.mly"
+# 30905 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1029 "parsing/parser.mly"
     ( mkmty ~loc:_sloc _1 )
-# 30276 "parsing/parser.ml"
-          
-        in
-        
-# 1727 "parsing/parser.mly"
+# 30913 "parsing/parser.ml"
+            
+          in
+          (
+# 1749 "parsing/parser.mly"
     ( _1 )
-# 30282 "parsing/parser.ml"
-         in
+# 30919 "parsing/parser.ml"
+           : (Parsetree.module_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30342,47 +30980,49 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.module_type_declaration * string Asttypes.loc option) = let attrs2 =
-          let _1 = _1_inlined3 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 30351 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined3_ in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 30990 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined3_ in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 30363 "parsing/parser.ml"
-          
-        in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 31002 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 30371 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1637 "parsing/parser.mly"
+# 31010 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1661 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Mtd.mk id ?typ ~attrs ~loc ~docs, ext
   )
-# 30385 "parsing/parser.ml"
-         in
+# 31024 "parsing/parser.ml"
+           : (Parsetree.module_type_declaration * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30452,47 +31092,49 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.module_type_declaration * string Asttypes.loc option) = let attrs2 =
-          let _1 = _1_inlined3 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 30461 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined3_ in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 31102 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined3_ in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 30473 "parsing/parser.ml"
-          
-        in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 31114 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 30481 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1903 "parsing/parser.mly"
+# 31122 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1925 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Mtd.mk id ~typ ~attrs ~loc ~docs, ext
   )
-# 30495 "parsing/parser.ml"
-         in
+# 31136 "parsing/parser.ml"
+           : (Parsetree.module_type_declaration * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30514,9 +31156,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3840 "parsing/parser.mly"
+# 3892 "parsing/parser.mly"
                                           ( _1 )
-# 30520 "parsing/parser.ml"
+# 31162 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -30532,9 +31174,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Asttypes.mutable_flag) = 
-# 3921 "parsing/parser.mly"
+# 3973 "parsing/parser.mly"
                                                 ( Immutable )
-# 30538 "parsing/parser.ml"
+# 31180 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -30557,9 +31199,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.mutable_flag) = 
-# 3922 "parsing/parser.mly"
+# 3974 "parsing/parser.mly"
                                                 ( Mutable )
-# 30563 "parsing/parser.ml"
+# 31205 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -30575,9 +31217,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = 
-# 3930 "parsing/parser.mly"
+# 3982 "parsing/parser.mly"
       ( Immutable, Concrete )
-# 30581 "parsing/parser.ml"
+# 31223 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -30600,9 +31242,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = 
-# 3932 "parsing/parser.mly"
+# 3984 "parsing/parser.mly"
       ( Mutable, Concrete )
-# 30606 "parsing/parser.ml"
+# 31248 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -30625,9 +31267,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = 
-# 3934 "parsing/parser.mly"
+# 3986 "parsing/parser.mly"
       ( Immutable, Virtual )
-# 30631 "parsing/parser.ml"
+# 31273 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -30657,9 +31299,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = 
-# 3937 "parsing/parser.mly"
+# 3989 "parsing/parser.mly"
       ( Mutable, Virtual )
-# 30663 "parsing/parser.ml"
+# 31305 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -30689,9 +31331,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) = 
-# 3937 "parsing/parser.mly"
+# 3989 "parsing/parser.mly"
       ( Mutable, Virtual )
-# 30695 "parsing/parser.ml"
+# 31337 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -30721,9 +31363,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.label) = 
-# 3892 "parsing/parser.mly"
+# 3944 "parsing/parser.mly"
                                                 ( _2 )
-# 30727 "parsing/parser.ml"
+# 31369 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -30742,28 +31384,30 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 30748 "parsing/parser.ml"
+# 31390 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (string Asttypes.loc list) = let x =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 30760 "parsing/parser.ml"
-          
-        in
-        
-# 221 "<standard.mly>"
+# 31403 "parsing/parser.ml"
+            
+          in
+          (
+# 228 "<standard.mly>"
     ( [ x ] )
-# 30766 "parsing/parser.ml"
-         in
+# 31409 "parsing/parser.ml"
+           : (string Asttypes.loc list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30788,28 +31432,30 @@ module Tables = struct
         } = _menhir_stack in
         let xs : (string Asttypes.loc list) = Obj.magic xs in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 30794 "parsing/parser.ml"
+# 31438 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (string Asttypes.loc list) = let x =
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 30806 "parsing/parser.ml"
-          
-        in
-        
-# 223 "<standard.mly>"
+# 31451 "parsing/parser.ml"
+            
+          in
+          (
+# 231 "<standard.mly>"
     ( x :: xs )
-# 30812 "parsing/parser.ml"
-         in
+# 31457 "parsing/parser.ml"
+           : (string Asttypes.loc list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30827,23 +31473,25 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let s : (
-# 816 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
        (string * Location.t * string option)
-# 30833 "parsing/parser.ml"
+# 31479 "parsing/parser.ml"
         ) = Obj.magic s in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_s_ in
         let _endpos = _endpos_s_ in
-        let _v : (string list) = let x = 
-# 3888 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3940 "parsing/parser.mly"
     ( let body, _, _ = s in body )
-# 30841 "parsing/parser.ml"
-         in
-        
-# 221 "<standard.mly>"
+# 31488 "parsing/parser.ml"
+           in
+          (
+# 228 "<standard.mly>"
     ( [ x ] )
-# 30846 "parsing/parser.ml"
-         in
+# 31493 "parsing/parser.ml"
+           : (string list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30868,23 +31516,25 @@ module Tables = struct
         } = _menhir_stack in
         let xs : (string list) = Obj.magic xs in
         let s : (
-# 816 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
        (string * Location.t * string option)
-# 30874 "parsing/parser.ml"
+# 31522 "parsing/parser.ml"
         ) = Obj.magic s in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_s_ in
         let _endpos = _endpos_xs_ in
-        let _v : (string list) = let x = 
-# 3888 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3940 "parsing/parser.mly"
     ( let body, _, _ = s in body )
-# 30882 "parsing/parser.ml"
-         in
-        
-# 223 "<standard.mly>"
+# 31531 "parsing/parser.ml"
+           in
+          (
+# 231 "<standard.mly>"
     ( x :: xs )
-# 30887 "parsing/parser.ml"
-         in
+# 31536 "parsing/parser.ml"
+           : (string list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30905,16 +31555,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_ty_ in
         let _endpos = _endpos_ty_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3917 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3969 "parsing/parser.mly"
                                                 ( Public )
-# 30912 "parsing/parser.ml"
-         in
-        
-# 3147 "parsing/parser.mly"
+# 31563 "parsing/parser.ml"
+           in
+          (
+# 3192 "parsing/parser.mly"
       ( (Ptype_abstract, priv, Some ty) )
-# 30917 "parsing/parser.ml"
-         in
+# 31568 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30942,16 +31594,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_ty_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3918 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3970 "parsing/parser.mly"
                                                 ( Private )
-# 30949 "parsing/parser.ml"
-         in
-        
-# 3147 "parsing/parser.mly"
+# 31602 "parsing/parser.ml"
+           in
+          (
+# 3192 "parsing/parser.mly"
       ( (Ptype_abstract, priv, Some ty) )
-# 30954 "parsing/parser.ml"
-         in
+# 31607 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -30972,28 +31626,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_cs_ in
         let _endpos = _endpos_cs_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3917 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3969 "parsing/parser.mly"
                                                 ( Public )
-# 30979 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 30985 "parsing/parser.ml"
+# 31634 "parsing/parser.ml"
            in
-          
-# 3163 "parsing/parser.mly"
+          let oty =
+            let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 31640 "parsing/parser.ml"
+             in
+            
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 30990 "parsing/parser.ml"
-          
-        in
-        
-# 3151 "parsing/parser.mly"
+# 31645 "parsing/parser.ml"
+            
+          in
+          (
+# 3196 "parsing/parser.mly"
       ( (Ptype_variant cs, priv, oty) )
-# 30996 "parsing/parser.ml"
-         in
+# 31651 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31021,28 +31677,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_cs_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3918 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3970 "parsing/parser.mly"
                                                 ( Private )
-# 31028 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 31034 "parsing/parser.ml"
+# 31685 "parsing/parser.ml"
            in
-          
-# 3163 "parsing/parser.mly"
+          let oty =
+            let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 31691 "parsing/parser.ml"
+             in
+            
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31039 "parsing/parser.ml"
-          
-        in
-        
-# 3151 "parsing/parser.mly"
+# 31696 "parsing/parser.ml"
+            
+          in
+          (
+# 3196 "parsing/parser.mly"
       ( (Ptype_variant cs, priv, oty) )
-# 31045 "parsing/parser.ml"
-         in
+# 31702 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31077,35 +31735,37 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_cs_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3917 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3969 "parsing/parser.mly"
                                                 ( Public )
-# 31084 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 =
-            let x = 
-# 191 "<standard.mly>"
+# 31743 "parsing/parser.ml"
+           in
+          let oty =
+            let _1 =
+              let x = 
+# 196 "<standard.mly>"
     ( x )
-# 31091 "parsing/parser.ml"
-             in
-            
+# 31750 "parsing/parser.ml"
+               in
+              
 # 126 "<standard.mly>"
     ( Some x )
-# 31096 "parsing/parser.ml"
+# 31755 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3163 "parsing/parser.mly"
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31102 "parsing/parser.ml"
-          
-        in
-        
-# 3151 "parsing/parser.mly"
+# 31761 "parsing/parser.ml"
+            
+          in
+          (
+# 3196 "parsing/parser.mly"
       ( (Ptype_variant cs, priv, oty) )
-# 31108 "parsing/parser.ml"
-         in
+# 31767 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31147,35 +31807,37 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_cs_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3918 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3970 "parsing/parser.mly"
                                                 ( Private )
-# 31154 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 =
-            let x = 
-# 191 "<standard.mly>"
+# 31815 "parsing/parser.ml"
+           in
+          let oty =
+            let _1 =
+              let x = 
+# 196 "<standard.mly>"
     ( x )
-# 31161 "parsing/parser.ml"
-             in
-            
+# 31822 "parsing/parser.ml"
+               in
+              
 # 126 "<standard.mly>"
     ( Some x )
-# 31166 "parsing/parser.ml"
+# 31827 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3163 "parsing/parser.mly"
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31172 "parsing/parser.ml"
-          
-        in
-        
-# 3151 "parsing/parser.mly"
+# 31833 "parsing/parser.ml"
+            
+          in
+          (
+# 3196 "parsing/parser.mly"
       ( (Ptype_variant cs, priv, oty) )
-# 31178 "parsing/parser.ml"
-         in
+# 31839 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31196,28 +31858,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__3_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3917 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3969 "parsing/parser.mly"
                                                 ( Public )
-# 31203 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 31209 "parsing/parser.ml"
+# 31866 "parsing/parser.ml"
            in
-          
-# 3163 "parsing/parser.mly"
+          let oty =
+            let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 31872 "parsing/parser.ml"
+             in
+            
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31214 "parsing/parser.ml"
-          
-        in
-        
-# 3155 "parsing/parser.mly"
+# 31877 "parsing/parser.ml"
+            
+          in
+          (
+# 3200 "parsing/parser.mly"
       ( (Ptype_open, priv, oty) )
-# 31220 "parsing/parser.ml"
-         in
+# 31883 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31245,28 +31909,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3918 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3970 "parsing/parser.mly"
                                                 ( Private )
-# 31252 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 31258 "parsing/parser.ml"
+# 31917 "parsing/parser.ml"
            in
-          
-# 3163 "parsing/parser.mly"
+          let oty =
+            let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 31923 "parsing/parser.ml"
+             in
+            
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31263 "parsing/parser.ml"
-          
-        in
-        
-# 3155 "parsing/parser.mly"
+# 31928 "parsing/parser.ml"
+            
+          in
+          (
+# 3200 "parsing/parser.mly"
       ( (Ptype_open, priv, oty) )
-# 31269 "parsing/parser.ml"
-         in
+# 31934 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31301,35 +31967,37 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3917 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3969 "parsing/parser.mly"
                                                 ( Public )
-# 31308 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 =
-            let x = 
-# 191 "<standard.mly>"
+# 31975 "parsing/parser.ml"
+           in
+          let oty =
+            let _1 =
+              let x = 
+# 196 "<standard.mly>"
     ( x )
-# 31315 "parsing/parser.ml"
-             in
-            
+# 31982 "parsing/parser.ml"
+               in
+              
 # 126 "<standard.mly>"
     ( Some x )
-# 31320 "parsing/parser.ml"
+# 31987 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3163 "parsing/parser.mly"
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31326 "parsing/parser.ml"
-          
-        in
-        
-# 3155 "parsing/parser.mly"
+# 31993 "parsing/parser.ml"
+            
+          in
+          (
+# 3200 "parsing/parser.mly"
       ( (Ptype_open, priv, oty) )
-# 31332 "parsing/parser.ml"
-         in
+# 31999 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31371,35 +32039,37 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3918 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3970 "parsing/parser.mly"
                                                 ( Private )
-# 31378 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 =
-            let x = 
-# 191 "<standard.mly>"
+# 32047 "parsing/parser.ml"
+           in
+          let oty =
+            let _1 =
+              let x = 
+# 196 "<standard.mly>"
     ( x )
-# 31385 "parsing/parser.ml"
-             in
-            
+# 32054 "parsing/parser.ml"
+               in
+              
 # 126 "<standard.mly>"
     ( Some x )
-# 31390 "parsing/parser.ml"
+# 32059 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3163 "parsing/parser.mly"
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31396 "parsing/parser.ml"
-          
-        in
-        
-# 3155 "parsing/parser.mly"
+# 32065 "parsing/parser.ml"
+            
+          in
+          (
+# 3200 "parsing/parser.mly"
       ( (Ptype_open, priv, oty) )
-# 31402 "parsing/parser.ml"
-         in
+# 32071 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31434,28 +32104,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__3_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3917 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3969 "parsing/parser.mly"
                                                 ( Public )
-# 31441 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 31447 "parsing/parser.ml"
+# 32112 "parsing/parser.ml"
            in
-          
-# 3163 "parsing/parser.mly"
+          let oty =
+            let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 32118 "parsing/parser.ml"
+             in
+            
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31452 "parsing/parser.ml"
-          
-        in
-        
-# 3159 "parsing/parser.mly"
+# 32123 "parsing/parser.ml"
+            
+          in
+          (
+# 3204 "parsing/parser.mly"
       ( (Ptype_record ls, priv, oty) )
-# 31458 "parsing/parser.ml"
-         in
+# 32129 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31497,28 +32169,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3918 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3970 "parsing/parser.mly"
                                                 ( Private )
-# 31504 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 31510 "parsing/parser.ml"
+# 32177 "parsing/parser.ml"
            in
-          
-# 3163 "parsing/parser.mly"
+          let oty =
+            let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 32183 "parsing/parser.ml"
+             in
+            
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31515 "parsing/parser.ml"
-          
-        in
-        
-# 3159 "parsing/parser.mly"
+# 32188 "parsing/parser.ml"
+            
+          in
+          (
+# 3204 "parsing/parser.mly"
       ( (Ptype_record ls, priv, oty) )
-# 31521 "parsing/parser.ml"
-         in
+# 32194 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31567,35 +32241,37 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3917 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3969 "parsing/parser.mly"
                                                 ( Public )
-# 31574 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 =
-            let x = 
-# 191 "<standard.mly>"
+# 32249 "parsing/parser.ml"
+           in
+          let oty =
+            let _1 =
+              let x = 
+# 196 "<standard.mly>"
     ( x )
-# 31581 "parsing/parser.ml"
-             in
-            
+# 32256 "parsing/parser.ml"
+               in
+              
 # 126 "<standard.mly>"
     ( Some x )
-# 31586 "parsing/parser.ml"
+# 32261 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3163 "parsing/parser.mly"
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31592 "parsing/parser.ml"
-          
-        in
-        
-# 3159 "parsing/parser.mly"
+# 32267 "parsing/parser.ml"
+            
+          in
+          (
+# 3204 "parsing/parser.mly"
       ( (Ptype_record ls, priv, oty) )
-# 31598 "parsing/parser.ml"
-         in
+# 32273 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31651,35 +32327,37 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv = 
-# 3918 "parsing/parser.mly"
+        let _v =
+          let priv = 
+# 3970 "parsing/parser.mly"
                                                 ( Private )
-# 31658 "parsing/parser.ml"
-         in
-        let oty =
-          let _1 =
-            let x = 
-# 191 "<standard.mly>"
+# 32335 "parsing/parser.ml"
+           in
+          let oty =
+            let _1 =
+              let x = 
+# 196 "<standard.mly>"
     ( x )
-# 31665 "parsing/parser.ml"
-             in
-            
+# 32342 "parsing/parser.ml"
+               in
+              
 # 126 "<standard.mly>"
     ( Some x )
-# 31670 "parsing/parser.ml"
+# 32347 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3163 "parsing/parser.mly"
+# 3208 "parsing/parser.mly"
     ( _1 )
-# 31676 "parsing/parser.ml"
-          
-        in
-        
-# 3159 "parsing/parser.mly"
+# 32353 "parsing/parser.ml"
+            
+          in
+          (
+# 3204 "parsing/parser.mly"
       ( (Ptype_record ls, priv, oty) )
-# 31682 "parsing/parser.ml"
-         in
+# 32359 "parsing/parser.ml"
+           : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31714,27 +32392,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 = 
-# 3581 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3626 "parsing/parser.mly"
         ( let (f, c) = meth_list in Ptyp_object (f, c) )
-# 31722 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 32401 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 31731 "parsing/parser.ml"
-          
-        in
-        
-# 3585 "parsing/parser.mly"
+# 32410 "parsing/parser.ml"
+            
+          in
+          (
+# 3630 "parsing/parser.mly"
   ( _1 )
-# 31737 "parsing/parser.ml"
-         in
+# 32416 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31762,27 +32442,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 = 
-# 3583 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3628 "parsing/parser.mly"
         ( Ptyp_object ([], Closed) )
-# 31770 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 32451 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 31779 "parsing/parser.ml"
-          
-        in
-        
-# 3585 "parsing/parser.mly"
+# 32460 "parsing/parser.ml"
+            
+          in
+          (
+# 3630 "parsing/parser.mly"
   ( _1 )
-# 31785 "parsing/parser.ml"
-         in
+# 32466 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31831,41 +32513,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 =
-          let _1 = _1_inlined2 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined2 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 31840 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined2_ in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 32523 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined2_ in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 31849 "parsing/parser.ml"
-          
-        in
-        let override = 
-# 3964 "parsing/parser.mly"
+# 32532 "parsing/parser.ml"
+            
+          in
+          let override = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 31855 "parsing/parser.ml"
-         in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1656 "parsing/parser.mly"
+# 32538 "parsing/parser.ml"
+           in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1680 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Opn.mk me ~override ~attrs ~loc ~docs, ext
   )
-# 31868 "parsing/parser.ml"
-         in
+# 32551 "parsing/parser.ml"
+           : (Parsetree.open_declaration * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -31921,41 +32605,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 =
-          let _1 = _1_inlined3 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 31930 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined3_ in
-        let attrs1 =
-          let _1 = _1_inlined2 in
-          
-# 4062 "parsing/parser.mly"
+# 32615 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined3_ in
+          let attrs1 =
+            let _1 = _1_inlined2 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 31939 "parsing/parser.ml"
-          
-        in
-        let override = 
-# 3965 "parsing/parser.mly"
+# 32624 "parsing/parser.ml"
+            
+          in
+          let override = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 31945 "parsing/parser.ml"
-         in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1656 "parsing/parser.mly"
+# 32630 "parsing/parser.ml"
+           in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1680 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Opn.mk me ~override ~attrs ~loc ~docs, ext
   )
-# 31958 "parsing/parser.ml"
-         in
+# 32643 "parsing/parser.ml"
+           : (Parsetree.open_declaration * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32004,52 +32690,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 =
-          let _1 = _1_inlined3 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 32013 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined3_ in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 32700 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined3_ in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 32025 "parsing/parser.ml"
-          
-        in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 32712 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 32033 "parsing/parser.ml"
-          
-        in
-        let override = 
-# 3964 "parsing/parser.mly"
+# 32720 "parsing/parser.ml"
+            
+          in
+          let override = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 32039 "parsing/parser.ml"
-         in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1671 "parsing/parser.mly"
+# 32726 "parsing/parser.ml"
+           in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1695 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Opn.mk id ~override ~attrs ~loc ~docs, ext
   )
-# 32052 "parsing/parser.ml"
-         in
+# 32739 "parsing/parser.ml"
+           : (Parsetree.open_description * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32105,52 +32793,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 =
-          let _1 = _1_inlined4 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined4 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 32114 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined4_ in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 32803 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined4_ in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 32126 "parsing/parser.ml"
-          
-        in
-        let attrs1 =
-          let _1 = _1_inlined2 in
-          
-# 4062 "parsing/parser.mly"
+# 32815 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined2 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 32134 "parsing/parser.ml"
-          
-        in
-        let override = 
-# 3965 "parsing/parser.mly"
+# 32823 "parsing/parser.ml"
+            
+          in
+          let override = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 32140 "parsing/parser.ml"
-         in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1671 "parsing/parser.mly"
+# 32829 "parsing/parser.ml"
+           in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1695 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Opn.mk id ~override ~attrs ~loc ~docs, ext
   )
-# 32153 "parsing/parser.ml"
-         in
+# 32842 "parsing/parser.ml"
+           : (Parsetree.open_description * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32168,17 +32858,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 802 "parsing/parser.mly"
+# 821 "parsing/parser.mly"
        (string)
-# 32174 "parsing/parser.ml"
+# 32864 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3756 "parsing/parser.mly"
+# 3808 "parsing/parser.mly"
                                                 ( _1 )
-# 32182 "parsing/parser.ml"
+# 32872 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32197,17 +32887,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 760 "parsing/parser.mly"
+# 779 "parsing/parser.mly"
        (string)
-# 32203 "parsing/parser.ml"
+# 32893 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3757 "parsing/parser.mly"
+# 3809 "parsing/parser.mly"
                                                 ( _1 )
-# 32211 "parsing/parser.ml"
+# 32901 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32226,17 +32916,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 761 "parsing/parser.mly"
+# 780 "parsing/parser.mly"
        (string)
-# 32232 "parsing/parser.ml"
+# 32922 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3758 "parsing/parser.mly"
+# 3810 "parsing/parser.mly"
                                                 ( _1 )
-# 32240 "parsing/parser.ml"
+# 32930 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32276,17 +32966,17 @@ module Tables = struct
         let _3 : (string) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 32282 "parsing/parser.ml"
+# 32972 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
         let _v : (Asttypes.label) = 
-# 3759 "parsing/parser.mly"
+# 3811 "parsing/parser.mly"
                                                 ( "."^ _1 ^"(" ^ _3 ^ ")" )
-# 32290 "parsing/parser.ml"
+# 32980 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32333,17 +33023,17 @@ module Tables = struct
         let _3 : (string) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 32339 "parsing/parser.ml"
+# 33029 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
         let _v : (Asttypes.label) = 
-# 3760 "parsing/parser.mly"
+# 3812 "parsing/parser.mly"
                                                 ( "."^ _1 ^ "(" ^ _3 ^ ")<-" )
-# 32347 "parsing/parser.ml"
+# 33037 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32383,17 +33073,17 @@ module Tables = struct
         let _3 : (string) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 32389 "parsing/parser.ml"
+# 33079 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
         let _v : (Asttypes.label) = 
-# 3761 "parsing/parser.mly"
+# 3813 "parsing/parser.mly"
                                                 ( "."^ _1 ^"[" ^ _3 ^ "]" )
-# 32397 "parsing/parser.ml"
+# 33087 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32440,17 +33130,17 @@ module Tables = struct
         let _3 : (string) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 32446 "parsing/parser.ml"
+# 33136 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
         let _v : (Asttypes.label) = 
-# 3762 "parsing/parser.mly"
+# 3814 "parsing/parser.mly"
                                                 ( "."^ _1 ^ "[" ^ _3 ^ "]<-" )
-# 32454 "parsing/parser.ml"
+# 33144 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32490,17 +33180,17 @@ module Tables = struct
         let _3 : (string) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 32496 "parsing/parser.ml"
+# 33186 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
         let _v : (Asttypes.label) = 
-# 3763 "parsing/parser.mly"
+# 3815 "parsing/parser.mly"
                                                 ( "."^ _1 ^"{" ^ _3 ^ "}" )
-# 32504 "parsing/parser.ml"
+# 33194 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32547,17 +33237,17 @@ module Tables = struct
         let _3 : (string) = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 32553 "parsing/parser.ml"
+# 33243 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
         let _v : (Asttypes.label) = 
-# 3764 "parsing/parser.mly"
+# 3816 "parsing/parser.mly"
                                                 ( "."^ _1 ^ "{" ^ _3 ^ "}<-" )
-# 32561 "parsing/parser.ml"
+# 33251 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32576,17 +33266,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 813 "parsing/parser.mly"
+# 832 "parsing/parser.mly"
        (string)
-# 32582 "parsing/parser.ml"
+# 33272 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3765 "parsing/parser.mly"
+# 3817 "parsing/parser.mly"
                                                 ( _1 )
-# 32590 "parsing/parser.ml"
+# 33280 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32609,9 +33299,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3766 "parsing/parser.mly"
+# 3818 "parsing/parser.mly"
                                                 ( "!" )
-# 32615 "parsing/parser.ml"
+# 33305 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -32630,23 +33320,25 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let op : (
-# 754 "parsing/parser.mly"
+# 773 "parsing/parser.mly"
        (string)
-# 32636 "parsing/parser.ml"
+# 33326 "parsing/parser.ml"
         ) = Obj.magic op in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_op_ in
         let _endpos = _endpos_op_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3770 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3822 "parsing/parser.mly"
                   ( op )
-# 32644 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33335 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32649 "parsing/parser.ml"
-         in
+# 33340 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32664,23 +33356,25 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let op : (
-# 755 "parsing/parser.mly"
+# 774 "parsing/parser.mly"
        (string)
-# 32670 "parsing/parser.ml"
+# 33362 "parsing/parser.ml"
         ) = Obj.magic op in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_op_ in
         let _endpos = _endpos_op_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3771 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3823 "parsing/parser.mly"
                   ( op )
-# 32678 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33371 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32683 "parsing/parser.ml"
-         in
+# 33376 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32698,23 +33392,25 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let op : (
-# 756 "parsing/parser.mly"
+# 775 "parsing/parser.mly"
        (string)
-# 32704 "parsing/parser.ml"
+# 33398 "parsing/parser.ml"
         ) = Obj.magic op in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_op_ in
         let _endpos = _endpos_op_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3772 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3824 "parsing/parser.mly"
                   ( op )
-# 32712 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33407 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32717 "parsing/parser.ml"
-         in
+# 33412 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32732,23 +33428,25 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let op : (
-# 757 "parsing/parser.mly"
+# 776 "parsing/parser.mly"
        (string)
-# 32738 "parsing/parser.ml"
+# 33434 "parsing/parser.ml"
         ) = Obj.magic op in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_op_ in
         let _endpos = _endpos_op_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3773 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3825 "parsing/parser.mly"
                   ( op )
-# 32746 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33443 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32751 "parsing/parser.ml"
-         in
+# 33448 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32766,23 +33464,25 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let op : (
-# 758 "parsing/parser.mly"
+# 777 "parsing/parser.mly"
        (string)
-# 32772 "parsing/parser.ml"
+# 33470 "parsing/parser.ml"
         ) = Obj.magic op in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_op_ in
         let _endpos = _endpos_op_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3774 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3826 "parsing/parser.mly"
                   ( op )
-# 32780 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33479 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32785 "parsing/parser.ml"
-         in
+# 33484 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32803,16 +33503,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3775 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3827 "parsing/parser.mly"
                    ("+")
-# 32810 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33511 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32815 "parsing/parser.ml"
-         in
+# 33516 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32833,16 +33535,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3776 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3828 "parsing/parser.mly"
                   ("+.")
-# 32840 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33543 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32845 "parsing/parser.ml"
-         in
+# 33548 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32863,16 +33567,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3777 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3829 "parsing/parser.mly"
                   ("+=")
-# 32870 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33575 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32875 "parsing/parser.ml"
-         in
+# 33580 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32893,16 +33599,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3778 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3830 "parsing/parser.mly"
                    ("-")
-# 32900 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33607 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32905 "parsing/parser.ml"
-         in
+# 33612 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32923,16 +33631,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3779 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3831 "parsing/parser.mly"
                   ("-.")
-# 32930 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33639 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32935 "parsing/parser.ml"
-         in
+# 33644 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32953,16 +33663,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3780 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3832 "parsing/parser.mly"
                    ("*")
-# 32960 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33671 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32965 "parsing/parser.ml"
-         in
+# 33676 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -32983,16 +33695,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3781 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3833 "parsing/parser.mly"
                    ("%")
-# 32990 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33703 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 32995 "parsing/parser.ml"
-         in
+# 33708 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33013,16 +33727,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3782 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3834 "parsing/parser.mly"
                    ("=")
-# 33020 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33735 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 33025 "parsing/parser.ml"
-         in
+# 33740 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33043,16 +33759,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3783 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3835 "parsing/parser.mly"
                    ("<")
-# 33050 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33767 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 33055 "parsing/parser.ml"
-         in
+# 33772 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33073,16 +33791,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3784 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3836 "parsing/parser.mly"
                    (">")
-# 33080 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33799 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 33085 "parsing/parser.ml"
-         in
+# 33804 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33103,16 +33823,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3785 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3837 "parsing/parser.mly"
                   ("or")
-# 33110 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33831 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 33115 "parsing/parser.ml"
-         in
+# 33836 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33133,16 +33855,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3786 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3838 "parsing/parser.mly"
                   ("||")
-# 33140 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33863 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 33145 "parsing/parser.ml"
-         in
+# 33868 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33163,16 +33887,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3787 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3839 "parsing/parser.mly"
                    ("&")
-# 33170 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33895 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 33175 "parsing/parser.ml"
-         in
+# 33900 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33193,16 +33919,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3788 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3840 "parsing/parser.mly"
                   ("&&")
-# 33200 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33927 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 33205 "parsing/parser.ml"
-         in
+# 33932 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33223,16 +33951,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.label) = let _1 = 
-# 3789 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3841 "parsing/parser.mly"
                   (":=")
-# 33230 "parsing/parser.ml"
-         in
-        
-# 3767 "parsing/parser.mly"
+# 33959 "parsing/parser.ml"
+           in
+          (
+# 3819 "parsing/parser.mly"
                                                 ( _1 )
-# 33235 "parsing/parser.ml"
-         in
+# 33964 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33254,9 +33984,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (bool) = 
-# 3671 "parsing/parser.mly"
+# 3716 "parsing/parser.mly"
                                                 ( true )
-# 33260 "parsing/parser.ml"
+# 33990 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33272,9 +34002,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (bool) = 
-# 3672 "parsing/parser.mly"
+# 3717 "parsing/parser.mly"
                                                 ( false )
-# 33278 "parsing/parser.ml"
+# 34008 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33290,9 +34020,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (unit option) = 
-# 114 "<standard.mly>"
+# 111 "<standard.mly>"
     ( None )
-# 33296 "parsing/parser.ml"
+# 34026 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33315,9 +34045,9 @@ module Tables = struct
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
         let _v : (unit option) = 
-# 116 "<standard.mly>"
+# 114 "<standard.mly>"
     ( Some x )
-# 33321 "parsing/parser.ml"
+# 34051 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33333,9 +34063,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (unit option) = 
-# 114 "<standard.mly>"
+# 111 "<standard.mly>"
     ( None )
-# 33339 "parsing/parser.ml"
+# 34069 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33358,9 +34088,9 @@ module Tables = struct
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
         let _v : (unit option) = 
-# 116 "<standard.mly>"
+# 114 "<standard.mly>"
     ( Some x )
-# 33364 "parsing/parser.ml"
+# 34094 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33376,9 +34106,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (string Asttypes.loc option) = 
-# 114 "<standard.mly>"
+# 111 "<standard.mly>"
     ( None )
-# 33382 "parsing/parser.ml"
+# 34112 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33403,37 +34133,39 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 33409 "parsing/parser.ml"
+# 34139 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (string Asttypes.loc option) = let x =
+        let _v =
           let x =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+            let x =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 33424 "parsing/parser.ml"
+# 34155 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 183 "<standard.mly>"
+# 188 "<standard.mly>"
     ( x )
-# 33430 "parsing/parser.ml"
-          
-        in
-        
-# 116 "<standard.mly>"
+# 34161 "parsing/parser.ml"
+            
+          in
+          (
+# 114 "<standard.mly>"
     ( Some x )
-# 33436 "parsing/parser.ml"
-         in
+# 34167 "parsing/parser.ml"
+           : (string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33448,9 +34180,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.core_type option) = 
-# 114 "<standard.mly>"
+# 111 "<standard.mly>"
     ( None )
-# 33454 "parsing/parser.ml"
+# 34186 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33479,16 +34211,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.core_type option) = let x = 
-# 183 "<standard.mly>"
+        let _v =
+          let x = 
+# 188 "<standard.mly>"
     ( x )
-# 33486 "parsing/parser.ml"
-         in
-        
-# 116 "<standard.mly>"
+# 34219 "parsing/parser.ml"
+           in
+          (
+# 114 "<standard.mly>"
     ( Some x )
-# 33491 "parsing/parser.ml"
-         in
+# 34224 "parsing/parser.ml"
+           : (Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33503,9 +34237,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.core_type option) = 
-# 114 "<standard.mly>"
+# 111 "<standard.mly>"
     ( None )
-# 33509 "parsing/parser.ml"
+# 34243 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33534,16 +34268,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.core_type option) = let x = 
-# 183 "<standard.mly>"
+        let _v =
+          let x = 
+# 188 "<standard.mly>"
     ( x )
-# 33541 "parsing/parser.ml"
-         in
-        
-# 116 "<standard.mly>"
+# 34276 "parsing/parser.ml"
+           in
+          (
+# 114 "<standard.mly>"
     ( Some x )
-# 33546 "parsing/parser.ml"
-         in
+# 34281 "parsing/parser.ml"
+           : (Parsetree.core_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33558,9 +34294,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.expression option) = 
-# 114 "<standard.mly>"
+# 111 "<standard.mly>"
     ( None )
-# 33564 "parsing/parser.ml"
+# 34300 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33589,31 +34325,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression option) = let x =
+        let _v =
           let x =
-            let _1 = _1_inlined1 in
-            let _1 = 
-# 2287 "parsing/parser.mly"
+            let x =
+              let _1 = _1_inlined1 in
+              let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 33599 "parsing/parser.ml"
-             in
-            
-# 2431 "parsing/parser.mly"
+# 34336 "parsing/parser.ml"
+               in
+              
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 33604 "parsing/parser.ml"
+# 34341 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 183 "<standard.mly>"
+# 188 "<standard.mly>"
     ( x )
-# 33610 "parsing/parser.ml"
-          
-        in
-        
-# 116 "<standard.mly>"
+# 34347 "parsing/parser.ml"
+            
+          in
+          (
+# 114 "<standard.mly>"
     ( Some x )
-# 33616 "parsing/parser.ml"
-         in
+# 34353 "parsing/parser.ml"
+           : (Parsetree.expression option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33662,51 +34400,52 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression option) = let x =
+        let _v =
           let x =
-            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-            let _1 =
-              let _3 =
-                let xs =
-                  let xs = 
-# 253 "<standard.mly>"
+            let x =
+              let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+              let _1 =
+                let _3 =
+                  let xs =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 33675 "parsing/parser.ml"
-                   in
+# 34414 "parsing/parser.ml"
+                     in
+                    
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 34419 "parsing/parser.ml"
+                    
+                  in
                   
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 33680 "parsing/parser.ml"
+# 34425 "parsing/parser.ml"
                   
                 in
-                
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 33686 "parsing/parser.ml"
-                
-              in
-              let _endpos__3_ = _endpos_xs_ in
-              let _2 =
-                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _endpos__3_ = _endpos_xs_ in
                 let _2 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _2 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 33697 "parsing/parser.ml"
+# 34436 "parsing/parser.ml"
+                    
+                  in
                   
-                in
-                
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 33703 "parsing/parser.ml"
+# 34442 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos__3_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos__3_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -33719,26 +34458,27 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 33723 "parsing/parser.ml"
+# 34462 "parsing/parser.ml"
+                
+              in
+              
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 34468 "parsing/parser.ml"
               
             in
             
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 33729 "parsing/parser.ml"
+# 188 "<standard.mly>"
+    ( x )
+# 34474 "parsing/parser.ml"
             
           in
-          
-# 183 "<standard.mly>"
-    ( x )
-# 33735 "parsing/parser.ml"
-          
-        in
-        
-# 116 "<standard.mly>"
+          (
+# 114 "<standard.mly>"
     ( Some x )
-# 33741 "parsing/parser.ml"
-         in
+# 34480 "parsing/parser.ml"
+           : (Parsetree.expression option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33753,9 +34493,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.module_type option) = 
-# 114 "<standard.mly>"
+# 111 "<standard.mly>"
     ( None )
-# 33759 "parsing/parser.ml"
+# 34499 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33784,16 +34524,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.module_type option) = let x = 
-# 183 "<standard.mly>"
+        let _v =
+          let x = 
+# 188 "<standard.mly>"
     ( x )
-# 33791 "parsing/parser.ml"
-         in
-        
-# 116 "<standard.mly>"
+# 34532 "parsing/parser.ml"
+           in
+          (
+# 114 "<standard.mly>"
     ( Some x )
-# 33796 "parsing/parser.ml"
-         in
+# 34537 "parsing/parser.ml"
+           : (Parsetree.module_type option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33808,9 +34550,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.pattern option) = 
-# 114 "<standard.mly>"
+# 111 "<standard.mly>"
     ( None )
-# 33814 "parsing/parser.ml"
+# 34556 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33839,16 +34581,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.pattern option) = let x = 
-# 183 "<standard.mly>"
+        let _v =
+          let x = 
+# 188 "<standard.mly>"
     ( x )
-# 33846 "parsing/parser.ml"
-         in
-        
-# 116 "<standard.mly>"
+# 34589 "parsing/parser.ml"
+           in
+          (
+# 114 "<standard.mly>"
     ( Some x )
-# 33851 "parsing/parser.ml"
-         in
+# 34594 "parsing/parser.ml"
+           : (Parsetree.pattern option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33863,9 +34607,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.expression option) = 
-# 114 "<standard.mly>"
+# 111 "<standard.mly>"
     ( None )
-# 33869 "parsing/parser.ml"
+# 34613 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33894,16 +34638,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.expression option) = let x = 
-# 183 "<standard.mly>"
+        let _v =
+          let x = 
+# 188 "<standard.mly>"
     ( x )
-# 33901 "parsing/parser.ml"
-         in
-        
-# 116 "<standard.mly>"
+# 34646 "parsing/parser.ml"
+           in
+          (
+# 114 "<standard.mly>"
     ( Some x )
-# 33906 "parsing/parser.ml"
-         in
+# 34651 "parsing/parser.ml"
+           : (Parsetree.expression option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -33918,9 +34664,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.type_constraint option) = 
-# 114 "<standard.mly>"
+# 111 "<standard.mly>"
     ( None )
-# 33924 "parsing/parser.ml"
+# 34670 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33943,9 +34689,9 @@ module Tables = struct
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
         let _v : (Parsetree.type_constraint option) = 
-# 116 "<standard.mly>"
+# 114 "<standard.mly>"
     ( Some x )
-# 33949 "parsing/parser.ml"
+# 34695 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -33964,17 +34710,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 795 "parsing/parser.mly"
+# 814 "parsing/parser.mly"
        (string)
-# 33970 "parsing/parser.ml"
+# 34716 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3976 "parsing/parser.mly"
+# 4028 "parsing/parser.mly"
                                                 ( _1 )
-# 33978 "parsing/parser.ml"
+# 34724 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -34006,18 +34752,18 @@ module Tables = struct
         } = _menhir_stack in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 34012 "parsing/parser.ml"
+# 34758 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (string) = 
-# 3977 "parsing/parser.mly"
+# 4029 "parsing/parser.mly"
                                                 ( _2 )
-# 34021 "parsing/parser.ml"
+# 34767 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -34067,14 +34813,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1433 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1457 "parsing/parser.mly"
       ( mkmod ~loc:_sloc (Pmod_constraint(me, mty)) )
-# 34077 "parsing/parser.ml"
-         in
+# 34824 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -34123,13 +34871,15 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1435 "parsing/parser.mly"
+        let _v =
+          let _loc__5_ = (_startpos__5_, _endpos__5_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1459 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 34132 "parsing/parser.ml"
-         in
+# 34881 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -34165,9 +34915,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.module_expr) = 
-# 1438 "parsing/parser.mly"
+# 1462 "parsing/parser.mly"
       ( me (* TODO consider reloc *) )
-# 34171 "parsing/parser.ml"
+# 34921 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -34203,13 +34953,15 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.module_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1440 "parsing/parser.mly"
+        let _v =
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1464 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 34212 "parsing/parser.ml"
-         in
+# 34963 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -34258,42 +35010,44 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let e =
-          let _1 = _1_inlined2 in
+        let _v =
           let e =
-            let _1 = 
-# 2287 "parsing/parser.mly"
+            let _1 = _1_inlined2 in
+            let e =
+              let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 34268 "parsing/parser.ml"
-             in
-            
-# 2431 "parsing/parser.mly"
+# 35021 "parsing/parser.ml"
+               in
+              
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 34273 "parsing/parser.ml"
+# 35026 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 1457 "parsing/parser.mly"
+# 1481 "parsing/parser.mly"
       ( e )
-# 34279 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 35032 "parsing/parser.ml"
+            
+          in
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 34287 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1444 "parsing/parser.mly"
+# 35040 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1468 "parsing/parser.mly"
       ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 34296 "parsing/parser.ml"
-         in
+# 35049 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -34363,51 +35117,52 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let e =
-          let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
+        let _v =
           let e =
-            let _1 =
-              let _3 =
-                let xs =
-                  let xs = 
-# 253 "<standard.mly>"
+            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
+            let e =
+              let _1 =
+                let _3 =
+                  let xs =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 34376 "parsing/parser.ml"
-                   in
+# 35131 "parsing/parser.ml"
+                     in
+                    
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 35136 "parsing/parser.ml"
+                    
+                  in
                   
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 34381 "parsing/parser.ml"
+# 35142 "parsing/parser.ml"
                   
                 in
-                
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 34387 "parsing/parser.ml"
-                
-              in
-              let _endpos__3_ = _endpos_xs_ in
-              let _2 =
-                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _endpos__3_ = _endpos_xs_ in
                 let _2 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _2 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 34398 "parsing/parser.ml"
+# 35153 "parsing/parser.ml"
+                    
+                  in
                   
-                in
-                
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 34404 "parsing/parser.ml"
+# 35159 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos__3_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos__3_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -34420,37 +35175,38 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 34424 "parsing/parser.ml"
+# 35179 "parsing/parser.ml"
+                
+              in
+              
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 35185 "parsing/parser.ml"
               
             in
             
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 34430 "parsing/parser.ml"
+# 1481 "parsing/parser.mly"
+      ( e )
+# 35191 "parsing/parser.ml"
             
           in
-          
-# 1457 "parsing/parser.mly"
-      ( e )
-# 34436 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 34444 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1444 "parsing/parser.mly"
+# 35199 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1468 "parsing/parser.mly"
       ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 34453 "parsing/parser.ml"
-         in
+# 35208 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -34513,60 +35269,62 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let e =
-          let (_endpos__1_inlined1_, _startpos__1_inlined1_, _startpos__1_, _1_inlined1, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_inlined2_, _1_inlined3, _1_inlined2) in
-          let ty =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 3646 "parsing/parser.mly"
+        let _v =
+          let e =
+            let (_endpos__1_inlined1_, _startpos__1_inlined1_, _startpos__1_, _1_inlined1, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_inlined2_, _1_inlined3, _1_inlined2) in
+            let ty =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 34529 "parsing/parser.ml"
-            
-          in
-          let _endpos_ty_ = _endpos__1_inlined1_ in
-          let e =
-            let _1 = 
-# 2287 "parsing/parser.mly"
+# 35286 "parsing/parser.ml"
+              
+            in
+            let _endpos_ty_ = _endpos__1_inlined1_ in
+            let e =
+              let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 34537 "parsing/parser.ml"
-             in
-            
-# 2431 "parsing/parser.mly"
+# 35294 "parsing/parser.ml"
+               in
+              
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 34542 "parsing/parser.ml"
+# 35299 "parsing/parser.ml"
+              
+            in
+            let _startpos_e_ = _startpos__1_ in
+            let _endpos = _endpos_ty_ in
+            let _startpos = _startpos_e_ in
+            let _loc = (_startpos, _endpos) in
             
-          in
-          let _startpos_e_ = _startpos__1_ in
-          let _endpos = _endpos_ty_ in
-          let _startpos = _startpos_e_ in
-          let _loc = (_startpos, _endpos) in
-          
-# 1459 "parsing/parser.mly"
+# 1483 "parsing/parser.mly"
       ( ghexp ~loc:_loc (Pexp_constraint (e, ty)) )
-# 34552 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 35309 "parsing/parser.ml"
+            
+          in
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 34560 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1444 "parsing/parser.mly"
+# 35317 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1468 "parsing/parser.mly"
       ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 34569 "parsing/parser.ml"
-         in
+# 35326 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -34650,65 +35408,66 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let e =
-          let (_endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_, _1_inlined3, _1_inlined2, _1_inlined1) = (_endpos__1_inlined5_, _startpos__1_inlined5_, _startpos__1_inlined2_, _1_inlined5, _1_inlined4, _1_inlined3) in
-          let ty =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 3646 "parsing/parser.mly"
+        let _v =
+          let e =
+            let (_endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_, _1_inlined3, _1_inlined2, _1_inlined1) = (_endpos__1_inlined5_, _startpos__1_inlined5_, _startpos__1_inlined2_, _1_inlined5, _1_inlined4, _1_inlined3) in
+            let ty =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 34666 "parsing/parser.ml"
-            
-          in
-          let _endpos_ty_ = _endpos__1_inlined3_ in
-          let e =
-            let _1 =
-              let _3 =
-                let xs =
-                  let xs = 
-# 253 "<standard.mly>"
+# 35425 "parsing/parser.ml"
+              
+            in
+            let _endpos_ty_ = _endpos__1_inlined3_ in
+            let e =
+              let _1 =
+                let _3 =
+                  let xs =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 34677 "parsing/parser.ml"
-                   in
+# 35436 "parsing/parser.ml"
+                     in
+                    
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 35441 "parsing/parser.ml"
+                    
+                  in
                   
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 34682 "parsing/parser.ml"
+# 35447 "parsing/parser.ml"
                   
                 in
-                
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 34688 "parsing/parser.ml"
-                
-              in
-              let _endpos__3_ = _endpos_xs_ in
-              let _2 =
-                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _endpos__3_ = _endpos_xs_ in
                 let _2 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _2 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 34699 "parsing/parser.ml"
+# 35458 "parsing/parser.ml"
+                    
+                  in
                   
-                in
-                
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 34705 "parsing/parser.ml"
+# 35464 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos__3_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos__3_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -34721,41 +35480,42 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 34725 "parsing/parser.ml"
+# 35484 "parsing/parser.ml"
+                
+              in
+              
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 35490 "parsing/parser.ml"
               
             in
+            let _startpos_e_ = _startpos__1_ in
+            let _endpos = _endpos_ty_ in
+            let _startpos = _startpos_e_ in
+            let _loc = (_startpos, _endpos) in
             
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 34731 "parsing/parser.ml"
+# 1483 "parsing/parser.mly"
+      ( ghexp ~loc:_loc (Pexp_constraint (e, ty)) )
+# 35500 "parsing/parser.ml"
             
           in
-          let _startpos_e_ = _startpos__1_ in
-          let _endpos = _endpos_ty_ in
-          let _startpos = _startpos_e_ in
-          let _loc = (_startpos, _endpos) in
-          
-# 1459 "parsing/parser.mly"
-      ( ghexp ~loc:_loc (Pexp_constraint (e, ty)) )
-# 34741 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 34749 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1444 "parsing/parser.mly"
+# 35508 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1468 "parsing/parser.mly"
       ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 34758 "parsing/parser.ml"
-         in
+# 35517 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -34832,73 +35592,75 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let e =
-          let (_endpos__1_inlined2_, _startpos__1_inlined2_, _endpos__1_inlined1_, _startpos__1_inlined1_, _startpos__1_, _1_inlined2, _1_inlined1, _1) = (_endpos__1_inlined4_, _startpos__1_inlined4_, _endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_inlined2_, _1_inlined4, _1_inlined3, _1_inlined2) in
-          let ty2 =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 3646 "parsing/parser.mly"
+        let _v =
+          let e =
+            let (_endpos__1_inlined2_, _startpos__1_inlined2_, _endpos__1_inlined1_, _startpos__1_inlined1_, _startpos__1_, _1_inlined2, _1_inlined1, _1) = (_endpos__1_inlined4_, _startpos__1_inlined4_, _endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_inlined2_, _1_inlined4, _1_inlined3, _1_inlined2) in
+            let ty2 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 34848 "parsing/parser.ml"
-            
-          in
-          let _endpos_ty2_ = _endpos__1_inlined2_ in
-          let ty1 =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 3646 "parsing/parser.mly"
+# 35609 "parsing/parser.ml"
+              
+            in
+            let _endpos_ty2_ = _endpos__1_inlined2_ in
+            let ty1 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 34862 "parsing/parser.ml"
-            
-          in
-          let e =
-            let _1 = 
-# 2287 "parsing/parser.mly"
+# 35623 "parsing/parser.ml"
+              
+            in
+            let e =
+              let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 34869 "parsing/parser.ml"
-             in
-            
-# 2431 "parsing/parser.mly"
+# 35630 "parsing/parser.ml"
+               in
+              
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 34874 "parsing/parser.ml"
+# 35635 "parsing/parser.ml"
+              
+            in
+            let _startpos_e_ = _startpos__1_ in
+            let _endpos = _endpos_ty2_ in
+            let _startpos = _startpos_e_ in
+            let _loc = (_startpos, _endpos) in
             
-          in
-          let _startpos_e_ = _startpos__1_ in
-          let _endpos = _endpos_ty2_ in
-          let _startpos = _startpos_e_ in
-          let _loc = (_startpos, _endpos) in
-          
-# 1461 "parsing/parser.mly"
+# 1485 "parsing/parser.mly"
       ( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) )
-# 34884 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 35645 "parsing/parser.ml"
+            
+          in
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 34892 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1444 "parsing/parser.mly"
+# 35653 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1468 "parsing/parser.mly"
       ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 34901 "parsing/parser.ml"
-         in
+# 35662 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -34996,78 +35758,79 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let e =
-          let (_endpos__1_inlined4_, _startpos__1_inlined4_, _endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_, _1_inlined4, _1_inlined3, _1_inlined2, _1_inlined1) = (_endpos__1_inlined6_, _startpos__1_inlined6_, _endpos__1_inlined5_, _startpos__1_inlined5_, _startpos__1_inlined2_, _1_inlined6, _1_inlined5, _1_inlined4, _1_inlined3) in
-          let ty2 =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined4_, _startpos__1_inlined4_, _1_inlined4) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 3646 "parsing/parser.mly"
+        let _v =
+          let e =
+            let (_endpos__1_inlined4_, _startpos__1_inlined4_, _endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_, _1_inlined4, _1_inlined3, _1_inlined2, _1_inlined1) = (_endpos__1_inlined6_, _startpos__1_inlined6_, _endpos__1_inlined5_, _startpos__1_inlined5_, _startpos__1_inlined2_, _1_inlined6, _1_inlined5, _1_inlined4, _1_inlined3) in
+            let ty2 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined4_, _startpos__1_inlined4_, _1_inlined4) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 35012 "parsing/parser.ml"
-            
-          in
-          let _endpos_ty2_ = _endpos__1_inlined4_ in
-          let ty1 =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 3646 "parsing/parser.mly"
+# 35775 "parsing/parser.ml"
+              
+            in
+            let _endpos_ty2_ = _endpos__1_inlined4_ in
+            let ty1 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 35026 "parsing/parser.ml"
-            
-          in
-          let e =
-            let _1 =
-              let _3 =
-                let xs =
-                  let xs = 
-# 253 "<standard.mly>"
+# 35789 "parsing/parser.ml"
+              
+            in
+            let e =
+              let _1 =
+                let _3 =
+                  let xs =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 35036 "parsing/parser.ml"
-                   in
+# 35799 "parsing/parser.ml"
+                     in
+                    
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 35804 "parsing/parser.ml"
+                    
+                  in
                   
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 35041 "parsing/parser.ml"
+# 35810 "parsing/parser.ml"
                   
                 in
-                
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 35047 "parsing/parser.ml"
-                
-              in
-              let _endpos__3_ = _endpos_xs_ in
-              let _2 =
-                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _endpos__3_ = _endpos_xs_ in
                 let _2 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _2 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35058 "parsing/parser.ml"
+# 35821 "parsing/parser.ml"
+                    
+                  in
                   
-                in
-                
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 35064 "parsing/parser.ml"
+# 35827 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos__3_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos__3_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -35080,41 +35843,42 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 35084 "parsing/parser.ml"
+# 35847 "parsing/parser.ml"
+                
+              in
+              
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 35853 "parsing/parser.ml"
               
             in
+            let _startpos_e_ = _startpos__1_ in
+            let _endpos = _endpos_ty2_ in
+            let _startpos = _startpos_e_ in
+            let _loc = (_startpos, _endpos) in
             
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 35090 "parsing/parser.ml"
+# 1485 "parsing/parser.mly"
+      ( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) )
+# 35863 "parsing/parser.ml"
             
           in
-          let _startpos_e_ = _startpos__1_ in
-          let _endpos = _endpos_ty2_ in
-          let _startpos = _startpos_e_ in
-          let _loc = (_startpos, _endpos) in
-          
-# 1461 "parsing/parser.mly"
-      ( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) )
-# 35100 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35108 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1444 "parsing/parser.mly"
+# 35871 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1468 "parsing/parser.mly"
       ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 35117 "parsing/parser.ml"
-         in
+# 35880 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -35177,60 +35941,62 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let e =
-          let (_endpos__1_inlined1_, _startpos__1_inlined1_, _startpos__1_, _1_inlined1, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_inlined2_, _1_inlined3, _1_inlined2) in
-          let ty2 =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 3646 "parsing/parser.mly"
+        let _v =
+          let e =
+            let (_endpos__1_inlined1_, _startpos__1_inlined1_, _startpos__1_, _1_inlined1, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_inlined2_, _1_inlined3, _1_inlined2) in
+            let ty2 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 35193 "parsing/parser.ml"
-            
-          in
-          let _endpos_ty2_ = _endpos__1_inlined1_ in
-          let e =
-            let _1 = 
-# 2287 "parsing/parser.mly"
+# 35958 "parsing/parser.ml"
+              
+            in
+            let _endpos_ty2_ = _endpos__1_inlined1_ in
+            let e =
+              let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 35201 "parsing/parser.ml"
-             in
-            
-# 2431 "parsing/parser.mly"
+# 35966 "parsing/parser.ml"
+               in
+              
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 35206 "parsing/parser.ml"
+# 35971 "parsing/parser.ml"
+              
+            in
+            let _startpos_e_ = _startpos__1_ in
+            let _endpos = _endpos_ty2_ in
+            let _startpos = _startpos_e_ in
+            let _loc = (_startpos, _endpos) in
             
-          in
-          let _startpos_e_ = _startpos__1_ in
-          let _endpos = _endpos_ty2_ in
-          let _startpos = _startpos_e_ in
-          let _loc = (_startpos, _endpos) in
-          
-# 1463 "parsing/parser.mly"
+# 1487 "parsing/parser.mly"
       ( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) )
-# 35216 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 35981 "parsing/parser.ml"
+            
+          in
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35224 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1444 "parsing/parser.mly"
+# 35989 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1468 "parsing/parser.mly"
       ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 35233 "parsing/parser.ml"
-         in
+# 35998 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -35314,65 +36080,66 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let e =
-          let (_endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_, _1_inlined3, _1_inlined2, _1_inlined1) = (_endpos__1_inlined5_, _startpos__1_inlined5_, _startpos__1_inlined2_, _1_inlined5, _1_inlined4, _1_inlined3) in
-          let ty2 =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 3646 "parsing/parser.mly"
+        let _v =
+          let e =
+            let (_endpos__1_inlined3_, _startpos__1_inlined3_, _startpos__1_, _1_inlined3, _1_inlined2, _1_inlined1) = (_endpos__1_inlined5_, _startpos__1_inlined5_, _startpos__1_inlined2_, _1_inlined5, _1_inlined4, _1_inlined3) in
+            let ty2 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 35330 "parsing/parser.ml"
-            
-          in
-          let _endpos_ty2_ = _endpos__1_inlined3_ in
-          let e =
-            let _1 =
-              let _3 =
-                let xs =
-                  let xs = 
-# 253 "<standard.mly>"
+# 36097 "parsing/parser.ml"
+              
+            in
+            let _endpos_ty2_ = _endpos__1_inlined3_ in
+            let e =
+              let _1 =
+                let _3 =
+                  let xs =
+                    let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 35341 "parsing/parser.ml"
-                   in
+# 36108 "parsing/parser.ml"
+                     in
+                    
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 36113 "parsing/parser.ml"
+                    
+                  in
                   
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 35346 "parsing/parser.ml"
+# 36119 "parsing/parser.ml"
                   
                 in
-                
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 35352 "parsing/parser.ml"
-                
-              in
-              let _endpos__3_ = _endpos_xs_ in
-              let _2 =
-                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _endpos__3_ = _endpos_xs_ in
                 let _2 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+                  let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                  let _2 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35363 "parsing/parser.ml"
+# 36130 "parsing/parser.ml"
+                    
+                  in
                   
-                in
-                
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 35369 "parsing/parser.ml"
+# 36136 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos__3_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos__3_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -35385,41 +36152,42 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 35389 "parsing/parser.ml"
+# 36156 "parsing/parser.ml"
+                
+              in
+              
+# 2453 "parsing/parser.mly"
+                          ( _1 )
+# 36162 "parsing/parser.ml"
               
             in
+            let _startpos_e_ = _startpos__1_ in
+            let _endpos = _endpos_ty2_ in
+            let _startpos = _startpos_e_ in
+            let _loc = (_startpos, _endpos) in
             
-# 2431 "parsing/parser.mly"
-                          ( _1 )
-# 35395 "parsing/parser.ml"
+# 1487 "parsing/parser.mly"
+      ( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) )
+# 36172 "parsing/parser.ml"
             
           in
-          let _startpos_e_ = _startpos__1_ in
-          let _endpos = _endpos_ty2_ in
-          let _startpos = _startpos_e_ in
-          let _loc = (_startpos, _endpos) in
-          
-# 1463 "parsing/parser.mly"
-      ( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) )
-# 35405 "parsing/parser.ml"
-          
-        in
-        let attrs =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+          let attrs =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35413 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1444 "parsing/parser.mly"
+# 36180 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1468 "parsing/parser.mly"
       ( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 35422 "parsing/parser.ml"
-         in
+# 36189 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -35475,34 +36243,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : (Parsetree.module_expr) = let _4 =
-          let _1 = _1_inlined2 in
-          let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined2 in
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 35484 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 36253 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 35489 "parsing/parser.ml"
-          
-        in
-        let _3 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 36258 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35497 "parsing/parser.ml"
-          
-        in
-        let _loc__6_ = (_startpos__6_, _endpos__6_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1446 "parsing/parser.mly"
+# 36266 "parsing/parser.ml"
+            
+          in
+          let _loc__6_ = (_startpos__6_, _endpos__6_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1470 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 35505 "parsing/parser.ml"
-         in
+# 36274 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -35579,50 +36349,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : (Parsetree.module_expr) = let _4 =
-          let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _4 =
+            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 35591 "parsing/parser.ml"
-                 in
+# 36362 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 36367 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 35596 "parsing/parser.ml"
+# 36373 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 35602 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35613 "parsing/parser.ml"
+# 36384 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 35619 "parsing/parser.ml"
+# 36390 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -35635,30 +36406,31 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 35639 "parsing/parser.ml"
+# 36410 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 35645 "parsing/parser.ml"
-          
-        in
-        let _3 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 36416 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35653 "parsing/parser.ml"
-          
-        in
-        let _loc__6_ = (_startpos__6_, _endpos__6_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1446 "parsing/parser.mly"
+# 36424 "parsing/parser.ml"
+            
+          in
+          let _loc__6_ = (_startpos__6_, _endpos__6_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1470 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 35661 "parsing/parser.ml"
-         in
+# 36432 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -35714,34 +36486,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : (Parsetree.module_expr) = let _4 =
-          let _1 = _1_inlined2 in
-          let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined2 in
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 35723 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 36496 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 35728 "parsing/parser.ml"
-          
-        in
-        let _3 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 36501 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35736 "parsing/parser.ml"
-          
-        in
-        let _loc__6_ = (_startpos__6_, _endpos__6_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1448 "parsing/parser.mly"
+# 36509 "parsing/parser.ml"
+            
+          in
+          let _loc__6_ = (_startpos__6_, _endpos__6_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1472 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 35744 "parsing/parser.ml"
-         in
+# 36517 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -35818,50 +36592,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : (Parsetree.module_expr) = let _4 =
-          let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _4 =
+            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 35830 "parsing/parser.ml"
-                 in
+# 36605 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 36610 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 35835 "parsing/parser.ml"
+# 36616 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 35841 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35852 "parsing/parser.ml"
+# 36627 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 35858 "parsing/parser.ml"
+# 36633 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -35874,30 +36649,31 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 35878 "parsing/parser.ml"
+# 36653 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 35884 "parsing/parser.ml"
-          
-        in
-        let _3 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 36659 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35892 "parsing/parser.ml"
-          
-        in
-        let _loc__6_ = (_startpos__6_, _endpos__6_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1448 "parsing/parser.mly"
+# 36667 "parsing/parser.ml"
+            
+          in
+          let _loc__6_ = (_startpos__6_, _endpos__6_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1472 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 35900 "parsing/parser.ml"
-         in
+# 36675 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -35946,34 +36722,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let _4 =
-          let _1 = _1_inlined2 in
-          let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let _1 = _1_inlined2 in
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 35955 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 36732 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 35960 "parsing/parser.ml"
-          
-        in
-        let _3 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 36737 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 35968 "parsing/parser.ml"
-          
-        in
-        let _loc__5_ = (_startpos__5_, _endpos__5_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1450 "parsing/parser.mly"
+# 36745 "parsing/parser.ml"
+            
+          in
+          let _loc__5_ = (_startpos__5_, _endpos__5_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1474 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 35976 "parsing/parser.ml"
-         in
+# 36753 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36043,50 +36821,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.module_expr) = let _4 =
-          let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _4 =
+            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined2_, _1_inlined4, _1_inlined3) in
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 36055 "parsing/parser.ml"
-                 in
+# 36834 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 36839 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 36060 "parsing/parser.ml"
+# 36845 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 36066 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 36077 "parsing/parser.ml"
+# 36856 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 36083 "parsing/parser.ml"
+# 36862 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -36099,30 +36878,31 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 36103 "parsing/parser.ml"
+# 36882 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 36109 "parsing/parser.ml"
-          
-        in
-        let _3 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 36888 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 36117 "parsing/parser.ml"
-          
-        in
-        let _loc__5_ = (_startpos__5_, _endpos__5_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 1450 "parsing/parser.mly"
+# 36896 "parsing/parser.ml"
+            
+          in
+          let _loc__5_ = (_startpos__5_, _endpos__5_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 1474 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 36125 "parsing/parser.ml"
-         in
+# 36904 "parsing/parser.ml"
+           : (Parsetree.module_expr))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36151,9 +36931,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Longident.t) = 
-# 1351 "parsing/parser.mly"
+# 1375 "parsing/parser.mly"
     ( _1 )
-# 36157 "parsing/parser.ml"
+# 36937 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36183,9 +36963,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Longident.t) = 
-# 1336 "parsing/parser.mly"
+# 1360 "parsing/parser.mly"
     ( _1 )
-# 36189 "parsing/parser.ml"
+# 36969 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36215,9 +36995,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.core_type) = 
-# 1311 "parsing/parser.mly"
+# 1335 "parsing/parser.mly"
     ( _1 )
-# 36221 "parsing/parser.ml"
+# 37001 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36247,9 +37027,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.expression) = 
-# 1316 "parsing/parser.mly"
+# 1340 "parsing/parser.mly"
     ( _1 )
-# 36253 "parsing/parser.ml"
+# 37033 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36279,9 +37059,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Longident.t) = 
-# 1341 "parsing/parser.mly"
+# 1365 "parsing/parser.mly"
     ( _1 )
-# 36285 "parsing/parser.ml"
+# 37065 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36311,9 +37091,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Longident.t) = 
-# 1346 "parsing/parser.mly"
+# 1370 "parsing/parser.mly"
     ( _1 )
-# 36317 "parsing/parser.ml"
+# 37097 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36343,9 +37123,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.module_expr) = 
-# 1306 "parsing/parser.mly"
+# 1330 "parsing/parser.mly"
     ( _1 )
-# 36349 "parsing/parser.ml"
+# 37129 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36375,9 +37155,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.module_type) = 
-# 1301 "parsing/parser.mly"
+# 1325 "parsing/parser.mly"
     ( _1 )
-# 36381 "parsing/parser.ml"
+# 37161 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36407,9 +37187,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Longident.t) = 
-# 1326 "parsing/parser.mly"
+# 1350 "parsing/parser.mly"
     ( _1 )
-# 36413 "parsing/parser.ml"
+# 37193 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36439,9 +37219,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.pattern) = 
-# 1321 "parsing/parser.mly"
+# 1345 "parsing/parser.mly"
     ( _1 )
-# 36445 "parsing/parser.ml"
+# 37225 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36471,9 +37251,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Longident.t) = 
-# 1331 "parsing/parser.mly"
+# 1355 "parsing/parser.mly"
     ( _1 )
-# 36477 "parsing/parser.ml"
+# 37257 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -36509,22 +37289,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _endpos = _endpos__3_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _loc__2_ = (_startpos__2_, _endpos__2_) in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2876 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _loc__2_ = (_startpos__2_, _endpos__2_) in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2920 "parsing/parser.mly"
       ( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 36521 "parsing/parser.ml"
-          
-        in
-        
-# 2864 "parsing/parser.mly"
+# 37302 "parsing/parser.ml"
+            
+          in
+          (
+# 2906 "parsing/parser.mly"
       ( _1 )
-# 36527 "parsing/parser.ml"
-         in
+# 37308 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36552,16 +37334,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.pattern) = let _1 = 
-# 2878 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 2922 "parsing/parser.mly"
       ( Pat.attr _1 _2 )
-# 36559 "parsing/parser.ml"
-         in
-        
-# 2864 "parsing/parser.mly"
+# 37342 "parsing/parser.ml"
+           in
+          (
+# 2906 "parsing/parser.mly"
       ( _1 )
-# 36564 "parsing/parser.ml"
-         in
+# 37347 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36582,16 +37366,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 = 
-# 2880 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 2924 "parsing/parser.mly"
       ( _1 )
-# 36589 "parsing/parser.ml"
-         in
-        
-# 2864 "parsing/parser.mly"
+# 37374 "parsing/parser.ml"
+           in
+          (
+# 2906 "parsing/parser.mly"
       ( _1 )
-# 36594 "parsing/parser.ml"
-         in
+# 37379 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36626,47 +37412,49 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _3 =
-                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _3 =
+                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 36641 "parsing/parser.ml"
+# 37428 "parsing/parser.ml"
+                  
+                in
+                
+# 2927 "parsing/parser.mly"
+        ( Ppat_alias(_1, _3) )
+# 37434 "parsing/parser.ml"
                 
               in
+              let _endpos__1_ = _endpos__1_inlined1_ in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-# 2883 "parsing/parser.mly"
-        ( Ppat_alias(_1, _3) )
-# 36647 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 37444 "parsing/parser.ml"
               
             in
-            let _endpos__1_ = _endpos__1_inlined1_ in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
             
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 36657 "parsing/parser.ml"
+# 2938 "parsing/parser.mly"
+    ( _1 )
+# 37450 "parsing/parser.ml"
             
           in
-          
-# 2894 "parsing/parser.mly"
-    ( _1 )
-# 36663 "parsing/parser.ml"
-          
-        in
-        
-# 2864 "parsing/parser.mly"
+          (
+# 2906 "parsing/parser.mly"
       ( _1 )
-# 36669 "parsing/parser.ml"
-         in
+# 37456 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36701,37 +37489,39 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _loc__3_ = (_startpos__3_, _endpos__3_) in
-              
-# 2885 "parsing/parser.mly"
+              let _1 =
+                let _loc__3_ = (_startpos__3_, _endpos__3_) in
+                
+# 2929 "parsing/parser.mly"
         ( expecting _loc__3_ "identifier" )
-# 36712 "parsing/parser.ml"
+# 37501 "parsing/parser.ml"
+                
+              in
+              let _endpos__1_ = _endpos__3_ in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 37511 "parsing/parser.ml"
               
             in
-            let _endpos__1_ = _endpos__3_ in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
             
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 36722 "parsing/parser.ml"
+# 2938 "parsing/parser.mly"
+    ( _1 )
+# 37517 "parsing/parser.ml"
             
           in
-          
-# 2894 "parsing/parser.mly"
-    ( _1 )
-# 36728 "parsing/parser.ml"
-          
-        in
-        
-# 2864 "parsing/parser.mly"
+          (
+# 2906 "parsing/parser.mly"
       ( _1 )
-# 36734 "parsing/parser.ml"
-         in
+# 37523 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36752,33 +37542,35 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _1 = 
-# 2887 "parsing/parser.mly"
+            let _1 =
+              let _1 = 
+# 2931 "parsing/parser.mly"
         ( Ppat_tuple(List.rev _1) )
-# 36761 "parsing/parser.ml"
-             in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 995 "parsing/parser.mly"
+# 37552 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 36769 "parsing/parser.ml"
+# 37560 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2894 "parsing/parser.mly"
+# 2938 "parsing/parser.mly"
     ( _1 )
-# 36775 "parsing/parser.ml"
-          
-        in
-        
-# 2864 "parsing/parser.mly"
+# 37566 "parsing/parser.ml"
+            
+          in
+          (
+# 2906 "parsing/parser.mly"
       ( _1 )
-# 36781 "parsing/parser.ml"
-         in
+# 37572 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36813,37 +37605,103 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _loc__3_ = (_startpos__3_, _endpos__3_) in
-              
-# 2889 "parsing/parser.mly"
+              let _1 =
+                let _loc__3_ = (_startpos__3_, _endpos__3_) in
+                
+# 2933 "parsing/parser.mly"
         ( expecting _loc__3_ "pattern" )
-# 36824 "parsing/parser.ml"
+# 37617 "parsing/parser.ml"
+                
+              in
+              let _endpos__1_ = _endpos__3_ in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 37627 "parsing/parser.ml"
               
             in
-            let _endpos__1_ = _endpos__3_ in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
             
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 36834 "parsing/parser.ml"
+# 2938 "parsing/parser.mly"
+    ( _1 )
+# 37633 "parsing/parser.ml"
             
           in
-          
-# 2894 "parsing/parser.mly"
-    ( _1 )
-# 36840 "parsing/parser.ml"
-          
+          (
+# 2906 "parsing/parser.mly"
+      ( _1 )
+# 37639 "parsing/parser.ml"
+           : (Parsetree.pattern))
         in
-        
-# 2864 "parsing/parser.mly"
+        {
+          MenhirLib.EngineTypes.state = _menhir_s;
+          MenhirLib.EngineTypes.semv = Obj.repr _v;
+          MenhirLib.EngineTypes.startp = _startpos;
+          MenhirLib.EngineTypes.endp = _endpos;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        });
+      (fun _menhir_env ->
+        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+        let {
+          MenhirLib.EngineTypes.state = _;
+          MenhirLib.EngineTypes.semv = _3;
+          MenhirLib.EngineTypes.startp = _startpos__3_;
+          MenhirLib.EngineTypes.endp = _endpos__3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _2;
+            MenhirLib.EngineTypes.startp = _startpos__2_;
+            MenhirLib.EngineTypes.endp = _endpos__2_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.pattern) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let _1 : (Parsetree.pattern) = Obj.magic _1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos__1_ in
+        let _endpos = _endpos__3_ in
+        let _v =
+          let _1 =
+            let _1 =
+              let _1 = 
+# 2935 "parsing/parser.mly"
+        ( Ppat_or(_1, _3) )
+# 37682 "parsing/parser.ml"
+               in
+              let _endpos__1_ = _endpos__3_ in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 37691 "parsing/parser.ml"
+              
+            in
+            
+# 2938 "parsing/parser.mly"
+    ( _1 )
+# 37697 "parsing/parser.ml"
+            
+          in
+          (
+# 2906 "parsing/parser.mly"
       ( _1 )
-# 36846 "parsing/parser.ml"
-         in
+# 37703 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36872,40 +37730,45 @@ module Tables = struct
             };
           };
         } = _menhir_stack in
-        let _3 : (Parsetree.pattern) = Obj.magic _3 in
+        let _3 : unit = Obj.magic _3 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (Parsetree.pattern) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _1 = 
-# 2891 "parsing/parser.mly"
-        ( Ppat_or(_1, _3) )
-# 36887 "parsing/parser.ml"
-             in
-            let _endpos__1_ = _endpos__3_ in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 995 "parsing/parser.mly"
+            let _1 =
+              let _1 =
+                let _loc__3_ = (_startpos__3_, _endpos__3_) in
+                
+# 2937 "parsing/parser.mly"
+        ( expecting _loc__3_ "pattern" )
+# 37748 "parsing/parser.ml"
+                
+              in
+              let _endpos__1_ = _endpos__3_ in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 36896 "parsing/parser.ml"
+# 37758 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2894 "parsing/parser.mly"
+# 2938 "parsing/parser.mly"
     ( _1 )
-# 36902 "parsing/parser.ml"
-          
-        in
-        
-# 2864 "parsing/parser.mly"
+# 37764 "parsing/parser.ml"
+            
+          in
+          (
+# 2906 "parsing/parser.mly"
       ( _1 )
-# 36908 "parsing/parser.ml"
-         in
+# 37770 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36922,55 +37785,57 @@ module Tables = struct
           MenhirLib.EngineTypes.endp = _endpos__3_;
           MenhirLib.EngineTypes.next = {
             MenhirLib.EngineTypes.state = _;
-            MenhirLib.EngineTypes.semv = _2;
-            MenhirLib.EngineTypes.startp = _startpos__2_;
-            MenhirLib.EngineTypes.endp = _endpos__2_;
+            MenhirLib.EngineTypes.semv = _1_inlined2;
+            MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+            MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
             MenhirLib.EngineTypes.next = {
-              MenhirLib.EngineTypes.state = _menhir_s;
-              MenhirLib.EngineTypes.semv = _1;
-              MenhirLib.EngineTypes.startp = _startpos__1_;
-              MenhirLib.EngineTypes.endp = _endpos__1_;
-              MenhirLib.EngineTypes.next = _menhir_stack;
+              MenhirLib.EngineTypes.state = _;
+              MenhirLib.EngineTypes.semv = _1_inlined1;
+              MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+              MenhirLib.EngineTypes.next = {
+                MenhirLib.EngineTypes.state = _menhir_s;
+                MenhirLib.EngineTypes.semv = _1;
+                MenhirLib.EngineTypes.startp = _startpos__1_;
+                MenhirLib.EngineTypes.endp = _endpos__1_;
+                MenhirLib.EngineTypes.next = _menhir_stack;
+              };
             };
           };
         } = _menhir_stack in
-        let _3 : unit = Obj.magic _3 in
-        let _2 : unit = Obj.magic _2 in
-        let _1 : (Parsetree.pattern) = Obj.magic _1 in
+        let _3 : (Parsetree.pattern) = Obj.magic _3 in
+        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
+        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
+        let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 =
-            let _1 =
-              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+        let _v =
+          let _2 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
               
-# 2893 "parsing/parser.mly"
-        ( expecting _loc__3_ "pattern" )
-# 36951 "parsing/parser.ml"
+# 4114 "parsing/parser.mly"
+    ( _1 )
+# 37822 "parsing/parser.ml"
               
             in
-            let _endpos__1_ = _endpos__3_ in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
             
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 36961 "parsing/parser.ml"
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 37828 "parsing/parser.ml"
             
           in
-          
-# 2894 "parsing/parser.mly"
-    ( _1 )
-# 36967 "parsing/parser.ml"
-          
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2908 "parsing/parser.mly"
+      ( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2)
+# 37837 "parsing/parser.ml"
+           : (Parsetree.pattern))
         in
-        
-# 2864 "parsing/parser.mly"
-      ( _1 )
-# 36973 "parsing/parser.ml"
-         in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -36982,19 +37847,19 @@ module Tables = struct
         let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
         let {
           MenhirLib.EngineTypes.state = _;
-          MenhirLib.EngineTypes.semv = _3;
-          MenhirLib.EngineTypes.startp = _startpos__3_;
-          MenhirLib.EngineTypes.endp = _endpos__3_;
+          MenhirLib.EngineTypes.semv = _4;
+          MenhirLib.EngineTypes.startp = _startpos__4_;
+          MenhirLib.EngineTypes.endp = _endpos__4_;
           MenhirLib.EngineTypes.next = {
             MenhirLib.EngineTypes.state = _;
-            MenhirLib.EngineTypes.semv = _1_inlined2;
-            MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
-            MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+            MenhirLib.EngineTypes.semv = _3;
+            MenhirLib.EngineTypes.startp = _startpos__3_;
+            MenhirLib.EngineTypes.endp = _endpos__3_;
             MenhirLib.EngineTypes.next = {
               MenhirLib.EngineTypes.state = _;
-              MenhirLib.EngineTypes.semv = _1_inlined1;
-              MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
-              MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+              MenhirLib.EngineTypes.semv = _2;
+              MenhirLib.EngineTypes.startp = _startpos__2_;
+              MenhirLib.EngineTypes.endp = _endpos__2_;
               MenhirLib.EngineTypes.next = {
                 MenhirLib.EngineTypes.state = _menhir_s;
                 MenhirLib.EngineTypes.semv = _1;
@@ -37005,37 +37870,23 @@ module Tables = struct
             };
           };
         } = _menhir_stack in
-        let _3 : (Parsetree.pattern) = Obj.magic _3 in
-        let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
-        let _1_inlined1 : (string Asttypes.loc option) = Obj.magic _1_inlined1 in
+        let _4 : (Parsetree.pattern) = Obj.magic _4 in
+        let _3 : unit = Obj.magic _3 in
+        let _2 : (Parsetree.pattern) = Obj.magic _2 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
-        let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _2 =
-          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-          let _2 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
-    ( _1 )
-# 37023 "parsing/parser.ml"
-            
-          in
-          
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 37029 "parsing/parser.ml"
-          
+        let _endpos = _endpos__4_ in
+        let _v =
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2910 "parsing/parser.mly"
+      ( mkpat ~loc:_sloc (Ppat_effect(_2,_4)) )
+# 37888 "parsing/parser.ml"
+           : (Parsetree.pattern))
         in
-        let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2866 "parsing/parser.mly"
-      ( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2)
-# 37038 "parsing/parser.ml"
-         in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37071,9 +37922,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.pattern list) = 
-# 2993 "parsing/parser.mly"
+# 3038 "parsing/parser.mly"
                                                 ( _3 :: _1 )
-# 37077 "parsing/parser.ml"
+# 37928 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -37110,9 +37961,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.pattern list) = 
-# 2994 "parsing/parser.mly"
+# 3039 "parsing/parser.mly"
                                                 ( [_3; _1] )
-# 37116 "parsing/parser.ml"
+# 37967 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -37148,12 +37999,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        
-# 2995 "parsing/parser.mly"
+        let _v =
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          (
+# 3040 "parsing/parser.mly"
                                                 ( expecting _loc__3_ "pattern" )
-# 37156 "parsing/parser.ml"
-         in
+# 38008 "parsing/parser.ml"
+           : (Parsetree.pattern list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37189,9 +38042,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.pattern list) = 
-# 2993 "parsing/parser.mly"
+# 3038 "parsing/parser.mly"
                                                 ( _3 :: _1 )
-# 37195 "parsing/parser.ml"
+# 38048 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -37228,9 +38081,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Parsetree.pattern list) = 
-# 2994 "parsing/parser.mly"
+# 3039 "parsing/parser.mly"
                                                 ( [_3; _1] )
-# 37234 "parsing/parser.ml"
+# 38087 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -37266,12 +38119,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        
-# 2995 "parsing/parser.mly"
+        let _v =
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          (
+# 3040 "parsing/parser.mly"
                                                 ( expecting _loc__3_ "pattern" )
-# 37274 "parsing/parser.ml"
-         in
+# 38128 "parsing/parser.ml"
+           : (Parsetree.pattern list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37293,9 +38148,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.pattern) = 
-# 2899 "parsing/parser.mly"
+# 2943 "parsing/parser.mly"
       ( _1 )
-# 37299 "parsing/parser.ml"
+# 38154 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -37324,39 +38179,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 37337 "parsing/parser.ml"
+# 38193 "parsing/parser.ml"
+                
+              in
+              
+# 2946 "parsing/parser.mly"
+        ( Ppat_construct(_1, Some ([], _2)) )
+# 38199 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2902 "parsing/parser.mly"
-        ( Ppat_construct(_1, Some ([], _2)) )
-# 37343 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 38209 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 37353 "parsing/parser.ml"
-          
-        in
-        
-# 2908 "parsing/parser.mly"
+          (
+# 2952 "parsing/parser.mly"
       ( _1 )
-# 37359 "parsing/parser.ml"
-         in
+# 38215 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37412,44 +38269,46 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_pat_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let newtypes = 
-# 2637 "parsing/parser.mly"
+            let _1 =
+              let newtypes = 
+# 2679 "parsing/parser.mly"
     ( xs )
-# 37421 "parsing/parser.ml"
-             in
-            let constr =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+# 38279 "parsing/parser.ml"
+               in
+              let constr =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 37430 "parsing/parser.ml"
+# 38288 "parsing/parser.ml"
+                
+              in
+              
+# 2949 "parsing/parser.mly"
+        ( Ppat_construct(constr, Some (newtypes, pat)) )
+# 38294 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos_pat_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2905 "parsing/parser.mly"
-        ( Ppat_construct(constr, Some (newtypes, pat)) )
-# 37436 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 38304 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_pat_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 37446 "parsing/parser.ml"
-          
-        in
-        
-# 2908 "parsing/parser.mly"
+          (
+# 2952 "parsing/parser.mly"
       ( _1 )
-# 37452 "parsing/parser.ml"
-         in
+# 38310 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37477,27 +38336,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2907 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2951 "parsing/parser.mly"
         ( Ppat_variant(_1, Some _2) )
-# 37485 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 38345 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 37494 "parsing/parser.ml"
-          
-        in
-        
-# 2908 "parsing/parser.mly"
+# 38354 "parsing/parser.ml"
+            
+          in
+          (
+# 2952 "parsing/parser.mly"
       ( _1 )
-# 37500 "parsing/parser.ml"
-         in
+# 38360 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37539,30 +38400,32 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _2 =
-          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+        let _v =
           let _2 =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 37550 "parsing/parser.ml"
+# 38412 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 37556 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2910 "parsing/parser.mly"
+# 38418 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2954 "parsing/parser.mly"
       ( mkpat_attrs ~loc:_sloc (Ppat_lazy _3) _2)
-# 37565 "parsing/parser.ml"
-         in
+# 38427 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37597,22 +38460,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _endpos = _endpos__3_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _loc__2_ = (_startpos__2_, _endpos__2_) in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2876 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _loc__2_ = (_startpos__2_, _endpos__2_) in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2920 "parsing/parser.mly"
       ( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 37609 "parsing/parser.ml"
-          
-        in
-        
-# 2871 "parsing/parser.mly"
+# 38473 "parsing/parser.ml"
+            
+          in
+          (
+# 2915 "parsing/parser.mly"
       ( _1 )
-# 37615 "parsing/parser.ml"
-         in
+# 38479 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37640,16 +38505,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.pattern) = let _1 = 
-# 2878 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 2922 "parsing/parser.mly"
       ( Pat.attr _1 _2 )
-# 37647 "parsing/parser.ml"
-         in
-        
-# 2871 "parsing/parser.mly"
+# 38513 "parsing/parser.ml"
+           in
+          (
+# 2915 "parsing/parser.mly"
       ( _1 )
-# 37652 "parsing/parser.ml"
-         in
+# 38518 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37670,16 +38537,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 = 
-# 2880 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 2924 "parsing/parser.mly"
       ( _1 )
-# 37677 "parsing/parser.ml"
-         in
-        
-# 2871 "parsing/parser.mly"
+# 38545 "parsing/parser.ml"
+           in
+          (
+# 2915 "parsing/parser.mly"
       ( _1 )
-# 37682 "parsing/parser.ml"
-         in
+# 38550 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37714,47 +38583,49 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _3 =
-                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _3 =
+                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 37729 "parsing/parser.ml"
+# 38599 "parsing/parser.ml"
+                  
+                in
+                
+# 2927 "parsing/parser.mly"
+        ( Ppat_alias(_1, _3) )
+# 38605 "parsing/parser.ml"
                 
               in
+              let _endpos__1_ = _endpos__1_inlined1_ in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-# 2883 "parsing/parser.mly"
-        ( Ppat_alias(_1, _3) )
-# 37735 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 38615 "parsing/parser.ml"
               
             in
-            let _endpos__1_ = _endpos__1_inlined1_ in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
             
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 37745 "parsing/parser.ml"
+# 2938 "parsing/parser.mly"
+    ( _1 )
+# 38621 "parsing/parser.ml"
             
           in
-          
-# 2894 "parsing/parser.mly"
-    ( _1 )
-# 37751 "parsing/parser.ml"
-          
-        in
-        
-# 2871 "parsing/parser.mly"
+          (
+# 2915 "parsing/parser.mly"
       ( _1 )
-# 37757 "parsing/parser.ml"
-         in
+# 38627 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37789,37 +38660,39 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _loc__3_ = (_startpos__3_, _endpos__3_) in
-              
-# 2885 "parsing/parser.mly"
+              let _1 =
+                let _loc__3_ = (_startpos__3_, _endpos__3_) in
+                
+# 2929 "parsing/parser.mly"
         ( expecting _loc__3_ "identifier" )
-# 37800 "parsing/parser.ml"
+# 38672 "parsing/parser.ml"
+                
+              in
+              let _endpos__1_ = _endpos__3_ in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 38682 "parsing/parser.ml"
               
             in
-            let _endpos__1_ = _endpos__3_ in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
             
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 37810 "parsing/parser.ml"
+# 2938 "parsing/parser.mly"
+    ( _1 )
+# 38688 "parsing/parser.ml"
             
           in
-          
-# 2894 "parsing/parser.mly"
-    ( _1 )
-# 37816 "parsing/parser.ml"
-          
-        in
-        
-# 2871 "parsing/parser.mly"
+          (
+# 2915 "parsing/parser.mly"
       ( _1 )
-# 37822 "parsing/parser.ml"
-         in
+# 38694 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37840,33 +38713,35 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _1 = 
-# 2887 "parsing/parser.mly"
+            let _1 =
+              let _1 = 
+# 2931 "parsing/parser.mly"
         ( Ppat_tuple(List.rev _1) )
-# 37849 "parsing/parser.ml"
-             in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 995 "parsing/parser.mly"
+# 38723 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 37857 "parsing/parser.ml"
+# 38731 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2894 "parsing/parser.mly"
+# 2938 "parsing/parser.mly"
     ( _1 )
-# 37863 "parsing/parser.ml"
-          
-        in
-        
-# 2871 "parsing/parser.mly"
+# 38737 "parsing/parser.ml"
+            
+          in
+          (
+# 2915 "parsing/parser.mly"
       ( _1 )
-# 37869 "parsing/parser.ml"
-         in
+# 38743 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37901,37 +38776,39 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _loc__3_ = (_startpos__3_, _endpos__3_) in
-              
-# 2889 "parsing/parser.mly"
+              let _1 =
+                let _loc__3_ = (_startpos__3_, _endpos__3_) in
+                
+# 2933 "parsing/parser.mly"
         ( expecting _loc__3_ "pattern" )
-# 37912 "parsing/parser.ml"
+# 38788 "parsing/parser.ml"
+                
+              in
+              let _endpos__1_ = _endpos__3_ in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 38798 "parsing/parser.ml"
               
             in
-            let _endpos__1_ = _endpos__3_ in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
             
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 37922 "parsing/parser.ml"
+# 2938 "parsing/parser.mly"
+    ( _1 )
+# 38804 "parsing/parser.ml"
             
           in
-          
-# 2894 "parsing/parser.mly"
-    ( _1 )
-# 37928 "parsing/parser.ml"
-          
-        in
-        
-# 2871 "parsing/parser.mly"
+          (
+# 2915 "parsing/parser.mly"
       ( _1 )
-# 37934 "parsing/parser.ml"
-         in
+# 38810 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -37966,34 +38843,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _1 = 
-# 2891 "parsing/parser.mly"
+            let _1 =
+              let _1 = 
+# 2935 "parsing/parser.mly"
         ( Ppat_or(_1, _3) )
-# 37975 "parsing/parser.ml"
-             in
-            let _endpos__1_ = _endpos__3_ in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 995 "parsing/parser.mly"
+# 38853 "parsing/parser.ml"
+               in
+              let _endpos__1_ = _endpos__3_ in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 37984 "parsing/parser.ml"
+# 38862 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2894 "parsing/parser.mly"
+# 2938 "parsing/parser.mly"
     ( _1 )
-# 37990 "parsing/parser.ml"
-          
-        in
-        
-# 2871 "parsing/parser.mly"
+# 38868 "parsing/parser.ml"
+            
+          in
+          (
+# 2915 "parsing/parser.mly"
       ( _1 )
-# 37996 "parsing/parser.ml"
-         in
+# 38874 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38028,37 +38907,39 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _loc__3_ = (_startpos__3_, _endpos__3_) in
-              
-# 2893 "parsing/parser.mly"
+              let _1 =
+                let _loc__3_ = (_startpos__3_, _endpos__3_) in
+                
+# 2937 "parsing/parser.mly"
         ( expecting _loc__3_ "pattern" )
-# 38039 "parsing/parser.ml"
+# 38919 "parsing/parser.ml"
+                
+              in
+              let _endpos__1_ = _endpos__3_ in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 38929 "parsing/parser.ml"
               
             in
-            let _endpos__1_ = _endpos__3_ in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
             
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 38049 "parsing/parser.ml"
+# 2938 "parsing/parser.mly"
+    ( _1 )
+# 38935 "parsing/parser.ml"
             
           in
-          
-# 2894 "parsing/parser.mly"
-    ( _1 )
-# 38055 "parsing/parser.ml"
-          
-        in
-        
-# 2871 "parsing/parser.mly"
+          (
+# 2915 "parsing/parser.mly"
       ( _1 )
-# 38061 "parsing/parser.ml"
-         in
+# 38941 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38076,45 +38957,47 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 38082 "parsing/parser.ml"
+# 38963 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 38096 "parsing/parser.ml"
+# 38978 "parsing/parser.ml"
+                
+              in
+              
+# 2370 "parsing/parser.mly"
+                        ( Ppat_var _1 )
+# 38984 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2348 "parsing/parser.mly"
-                        ( Ppat_var _1 )
-# 38102 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 38993 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 38111 "parsing/parser.ml"
-          
-        in
-        
-# 2350 "parsing/parser.mly"
+          (
+# 2372 "parsing/parser.mly"
     ( _1 )
-# 38117 "parsing/parser.ml"
-         in
+# 38999 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38135,26 +39018,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2349 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2371 "parsing/parser.mly"
                         ( Ppat_any )
-# 38143 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 39027 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 38151 "parsing/parser.ml"
-          
-        in
-        
-# 2350 "parsing/parser.mly"
+# 39035 "parsing/parser.ml"
+            
+          in
+          (
+# 2372 "parsing/parser.mly"
     ( _1 )
-# 38157 "parsing/parser.ml"
-         in
+# 39041 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38176,9 +39061,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.payload) = 
-# 4088 "parsing/parser.mly"
+# 4140 "parsing/parser.mly"
               ( PStr _1 )
-# 38182 "parsing/parser.ml"
+# 39067 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38208,9 +39093,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.payload) = 
-# 4089 "parsing/parser.mly"
+# 4141 "parsing/parser.mly"
                     ( PSig _2 )
-# 38214 "parsing/parser.ml"
+# 39099 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38240,9 +39125,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.payload) = 
-# 4090 "parsing/parser.mly"
+# 4142 "parsing/parser.mly"
                     ( PTyp _2 )
-# 38246 "parsing/parser.ml"
+# 39131 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38272,9 +39157,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.payload) = 
-# 4091 "parsing/parser.mly"
+# 4143 "parsing/parser.mly"
                      ( PPat (_2, None) )
-# 38278 "parsing/parser.ml"
+# 39163 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38318,110 +39203,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
         let _v : (Parsetree.payload) = 
-# 4092 "parsing/parser.mly"
+# 4144 "parsing/parser.mly"
                                    ( PPat (_2, Some _4) )
-# 38324 "parsing/parser.ml"
-         in
-        {
-          MenhirLib.EngineTypes.state = _menhir_s;
-          MenhirLib.EngineTypes.semv = Obj.repr _v;
-          MenhirLib.EngineTypes.startp = _startpos;
-          MenhirLib.EngineTypes.endp = _endpos;
-          MenhirLib.EngineTypes.next = _menhir_stack;
-        });
-      (fun _menhir_env ->
-        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
-        let {
-          MenhirLib.EngineTypes.state = _menhir_s;
-          MenhirLib.EngineTypes.semv = _1;
-          MenhirLib.EngineTypes.startp = _startpos__1_;
-          MenhirLib.EngineTypes.endp = _endpos__1_;
-          MenhirLib.EngineTypes.next = _menhir_stack;
-        } = _menhir_stack in
-        let _1 : (Parsetree.core_type) = Obj.magic _1 in
-        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
-        let _startpos = _startpos__1_ in
-        let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type) = 
-# 3429 "parsing/parser.mly"
-    ( _1 )
-# 38349 "parsing/parser.ml"
-         in
-        {
-          MenhirLib.EngineTypes.state = _menhir_s;
-          MenhirLib.EngineTypes.semv = Obj.repr _v;
-          MenhirLib.EngineTypes.startp = _startpos;
-          MenhirLib.EngineTypes.endp = _endpos;
-          MenhirLib.EngineTypes.next = _menhir_stack;
-        });
-      (fun _menhir_env ->
-        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
-        let {
-          MenhirLib.EngineTypes.state = _;
-          MenhirLib.EngineTypes.semv = _3;
-          MenhirLib.EngineTypes.startp = _startpos__3_;
-          MenhirLib.EngineTypes.endp = _endpos__3_;
-          MenhirLib.EngineTypes.next = {
-            MenhirLib.EngineTypes.state = _;
-            MenhirLib.EngineTypes.semv = _2;
-            MenhirLib.EngineTypes.startp = _startpos__2_;
-            MenhirLib.EngineTypes.endp = _endpos__2_;
-            MenhirLib.EngineTypes.next = {
-              MenhirLib.EngineTypes.state = _menhir_s;
-              MenhirLib.EngineTypes.semv = xs;
-              MenhirLib.EngineTypes.startp = _startpos_xs_;
-              MenhirLib.EngineTypes.endp = _endpos_xs_;
-              MenhirLib.EngineTypes.next = _menhir_stack;
-            };
-          };
-        } = _menhir_stack in
-        let _3 : (Parsetree.core_type) = Obj.magic _3 in
-        let _2 : unit = Obj.magic _2 in
-        let xs : (Asttypes.label Asttypes.loc list) = Obj.magic xs in
-        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
-        let _startpos = _startpos_xs_ in
-        let _endpos = _endpos__3_ in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 =
-            let _1 =
-              let _1 =
-                let xs = 
-# 253 "<standard.mly>"
-    ( List.rev xs )
-# 38392 "parsing/parser.ml"
-                 in
-                
-# 1062 "parsing/parser.mly"
-    ( xs )
-# 38397 "parsing/parser.ml"
-                
-              in
-              
-# 3421 "parsing/parser.mly"
-    ( _1 )
-# 38403 "parsing/parser.ml"
-              
-            in
-            
-# 3425 "parsing/parser.mly"
-    ( Ptyp_poly(_1, _3) )
-# 38409 "parsing/parser.ml"
-            
-          in
-          let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_xs_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 38419 "parsing/parser.ml"
-          
-        in
-        
-# 3431 "parsing/parser.mly"
-    ( _1 )
-# 38425 "parsing/parser.ml"
+# 39209 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38443,16 +39227,121 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type) = let _1 = 
-# 3460 "parsing/parser.mly"
+        let _v : (Parsetree.core_type) = 
+# 3474 "parsing/parser.mly"
     ( _1 )
-# 38450 "parsing/parser.ml"
+# 39234 "parsing/parser.ml"
          in
-        
-# 3429 "parsing/parser.mly"
+        {
+          MenhirLib.EngineTypes.state = _menhir_s;
+          MenhirLib.EngineTypes.semv = Obj.repr _v;
+          MenhirLib.EngineTypes.startp = _startpos;
+          MenhirLib.EngineTypes.endp = _endpos;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        });
+      (fun _menhir_env ->
+        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+        let {
+          MenhirLib.EngineTypes.state = _;
+          MenhirLib.EngineTypes.semv = _3;
+          MenhirLib.EngineTypes.startp = _startpos__3_;
+          MenhirLib.EngineTypes.endp = _endpos__3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = _2;
+            MenhirLib.EngineTypes.startp = _startpos__2_;
+            MenhirLib.EngineTypes.endp = _endpos__2_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = xs;
+              MenhirLib.EngineTypes.startp = _startpos_xs_;
+              MenhirLib.EngineTypes.endp = _endpos_xs_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : (Parsetree.core_type) = Obj.magic _3 in
+        let _2 : unit = Obj.magic _2 in
+        let xs : (Asttypes.label Asttypes.loc list) = Obj.magic xs in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos_xs_ in
+        let _endpos = _endpos__3_ in
+        let _v =
+          let _1 =
+            let _1 =
+              let _1 =
+                let _1 =
+                  let xs = 
+# 264 "<standard.mly>"
+    ( List.rev xs )
+# 39278 "parsing/parser.ml"
+                   in
+                  
+# 1086 "parsing/parser.mly"
+    ( xs )
+# 39283 "parsing/parser.ml"
+                  
+                in
+                
+# 3466 "parsing/parser.mly"
     ( _1 )
-# 38455 "parsing/parser.ml"
-         in
+# 39289 "parsing/parser.ml"
+                
+              in
+              
+# 3470 "parsing/parser.mly"
+    ( Ptyp_poly(_1, _3) )
+# 39295 "parsing/parser.ml"
+              
+            in
+            let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_xs_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 39305 "parsing/parser.ml"
+            
+          in
+          (
+# 3476 "parsing/parser.mly"
+    ( _1 )
+# 39311 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
+        {
+          MenhirLib.EngineTypes.state = _menhir_s;
+          MenhirLib.EngineTypes.semv = Obj.repr _v;
+          MenhirLib.EngineTypes.startp = _startpos;
+          MenhirLib.EngineTypes.endp = _endpos;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        });
+      (fun _menhir_env ->
+        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+        let {
+          MenhirLib.EngineTypes.state = _menhir_s;
+          MenhirLib.EngineTypes.semv = _1;
+          MenhirLib.EngineTypes.startp = _startpos__1_;
+          MenhirLib.EngineTypes.endp = _endpos__1_;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        } = _menhir_stack in
+        let _1 : (Parsetree.core_type) = Obj.magic _1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos__1_ in
+        let _endpos = _endpos__1_ in
+        let _v =
+          let _1 = 
+# 3505 "parsing/parser.mly"
+    ( _1 )
+# 39338 "parsing/parser.ml"
+           in
+          (
+# 3474 "parsing/parser.mly"
+    ( _1 )
+# 39343 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38487,53 +39376,55 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let _3 = 
-# 3460 "parsing/parser.mly"
-    ( _1 )
-# 38496 "parsing/parser.ml"
-             in
             let _1 =
+              let _3 = 
+# 3505 "parsing/parser.mly"
+    ( _1 )
+# 39386 "parsing/parser.ml"
+               in
               let _1 =
-                let xs = 
-# 253 "<standard.mly>"
+                let _1 =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 38503 "parsing/parser.ml"
-                 in
-                
-# 1062 "parsing/parser.mly"
+# 39393 "parsing/parser.ml"
+                   in
+                  
+# 1086 "parsing/parser.mly"
     ( xs )
-# 38508 "parsing/parser.ml"
+# 39398 "parsing/parser.ml"
+                  
+                in
+                
+# 3466 "parsing/parser.mly"
+    ( _1 )
+# 39404 "parsing/parser.ml"
                 
               in
               
-# 3421 "parsing/parser.mly"
-    ( _1 )
-# 38514 "parsing/parser.ml"
+# 3470 "parsing/parser.mly"
+    ( Ptyp_poly(_1, _3) )
+# 39410 "parsing/parser.ml"
               
             in
+            let _startpos__1_ = _startpos_xs_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3425 "parsing/parser.mly"
-    ( Ptyp_poly(_1, _3) )
-# 38520 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 39420 "parsing/parser.ml"
             
           in
-          let _startpos__1_ = _startpos_xs_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 38530 "parsing/parser.ml"
-          
-        in
-        
-# 3431 "parsing/parser.mly"
+          (
+# 3476 "parsing/parser.mly"
     ( _1 )
-# 38536 "parsing/parser.ml"
-         in
+# 39426 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38575,14 +39466,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.attribute) = let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 4049 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 4101 "parsing/parser.mly"
     ( mk_attr ~loc:(make_loc _sloc) _2 _3 )
-# 38585 "parsing/parser.ml"
-         in
+# 39477 "parsing/parser.ml"
+           : (Parsetree.attribute))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38659,46 +39552,48 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 =
-          let _1 = _1_inlined3 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 38668 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined3_ in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 39562 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined3_ in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 38680 "parsing/parser.ml"
-          
-        in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 39574 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 38688 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3057 "parsing/parser.mly"
+# 39582 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3102 "parsing/parser.mly"
     ( let attrs = attrs1 @ attrs2 in
       let loc = make_loc _sloc in
       let docs = symbol_docs _sloc in
       Val.mk id ty ~prim ~attrs ~loc ~docs,
       ext )
-# 38701 "parsing/parser.ml"
-         in
+# 39595 "parsing/parser.ml"
+           : (Parsetree.value_description * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38712,16 +39607,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
-        let _v : (Asttypes.private_flag) = let _1 = 
-# 3917 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3969 "parsing/parser.mly"
                                                 ( Public )
-# 38719 "parsing/parser.ml"
-         in
-        
-# 3914 "parsing/parser.mly"
+# 39615 "parsing/parser.ml"
+           in
+          (
+# 3966 "parsing/parser.mly"
     ( _1 )
-# 38724 "parsing/parser.ml"
-         in
+# 39620 "parsing/parser.ml"
+           : (Asttypes.private_flag))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38742,16 +39639,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.private_flag) = let _1 = 
-# 3918 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 3970 "parsing/parser.mly"
                                                 ( Private )
-# 38749 "parsing/parser.ml"
-         in
-        
-# 3914 "parsing/parser.mly"
+# 39647 "parsing/parser.ml"
+           in
+          (
+# 3966 "parsing/parser.mly"
     ( _1 )
-# 38754 "parsing/parser.ml"
-         in
+# 39652 "parsing/parser.ml"
+           : (Asttypes.private_flag))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38766,9 +39665,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = 
-# 3940 "parsing/parser.mly"
+# 3992 "parsing/parser.mly"
                  ( Public, Concrete )
-# 38772 "parsing/parser.ml"
+# 39671 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38791,9 +39690,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = 
-# 3941 "parsing/parser.mly"
+# 3993 "parsing/parser.mly"
             ( Private, Concrete )
-# 38797 "parsing/parser.ml"
+# 39696 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38816,9 +39715,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = 
-# 3942 "parsing/parser.mly"
+# 3994 "parsing/parser.mly"
             ( Public, Virtual )
-# 38822 "parsing/parser.ml"
+# 39721 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38848,9 +39747,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = 
-# 3943 "parsing/parser.mly"
+# 3995 "parsing/parser.mly"
                     ( Private, Virtual )
-# 38854 "parsing/parser.ml"
+# 39753 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38880,9 +39779,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.private_flag * Asttypes.virtual_flag) = 
-# 3944 "parsing/parser.mly"
+# 3996 "parsing/parser.mly"
                     ( Private, Virtual )
-# 38886 "parsing/parser.ml"
+# 39785 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38898,9 +39797,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Asttypes.rec_flag) = 
-# 3895 "parsing/parser.mly"
+# 3947 "parsing/parser.mly"
                                                 ( Nonrecursive )
-# 38904 "parsing/parser.ml"
+# 39803 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38923,9 +39822,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.rec_flag) = 
-# 3896 "parsing/parser.mly"
+# 3948 "parsing/parser.mly"
                                                 ( Recursive )
-# 38929 "parsing/parser.ml"
+# 39828 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -38947,17 +39846,19 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_fields_ in
         let _endpos = _endpos_fields_ in
-        let _v : (Parsetree.expression option *
-  (Longident.t Asttypes.loc * Parsetree.expression) list) = let eo = 
-# 124 "<standard.mly>"
+        let _v =
+          let eo = 
+# 123 "<standard.mly>"
     ( None )
-# 38955 "parsing/parser.ml"
-         in
-        
-# 2796 "parsing/parser.mly"
+# 39854 "parsing/parser.ml"
+           in
+          (
+# 2838 "parsing/parser.mly"
     ( eo, fields )
-# 38960 "parsing/parser.ml"
-         in
+# 39859 "parsing/parser.ml"
+           : (Parsetree.expression option *
+  (Longident.t Asttypes.loc * Parsetree.expression) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -38992,24 +39893,26 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_fields_ in
-        let _v : (Parsetree.expression option *
-  (Longident.t Asttypes.loc * Parsetree.expression) list) = let eo =
-          let x = 
-# 191 "<standard.mly>"
+        let _v =
+          let eo =
+            let x = 
+# 196 "<standard.mly>"
     ( x )
-# 39001 "parsing/parser.ml"
-           in
-          
+# 39902 "parsing/parser.ml"
+             in
+            
 # 126 "<standard.mly>"
     ( Some x )
-# 39006 "parsing/parser.ml"
-          
-        in
-        
-# 2796 "parsing/parser.mly"
+# 39907 "parsing/parser.ml"
+            
+          in
+          (
+# 2838 "parsing/parser.mly"
     ( eo, fields )
-# 39012 "parsing/parser.ml"
-         in
+# 39913 "parsing/parser.ml"
+           : (Parsetree.expression option *
+  (Longident.t Asttypes.loc * Parsetree.expression) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39032,19 +39935,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_d_ in
         let _endpos = _endpos_d_ in
-        let _v : (Parsetree.constructor_declaration list) = let x = 
-# 3242 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3287 "parsing/parser.mly"
     (
       let cid, vars, args, res, attrs, loc, info = d in
       Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
     )
-# 39042 "parsing/parser.ml"
-         in
-        
-# 1193 "parsing/parser.mly"
+# 39946 "parsing/parser.ml"
+           in
+          (
+# 1217 "parsing/parser.mly"
       ( [x] )
-# 39047 "parsing/parser.ml"
-         in
+# 39951 "parsing/parser.ml"
+           : (Parsetree.constructor_declaration list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39067,19 +39972,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_d_ in
         let _endpos = _endpos_d_ in
-        let _v : (Parsetree.constructor_declaration list) = let x = 
-# 3242 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3287 "parsing/parser.mly"
     (
       let cid, vars, args, res, attrs, loc, info = d in
       Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
     )
-# 39077 "parsing/parser.ml"
-         in
-        
-# 1196 "parsing/parser.mly"
+# 39983 "parsing/parser.ml"
+           in
+          (
+# 1220 "parsing/parser.mly"
       ( [x] )
-# 39082 "parsing/parser.ml"
-         in
+# 39988 "parsing/parser.ml"
+           : (Parsetree.constructor_declaration list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39109,19 +40016,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_d_ in
-        let _v : (Parsetree.constructor_declaration list) = let x = 
-# 3242 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3287 "parsing/parser.mly"
     (
       let cid, vars, args, res, attrs, loc, info = d in
       Type.constructor cid ~vars ~args ?res ~attrs ~loc ~info
     )
-# 39119 "parsing/parser.ml"
-         in
-        
-# 1200 "parsing/parser.mly"
+# 40027 "parsing/parser.ml"
+           in
+          (
+# 1224 "parsing/parser.mly"
       ( x :: xs )
-# 39124 "parsing/parser.ml"
-         in
+# 40032 "parsing/parser.ml"
+           : (Parsetree.constructor_declaration list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39144,26 +40053,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_d_ in
         let _endpos = _endpos_d_ in
-        let _v : (Parsetree.extension_constructor list) = let x =
-          let _1 = 
-# 3359 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _1 = 
+# 3404 "parsing/parser.mly"
     (
       let cid, vars, args, res, attrs, loc, info = d in
       Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
     )
-# 39155 "parsing/parser.ml"
-           in
-          
-# 3353 "parsing/parser.mly"
+# 40065 "parsing/parser.ml"
+             in
+            
+# 3398 "parsing/parser.mly"
       ( _1 )
-# 39160 "parsing/parser.ml"
-          
-        in
-        
-# 1193 "parsing/parser.mly"
+# 40070 "parsing/parser.ml"
+            
+          in
+          (
+# 1217 "parsing/parser.mly"
       ( [x] )
-# 39166 "parsing/parser.ml"
-         in
+# 40076 "parsing/parser.ml"
+           : (Parsetree.extension_constructor list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39184,16 +40095,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.extension_constructor list) = let x = 
-# 3355 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3400 "parsing/parser.mly"
       ( _1 )
-# 39191 "parsing/parser.ml"
-         in
-        
-# 1193 "parsing/parser.mly"
+# 40103 "parsing/parser.ml"
+           in
+          (
+# 1217 "parsing/parser.mly"
       ( [x] )
-# 39196 "parsing/parser.ml"
-         in
+# 40108 "parsing/parser.ml"
+           : (Parsetree.extension_constructor list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39216,26 +40129,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_d_ in
         let _endpos = _endpos_d_ in
-        let _v : (Parsetree.extension_constructor list) = let x =
-          let _1 = 
-# 3359 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _1 = 
+# 3404 "parsing/parser.mly"
     (
       let cid, vars, args, res, attrs, loc, info = d in
       Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
     )
-# 39227 "parsing/parser.ml"
-           in
-          
-# 3353 "parsing/parser.mly"
+# 40141 "parsing/parser.ml"
+             in
+            
+# 3398 "parsing/parser.mly"
       ( _1 )
-# 39232 "parsing/parser.ml"
-          
-        in
-        
-# 1196 "parsing/parser.mly"
+# 40146 "parsing/parser.ml"
+            
+          in
+          (
+# 1220 "parsing/parser.mly"
       ( [x] )
-# 39238 "parsing/parser.ml"
-         in
+# 40152 "parsing/parser.ml"
+           : (Parsetree.extension_constructor list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39256,16 +40171,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.extension_constructor list) = let x = 
-# 3355 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3400 "parsing/parser.mly"
       ( _1 )
-# 39263 "parsing/parser.ml"
-         in
-        
-# 1196 "parsing/parser.mly"
+# 40179 "parsing/parser.ml"
+           in
+          (
+# 1220 "parsing/parser.mly"
       ( [x] )
-# 39268 "parsing/parser.ml"
-         in
+# 40184 "parsing/parser.ml"
+           : (Parsetree.extension_constructor list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39295,26 +40212,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_d_ in
-        let _v : (Parsetree.extension_constructor list) = let x =
-          let _1 = 
-# 3359 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _1 = 
+# 3404 "parsing/parser.mly"
     (
       let cid, vars, args, res, attrs, loc, info = d in
       Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
     )
-# 39306 "parsing/parser.ml"
-           in
-          
-# 3353 "parsing/parser.mly"
+# 40224 "parsing/parser.ml"
+             in
+            
+# 3398 "parsing/parser.mly"
       ( _1 )
-# 39311 "parsing/parser.ml"
-          
-        in
-        
-# 1200 "parsing/parser.mly"
+# 40229 "parsing/parser.ml"
+            
+          in
+          (
+# 1224 "parsing/parser.mly"
       ( x :: xs )
-# 39317 "parsing/parser.ml"
-         in
+# 40235 "parsing/parser.ml"
+           : (Parsetree.extension_constructor list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39342,16 +40261,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.extension_constructor list) = let x = 
-# 3355 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3400 "parsing/parser.mly"
       ( _1 )
-# 39349 "parsing/parser.ml"
-         in
-        
-# 1200 "parsing/parser.mly"
+# 40269 "parsing/parser.ml"
+           in
+          (
+# 1224 "parsing/parser.mly"
       ( x :: xs )
-# 39354 "parsing/parser.ml"
-         in
+# 40274 "parsing/parser.ml"
+           : (Parsetree.extension_constructor list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39374,19 +40295,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_d_ in
         let _endpos = _endpos_d_ in
-        let _v : (Parsetree.extension_constructor list) = let x = 
-# 3359 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3404 "parsing/parser.mly"
     (
       let cid, vars, args, res, attrs, loc, info = d in
       Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
     )
-# 39384 "parsing/parser.ml"
-         in
-        
-# 1193 "parsing/parser.mly"
+# 40306 "parsing/parser.ml"
+           in
+          (
+# 1217 "parsing/parser.mly"
       ( [x] )
-# 39389 "parsing/parser.ml"
-         in
+# 40311 "parsing/parser.ml"
+           : (Parsetree.extension_constructor list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39409,19 +40332,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_d_ in
         let _endpos = _endpos_d_ in
-        let _v : (Parsetree.extension_constructor list) = let x = 
-# 3359 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3404 "parsing/parser.mly"
     (
       let cid, vars, args, res, attrs, loc, info = d in
       Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
     )
-# 39419 "parsing/parser.ml"
-         in
-        
-# 1196 "parsing/parser.mly"
+# 40343 "parsing/parser.ml"
+           in
+          (
+# 1220 "parsing/parser.mly"
       ( [x] )
-# 39424 "parsing/parser.ml"
-         in
+# 40348 "parsing/parser.ml"
+           : (Parsetree.extension_constructor list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39451,19 +40376,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_d_ in
-        let _v : (Parsetree.extension_constructor list) = let x = 
-# 3359 "parsing/parser.mly"
+        let _v =
+          let x = 
+# 3404 "parsing/parser.mly"
     (
       let cid, vars, args, res, attrs, loc, info = d in
       Te.decl cid ~vars ~args ?res ~attrs ~loc ~info
     )
-# 39461 "parsing/parser.ml"
-         in
-        
-# 1200 "parsing/parser.mly"
+# 40387 "parsing/parser.ml"
+           in
+          (
+# 1224 "parsing/parser.mly"
       ( x :: xs )
-# 39466 "parsing/parser.ml"
-         in
+# 40392 "parsing/parser.ml"
+           : (Parsetree.extension_constructor list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39478,9 +40405,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = 
-# 1038 "parsing/parser.mly"
+# 1062 "parsing/parser.mly"
     ( [] )
-# 39484 "parsing/parser.ml"
+# 40411 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -39530,29 +40457,31 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos__3_ in
-        let _v : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = let x =
+        let _v =
           let x =
-            let (_startpos__1_, _1) = (_startpos__1_inlined1_, _1_inlined1) in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2197 "parsing/parser.mly"
+            let x =
+              let (_startpos__1_, _1) = (_startpos__1_inlined1_, _1_inlined1) in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 2219 "parsing/parser.mly"
     ( _1, _3, make_loc _sloc )
-# 39543 "parsing/parser.ml"
+# 40471 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 183 "<standard.mly>"
+# 188 "<standard.mly>"
     ( x )
-# 39549 "parsing/parser.ml"
-          
-        in
-        
-# 1040 "parsing/parser.mly"
+# 40477 "parsing/parser.ml"
+            
+          in
+          (
+# 1064 "parsing/parser.mly"
     ( x :: xs )
-# 39555 "parsing/parser.ml"
-         in
+# 40483 "parsing/parser.ml"
+           : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39574,9 +40503,9 @@ module Tables = struct
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
         let _v : (Parsetree.function_param list) = 
-# 1071 "parsing/parser.mly"
+# 1095 "parsing/parser.mly"
     ( List.rev x )
-# 39580 "parsing/parser.ml"
+# 40509 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -39606,9 +40535,9 @@ module Tables = struct
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
         let _v : (Parsetree.function_param list) = 
-# 1073 "parsing/parser.mly"
+# 1097 "parsing/parser.mly"
     ( List.rev_append x xs )
-# 39612 "parsing/parser.ml"
+# 40541 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -39631,9 +40560,9 @@ module Tables = struct
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
         let _v : ((Lexing.position * Parsetree.functor_parameter) list) = 
-# 1052 "parsing/parser.mly"
+# 1076 "parsing/parser.mly"
     ( [ x ] )
-# 39637 "parsing/parser.ml"
+# 40566 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -39663,9 +40592,9 @@ module Tables = struct
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
         let _v : ((Lexing.position * Parsetree.functor_parameter) list) = 
-# 1054 "parsing/parser.mly"
+# 1078 "parsing/parser.mly"
     ( x :: xs )
-# 39669 "parsing/parser.ml"
+# 40598 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -39688,9 +40617,9 @@ module Tables = struct
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
         let _v : ((Asttypes.arg_label * Parsetree.expression) list) = 
-# 1052 "parsing/parser.mly"
+# 1076 "parsing/parser.mly"
     ( [ x ] )
-# 39694 "parsing/parser.ml"
+# 40623 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -39720,9 +40649,9 @@ module Tables = struct
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
         let _v : ((Asttypes.arg_label * Parsetree.expression) list) = 
-# 1054 "parsing/parser.mly"
+# 1078 "parsing/parser.mly"
     ( x :: xs )
-# 39726 "parsing/parser.ml"
+# 40655 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -39745,9 +40674,9 @@ module Tables = struct
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
         let _v : (Asttypes.label list) = 
-# 1052 "parsing/parser.mly"
+# 1076 "parsing/parser.mly"
     ( [ x ] )
-# 39751 "parsing/parser.ml"
+# 40680 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -39777,9 +40706,9 @@ module Tables = struct
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
         let _v : (Asttypes.label list) = 
-# 1054 "parsing/parser.mly"
+# 1078 "parsing/parser.mly"
     ( x :: xs )
-# 39783 "parsing/parser.ml"
+# 40712 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -39808,21 +40737,23 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Asttypes.label Asttypes.loc list) = let x =
-          let _endpos = _endpos__2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3417 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _endpos = _endpos__2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 3462 "parsing/parser.mly"
     ( mkrhs _2 _sloc )
-# 39819 "parsing/parser.ml"
-          
-        in
-        
-# 1052 "parsing/parser.mly"
+# 40749 "parsing/parser.ml"
+            
+          in
+          (
+# 1076 "parsing/parser.mly"
     ( [ x ] )
-# 39825 "parsing/parser.ml"
-         in
+# 40755 "parsing/parser.ml"
+           : (Asttypes.label Asttypes.loc list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39857,21 +40788,23 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos__2_ in
-        let _v : (Asttypes.label Asttypes.loc list) = let x =
-          let _endpos = _endpos__2_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3417 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _endpos = _endpos__2_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 3462 "parsing/parser.mly"
     ( mkrhs _2 _sloc )
-# 39868 "parsing/parser.ml"
-          
-        in
-        
-# 1054 "parsing/parser.mly"
+# 40800 "parsing/parser.ml"
+            
+          in
+          (
+# 1078 "parsing/parser.mly"
     ( x :: xs )
-# 39874 "parsing/parser.ml"
-         in
+# 40806 "parsing/parser.ml"
+           : (Asttypes.label Asttypes.loc list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39892,16 +40825,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.case list) = let _1 = 
-# 124 "<standard.mly>"
+        let _v =
+          let _1 = 
+# 123 "<standard.mly>"
     ( None )
-# 39899 "parsing/parser.ml"
-         in
-        
-# 1164 "parsing/parser.mly"
+# 40833 "parsing/parser.ml"
+           in
+          (
+# 1188 "parsing/parser.mly"
     ( [x] )
-# 39904 "parsing/parser.ml"
-         in
+# 40838 "parsing/parser.ml"
+           : (Parsetree.case list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39929,19 +40864,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_inlined1_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.case list) = let _1 =
-          let x = x_inlined1 in
-          
+        let _v =
+          let _1 =
+            let x = x_inlined1 in
+            
 # 126 "<standard.mly>"
     ( Some x )
-# 39938 "parsing/parser.ml"
-          
-        in
-        
-# 1164 "parsing/parser.mly"
+# 40874 "parsing/parser.ml"
+            
+          in
+          (
+# 1188 "parsing/parser.mly"
     ( [x] )
-# 39944 "parsing/parser.ml"
-         in
+# 40880 "parsing/parser.ml"
+           : (Parsetree.case list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -39977,9 +40914,9 @@ module Tables = struct
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
         let _v : (Parsetree.case list) = 
-# 1168 "parsing/parser.mly"
+# 1192 "parsing/parser.mly"
     ( x :: xs )
-# 39983 "parsing/parser.ml"
+# 40920 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -40001,23 +40938,25 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type list) = let xs =
-          let x = 
-# 3460 "parsing/parser.mly"
+        let _v =
+          let xs =
+            let x = 
+# 3505 "parsing/parser.mly"
     ( _1 )
-# 40009 "parsing/parser.ml"
-           in
-          
-# 1099 "parsing/parser.mly"
+# 40947 "parsing/parser.ml"
+             in
+            
+# 1123 "parsing/parser.mly"
     ( [ x ] )
-# 40014 "parsing/parser.ml"
-          
-        in
-        
-# 1107 "parsing/parser.mly"
+# 40952 "parsing/parser.ml"
+            
+          in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40020 "parsing/parser.ml"
-         in
+# 40958 "parsing/parser.ml"
+           : (Parsetree.core_type list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40052,23 +40991,25 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type list) = let xs =
-          let x = 
-# 3460 "parsing/parser.mly"
+        let _v =
+          let xs =
+            let x = 
+# 3505 "parsing/parser.mly"
     ( _1 )
-# 40060 "parsing/parser.ml"
-           in
-          
-# 1103 "parsing/parser.mly"
+# 41000 "parsing/parser.ml"
+             in
+            
+# 1127 "parsing/parser.mly"
     ( x :: xs )
-# 40065 "parsing/parser.ml"
-          
-        in
-        
-# 1107 "parsing/parser.mly"
+# 41005 "parsing/parser.ml"
+            
+          in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40071 "parsing/parser.ml"
-         in
+# 41011 "parsing/parser.ml"
+           : (Parsetree.core_type list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40089,16 +41030,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.with_constraint list) = let xs = 
-# 1099 "parsing/parser.mly"
+        let _v =
+          let xs = 
+# 1123 "parsing/parser.mly"
     ( [ x ] )
-# 40096 "parsing/parser.ml"
-         in
-        
-# 1107 "parsing/parser.mly"
+# 41038 "parsing/parser.ml"
+           in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40101 "parsing/parser.ml"
-         in
+# 41043 "parsing/parser.ml"
+           : (Parsetree.with_constraint list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40133,16 +41076,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.with_constraint list) = let xs = 
-# 1103 "parsing/parser.mly"
+        let _v =
+          let xs = 
+# 1127 "parsing/parser.mly"
     ( x :: xs )
-# 40140 "parsing/parser.ml"
-         in
-        
-# 1107 "parsing/parser.mly"
+# 41084 "parsing/parser.ml"
+           in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40145 "parsing/parser.ml"
-         in
+# 41089 "parsing/parser.ml"
+           : (Parsetree.with_constraint list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40163,16 +41108,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.row_field list) = let xs = 
-# 1099 "parsing/parser.mly"
+        let _v =
+          let xs = 
+# 1123 "parsing/parser.mly"
     ( [ x ] )
-# 40170 "parsing/parser.ml"
-         in
-        
-# 1107 "parsing/parser.mly"
+# 41116 "parsing/parser.ml"
+           in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40175 "parsing/parser.ml"
-         in
+# 41121 "parsing/parser.ml"
+           : (Parsetree.row_field list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40207,16 +41154,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.row_field list) = let xs = 
-# 1103 "parsing/parser.mly"
+        let _v =
+          let xs = 
+# 1127 "parsing/parser.mly"
     ( x :: xs )
-# 40214 "parsing/parser.ml"
-         in
-        
-# 1107 "parsing/parser.mly"
+# 41162 "parsing/parser.ml"
+           in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40219 "parsing/parser.ml"
-         in
+# 41167 "parsing/parser.ml"
+           : (Parsetree.row_field list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40237,16 +41186,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.core_type list) = let xs = 
-# 1099 "parsing/parser.mly"
+        let _v =
+          let xs = 
+# 1123 "parsing/parser.mly"
     ( [ x ] )
-# 40244 "parsing/parser.ml"
-         in
-        
-# 1107 "parsing/parser.mly"
+# 41194 "parsing/parser.ml"
+           in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40249 "parsing/parser.ml"
-         in
+# 41199 "parsing/parser.ml"
+           : (Parsetree.core_type list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40281,16 +41232,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.core_type list) = let xs = 
-# 1103 "parsing/parser.mly"
+        let _v =
+          let xs = 
+# 1127 "parsing/parser.mly"
     ( x :: xs )
-# 40288 "parsing/parser.ml"
-         in
-        
-# 1107 "parsing/parser.mly"
+# 41240 "parsing/parser.ml"
+           in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40293 "parsing/parser.ml"
-         in
+# 41245 "parsing/parser.ml"
+           : (Parsetree.core_type list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40311,16 +41264,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
-        let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs = 
-# 1099 "parsing/parser.mly"
+        let _v =
+          let xs = 
+# 1123 "parsing/parser.mly"
     ( [ x ] )
-# 40318 "parsing/parser.ml"
-         in
-        
-# 1107 "parsing/parser.mly"
+# 41272 "parsing/parser.ml"
+           in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40323 "parsing/parser.ml"
-         in
+# 41277 "parsing/parser.ml"
+           : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40355,16 +41310,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
-        let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs = 
-# 1103 "parsing/parser.mly"
+        let _v =
+          let xs = 
+# 1127 "parsing/parser.mly"
     ( x :: xs )
-# 40362 "parsing/parser.ml"
-         in
-        
-# 1107 "parsing/parser.mly"
+# 41318 "parsing/parser.ml"
+           in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40367 "parsing/parser.ml"
-         in
+# 41323 "parsing/parser.ml"
+           : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40385,16 +41342,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.core_type list) = let xs = 
-# 1099 "parsing/parser.mly"
+        let _v =
+          let xs = 
+# 1123 "parsing/parser.mly"
     ( [ x ] )
-# 40392 "parsing/parser.ml"
-         in
-        
-# 1107 "parsing/parser.mly"
+# 41350 "parsing/parser.ml"
+           in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40397 "parsing/parser.ml"
-         in
+# 41355 "parsing/parser.ml"
+           : (Parsetree.core_type list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40429,16 +41388,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.core_type list) = let xs = 
-# 1103 "parsing/parser.mly"
+        let _v =
+          let xs = 
+# 1127 "parsing/parser.mly"
     ( x :: xs )
-# 40436 "parsing/parser.ml"
-         in
-        
-# 1107 "parsing/parser.mly"
+# 41396 "parsing/parser.ml"
+           in
+          (
+# 1131 "parsing/parser.mly"
     ( xs )
-# 40441 "parsing/parser.ml"
-         in
+# 41401 "parsing/parser.ml"
+           : (Parsetree.core_type list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40474,9 +41435,9 @@ module Tables = struct
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
         let _v : (Parsetree.core_type list) = 
-# 1130 "parsing/parser.mly"
+# 1154 "parsing/parser.mly"
     ( x :: xs )
-# 40480 "parsing/parser.ml"
+# 41441 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -40513,9 +41474,9 @@ module Tables = struct
         let _startpos = _startpos_x1_ in
         let _endpos = _endpos_x2_ in
         let _v : (Parsetree.core_type list) = 
-# 1134 "parsing/parser.mly"
+# 1158 "parsing/parser.mly"
     ( [ x2; x1 ] )
-# 40519 "parsing/parser.ml"
+# 41480 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -40551,23 +41512,25 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression list) = let x =
-          let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 40559 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 41521 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 40564 "parsing/parser.ml"
-          
-        in
-        
-# 1130 "parsing/parser.mly"
+# 41526 "parsing/parser.ml"
+            
+          in
+          (
+# 1154 "parsing/parser.mly"
     ( x :: xs )
-# 40570 "parsing/parser.ml"
-         in
+# 41532 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40623,50 +41586,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_xs_inlined1_ in
-        let _v : (Parsetree.expression list) = let x =
-          let (_endpos_xs_, xs) = (_endpos_xs_inlined1_, xs_inlined1) in
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let x =
+            let (_endpos_xs_, xs) = (_endpos_xs_inlined1_, xs_inlined1) in
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 40635 "parsing/parser.ml"
-                 in
+# 41599 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 41604 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 40640 "parsing/parser.ml"
+# 41610 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 40646 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 40657 "parsing/parser.ml"
+# 41621 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 40663 "parsing/parser.ml"
+# 41627 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -40679,20 +41643,21 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 40683 "parsing/parser.ml"
+# 41647 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 40689 "parsing/parser.ml"
-          
-        in
-        
-# 1130 "parsing/parser.mly"
+# 41653 "parsing/parser.ml"
+            
+          in
+          (
+# 1154 "parsing/parser.mly"
     ( x :: xs )
-# 40695 "parsing/parser.ml"
-         in
+# 41659 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40727,36 +41692,38 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression list) = let x2 =
-          let _1 = _1_inlined1 in
-          let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let x2 =
+            let _1 = _1_inlined1 in
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 40736 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 41702 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 40741 "parsing/parser.ml"
-          
-        in
-        let x1 =
-          let _1 = 
-# 2287 "parsing/parser.mly"
+# 41707 "parsing/parser.ml"
+            
+          in
+          let x1 =
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 40748 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 41714 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 40753 "parsing/parser.ml"
-          
-        in
-        
-# 1134 "parsing/parser.mly"
+# 41719 "parsing/parser.ml"
+            
+          in
+          (
+# 1158 "parsing/parser.mly"
     ( [ x2; x1 ] )
-# 40759 "parsing/parser.ml"
-         in
+# 41725 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40812,50 +41779,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression list) = let x2 =
-          let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let x2 =
+            let (_startpos__1_, _1_inlined2, _1_inlined1) = (_startpos__1_inlined1_, _1_inlined3, _1_inlined2) in
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 40824 "parsing/parser.ml"
-                 in
+# 41792 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 41797 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 40829 "parsing/parser.ml"
+# 41803 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 40835 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 40846 "parsing/parser.ml"
+# 41814 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 40852 "parsing/parser.ml"
+# 41820 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -40868,32 +41836,33 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 40872 "parsing/parser.ml"
+# 41840 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 40878 "parsing/parser.ml"
-          
-        in
-        let x1 =
-          let _1 = 
-# 2287 "parsing/parser.mly"
+# 41846 "parsing/parser.ml"
+            
+          in
+          let x1 =
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 40885 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 41853 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 40890 "parsing/parser.ml"
-          
-        in
-        
-# 1134 "parsing/parser.mly"
+# 41858 "parsing/parser.ml"
+            
+          in
+          (
+# 1158 "parsing/parser.mly"
     ( [ x2; x1 ] )
-# 40896 "parsing/parser.ml"
-         in
+# 41864 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -40949,62 +41918,63 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.expression list) = let x2 =
-          let _1 = _1_inlined3 in
-          let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let x2 =
+            let _1 = _1_inlined3 in
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 40958 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 41928 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 40963 "parsing/parser.ml"
-          
-        in
-        let x1 =
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+# 41933 "parsing/parser.ml"
+            
+          in
+          let x1 =
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 40973 "parsing/parser.ml"
-                 in
+# 41943 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 41948 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 40978 "parsing/parser.ml"
+# 41954 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 40984 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 40995 "parsing/parser.ml"
+# 41965 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 41001 "parsing/parser.ml"
+# 41971 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -41017,20 +41987,21 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 41021 "parsing/parser.ml"
+# 41991 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 41027 "parsing/parser.ml"
-          
-        in
-        
-# 1134 "parsing/parser.mly"
+# 41997 "parsing/parser.ml"
+            
+          in
+          (
+# 1158 "parsing/parser.mly"
     ( [ x2; x1 ] )
-# 41033 "parsing/parser.ml"
-         in
+# 42003 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -41107,50 +42078,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_inlined1_ in
-        let _v : (Parsetree.expression list) = let x2 =
-          let (_endpos_xs_, _startpos__1_, xs, _1_inlined2, _1_inlined1) = (_endpos_xs_inlined1_, _startpos__1_inlined3_, xs_inlined1, _1_inlined5, _1_inlined4) in
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let x2 =
+            let (_endpos_xs_, _startpos__1_, xs, _1_inlined2, _1_inlined1) = (_endpos_xs_inlined1_, _startpos__1_inlined3_, xs_inlined1, _1_inlined5, _1_inlined4) in
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 41119 "parsing/parser.ml"
-                 in
+# 42091 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 42096 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 41124 "parsing/parser.ml"
+# 42102 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 41130 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 41141 "parsing/parser.ml"
+# 42113 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 41147 "parsing/parser.ml"
+# 42119 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -41163,58 +42135,58 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 41167 "parsing/parser.ml"
+# 42139 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 41173 "parsing/parser.ml"
-          
-        in
-        let x1 =
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+# 42145 "parsing/parser.ml"
+            
+          in
+          let x1 =
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 41183 "parsing/parser.ml"
-                 in
+# 42155 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 42160 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 41188 "parsing/parser.ml"
+# 42166 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 41194 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 41205 "parsing/parser.ml"
+# 42177 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 41211 "parsing/parser.ml"
+# 42183 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -41227,20 +42199,21 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 41231 "parsing/parser.ml"
+# 42203 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 41237 "parsing/parser.ml"
-          
-        in
-        
-# 1134 "parsing/parser.mly"
+# 42209 "parsing/parser.ml"
+            
+          in
+          (
+# 1158 "parsing/parser.mly"
     ( [ x2; x1 ] )
-# 41243 "parsing/parser.ml"
-         in
+# 42215 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -41276,9 +42249,9 @@ module Tables = struct
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_x_ in
         let _v : (Parsetree.core_type list) = 
-# 1130 "parsing/parser.mly"
+# 1154 "parsing/parser.mly"
     ( x :: xs )
-# 41282 "parsing/parser.ml"
+# 42255 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -41315,9 +42288,9 @@ module Tables = struct
         let _startpos = _startpos_x1_ in
         let _endpos = _endpos_x2_ in
         let _v : (Parsetree.core_type list) = 
-# 1134 "parsing/parser.mly"
+# 1158 "parsing/parser.mly"
     ( [ x2; x1 ] )
-# 41321 "parsing/parser.ml"
+# 42294 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -41340,9 +42313,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.row_field) = 
-# 3656 "parsing/parser.mly"
+# 3701 "parsing/parser.mly"
       ( _1 )
-# 41346 "parsing/parser.ml"
+# 42319 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -41364,14 +42337,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.row_field) = let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3658 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3703 "parsing/parser.mly"
       ( Rf.inherit_ ~loc:(make_loc _sloc) _1 )
-# 41374 "parsing/parser.ml"
-         in
+# 42348 "parsing/parser.ml"
+           : (Parsetree.row_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -41392,28 +42367,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression list) = let _2 = 
-# 124 "<standard.mly>"
+        let _v =
+          let _2 = 
+# 123 "<standard.mly>"
     ( None )
-# 41399 "parsing/parser.ml"
-         in
-        let x =
-          let _1 = 
-# 2287 "parsing/parser.mly"
-      ( _1 )
-# 41405 "parsing/parser.ml"
+# 42375 "parsing/parser.ml"
            in
-          
-# 2431 "parsing/parser.mly"
+          let x =
+            let _1 = 
+# 2309 "parsing/parser.mly"
+      ( _1 )
+# 42381 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 41410 "parsing/parser.ml"
-          
-        in
-        
-# 1151 "parsing/parser.mly"
+# 42386 "parsing/parser.ml"
+            
+          in
+          (
+# 1175 "parsing/parser.mly"
     ( [x] )
-# 41416 "parsing/parser.ml"
-         in
+# 42392 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -41441,28 +42418,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.expression list) = let _2 = 
+        let _v =
+          let _2 = 
 # 126 "<standard.mly>"
     ( Some x )
-# 41448 "parsing/parser.ml"
-         in
-        let x =
-          let _1 = 
-# 2287 "parsing/parser.mly"
-      ( _1 )
-# 41454 "parsing/parser.ml"
+# 42426 "parsing/parser.ml"
            in
-          
-# 2431 "parsing/parser.mly"
+          let x =
+            let _1 = 
+# 2309 "parsing/parser.mly"
+      ( _1 )
+# 42432 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 41459 "parsing/parser.ml"
-          
-        in
-        
-# 1151 "parsing/parser.mly"
+# 42437 "parsing/parser.ml"
+            
+          in
+          (
+# 1175 "parsing/parser.mly"
     ( [x] )
-# 41465 "parsing/parser.ml"
-         in
+# 42443 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -41504,54 +42483,55 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression list) = let _2 = 
-# 124 "<standard.mly>"
+        let _v =
+          let _2 = 
+# 123 "<standard.mly>"
     ( None )
-# 41511 "parsing/parser.ml"
-         in
-        let x =
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+# 42491 "parsing/parser.ml"
+           in
+          let x =
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 41520 "parsing/parser.ml"
-                 in
+# 42500 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 42505 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 41525 "parsing/parser.ml"
+# 42511 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 41531 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 41542 "parsing/parser.ml"
+# 42522 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 41548 "parsing/parser.ml"
+# 42528 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -41564,20 +42544,21 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 41568 "parsing/parser.ml"
+# 42548 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 41574 "parsing/parser.ml"
-          
-        in
-        
-# 1151 "parsing/parser.mly"
+# 42554 "parsing/parser.ml"
+            
+          in
+          (
+# 1175 "parsing/parser.mly"
     ( [x] )
-# 41580 "parsing/parser.ml"
-         in
+# 42560 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -41626,54 +42607,55 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.expression list) = let _2 = 
+        let _v =
+          let _2 = 
 # 126 "<standard.mly>"
     ( Some x )
-# 41633 "parsing/parser.ml"
-         in
-        let x =
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+# 42615 "parsing/parser.ml"
+           in
+          let x =
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 41642 "parsing/parser.ml"
-                 in
+# 42624 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 42629 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 41647 "parsing/parser.ml"
+# 42635 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 41653 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 41664 "parsing/parser.ml"
+# 42646 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 41670 "parsing/parser.ml"
+# 42652 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -41686,20 +42668,21 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 41690 "parsing/parser.ml"
+# 42672 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 41696 "parsing/parser.ml"
-          
-        in
-        
-# 1151 "parsing/parser.mly"
+# 42678 "parsing/parser.ml"
+            
+          in
+          (
+# 1175 "parsing/parser.mly"
     ( [x] )
-# 41702 "parsing/parser.ml"
-         in
+# 42684 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -41734,23 +42717,25 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression list) = let x =
-          let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let x =
+            let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 41742 "parsing/parser.ml"
-           in
-          
-# 2431 "parsing/parser.mly"
+# 42726 "parsing/parser.ml"
+             in
+            
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 41747 "parsing/parser.ml"
-          
-        in
-        
-# 1155 "parsing/parser.mly"
+# 42731 "parsing/parser.ml"
+            
+          in
+          (
+# 1179 "parsing/parser.mly"
     ( x :: xs )
-# 41753 "parsing/parser.ml"
-         in
+# 42737 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -41806,50 +42791,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression list) = let x =
-          let (_endpos_xs_, xs) = (_endpos_xs_inlined1_, xs_inlined1) in
-          let _1 =
-            let _3 =
-              let xs =
-                let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let x =
+            let (_endpos_xs_, xs) = (_endpos_xs_inlined1_, xs_inlined1) in
+            let _1 =
+              let _3 =
+                let xs =
+                  let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 41818 "parsing/parser.ml"
-                 in
+# 42804 "parsing/parser.ml"
+                   in
+                  
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 42809 "parsing/parser.ml"
+                  
+                in
                 
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 41823 "parsing/parser.ml"
+# 42815 "parsing/parser.ml"
                 
               in
-              
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 41829 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos_xs_ in
-            let _2 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _endpos__3_ = _endpos_xs_ in
               let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 41840 "parsing/parser.ml"
+# 42826 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 41846 "parsing/parser.ml"
+# 42832 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _endpos = _endpos__3_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -41862,20 +42848,21 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 41866 "parsing/parser.ml"
+# 42852 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2431 "parsing/parser.mly"
+# 2453 "parsing/parser.mly"
                           ( _1 )
-# 41872 "parsing/parser.ml"
-          
-        in
-        
-# 1155 "parsing/parser.mly"
+# 42858 "parsing/parser.ml"
+            
+          in
+          (
+# 1179 "parsing/parser.mly"
     ( x :: xs )
-# 41878 "parsing/parser.ml"
-         in
+# 42864 "parsing/parser.ml"
+           : (Parsetree.expression list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -41900,36 +42887,37 @@ module Tables = struct
         } = _menhir_stack in
         let oe : (Parsetree.expression option) = Obj.magic oe in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 41906 "parsing/parser.ml"
+# 42893 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_oe_ in
-        let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 = 
-# 124 "<standard.mly>"
+        let _v =
+          let _2 = 
+# 123 "<standard.mly>"
     ( None )
-# 41914 "parsing/parser.ml"
-         in
-        let x =
-          let label =
-            let _1 = 
-# 3720 "parsing/parser.mly"
+# 42902 "parsing/parser.ml"
+           in
+          let x =
+            let label =
+              let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 41921 "parsing/parser.ml"
-             in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 42909 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 41929 "parsing/parser.ml"
+# 42917 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2819 "parsing/parser.mly"
+# 2861 "parsing/parser.mly"
       ( let label, e =
           match oe with
           | None ->
@@ -41939,14 +42927,15 @@ module Tables = struct
               label, e
         in
         label, e )
-# 41943 "parsing/parser.ml"
-          
-        in
-        
-# 1151 "parsing/parser.mly"
+# 42931 "parsing/parser.ml"
+            
+          in
+          (
+# 1175 "parsing/parser.mly"
     ( [x] )
-# 41949 "parsing/parser.ml"
-         in
+# 42937 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Parsetree.expression) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -41978,36 +42967,37 @@ module Tables = struct
         let x : unit = Obj.magic x in
         let oe : (Parsetree.expression option) = Obj.magic oe in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 41984 "parsing/parser.ml"
+# 42973 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_x_ in
-        let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 = 
+        let _v =
+          let _2 = 
 # 126 "<standard.mly>"
     ( Some x )
-# 41992 "parsing/parser.ml"
-         in
-        let x =
-          let label =
-            let _1 = 
-# 3720 "parsing/parser.mly"
+# 42982 "parsing/parser.ml"
+           in
+          let x =
+            let label =
+              let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 41999 "parsing/parser.ml"
-             in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 42989 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 42007 "parsing/parser.ml"
+# 42997 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2819 "parsing/parser.mly"
+# 2861 "parsing/parser.mly"
       ( let label, e =
           match oe with
           | None ->
@@ -42017,14 +43007,15 @@ module Tables = struct
               label, e
         in
         label, e )
-# 42021 "parsing/parser.ml"
-          
-        in
-        
-# 1151 "parsing/parser.mly"
+# 43011 "parsing/parser.ml"
+            
+          in
+          (
+# 1175 "parsing/parser.mly"
     ( [x] )
-# 42027 "parsing/parser.ml"
-         in
+# 43017 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Parsetree.expression) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42063,31 +43054,32 @@ module Tables = struct
         let _2 : unit = Obj.magic _2 in
         let oe : (Parsetree.expression option) = Obj.magic oe in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 42069 "parsing/parser.ml"
+# 43060 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let x =
-          let label =
-            let _1 = 
-# 3720 "parsing/parser.mly"
+        let _v =
+          let x =
+            let label =
+              let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 42079 "parsing/parser.ml"
-             in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 43071 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 42087 "parsing/parser.ml"
+# 43079 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2819 "parsing/parser.mly"
+# 2861 "parsing/parser.mly"
       ( let label, e =
           match oe with
           | None ->
@@ -42097,14 +43089,15 @@ module Tables = struct
               label, e
         in
         label, e )
-# 42101 "parsing/parser.ml"
-          
-        in
-        
-# 1155 "parsing/parser.mly"
+# 43093 "parsing/parser.ml"
+            
+          in
+          (
+# 1179 "parsing/parser.mly"
     ( x :: xs )
-# 42107 "parsing/parser.ml"
-         in
+# 43099 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Parsetree.expression) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42125,16 +43118,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_ in
-        let _v : (Parsetree.pattern list) = let _2 = 
-# 124 "<standard.mly>"
+        let _v =
+          let _2 = 
+# 123 "<standard.mly>"
     ( None )
-# 42132 "parsing/parser.ml"
-         in
-        
-# 1151 "parsing/parser.mly"
+# 43126 "parsing/parser.ml"
+           in
+          (
+# 1175 "parsing/parser.mly"
     ( [x] )
-# 42137 "parsing/parser.ml"
-         in
+# 43131 "parsing/parser.ml"
+           : (Parsetree.pattern list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42162,19 +43157,21 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_x_inlined1_ in
-        let _v : (Parsetree.pattern list) = let _2 =
-          let x = x_inlined1 in
-          
+        let _v =
+          let _2 =
+            let x = x_inlined1 in
+            
 # 126 "<standard.mly>"
     ( Some x )
-# 42171 "parsing/parser.ml"
-          
-        in
-        
-# 1151 "parsing/parser.mly"
+# 43167 "parsing/parser.ml"
+            
+          in
+          (
+# 1175 "parsing/parser.mly"
     ( [x] )
-# 42177 "parsing/parser.ml"
-         in
+# 43173 "parsing/parser.ml"
+           : (Parsetree.pattern list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42210,9 +43207,9 @@ module Tables = struct
         let _startpos = _startpos_x_ in
         let _endpos = _endpos_xs_ in
         let _v : (Parsetree.pattern list) = 
-# 1155 "parsing/parser.mly"
+# 1179 "parsing/parser.mly"
     ( x :: xs )
-# 42216 "parsing/parser.ml"
+# 43213 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -42248,28 +43245,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_eo_ in
-        let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 = 
-# 124 "<standard.mly>"
+        let _v =
+          let _2 = 
+# 123 "<standard.mly>"
     ( None )
-# 42255 "parsing/parser.ml"
-         in
-        let x =
-          let label =
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 43253 "parsing/parser.ml"
+           in
+          let x =
+            let label =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 42265 "parsing/parser.ml"
+# 43263 "parsing/parser.ml"
+              
+            in
+            let _startpos_label_ = _startpos__1_ in
+            let _endpos = _endpos_eo_ in
+            let _symbolstartpos = _startpos_label_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _startpos_label_ = _startpos__1_ in
-          let _endpos = _endpos_eo_ in
-          let _symbolstartpos = _startpos_label_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2802 "parsing/parser.mly"
+# 2844 "parsing/parser.mly"
       ( let constraint_loc, label, e =
           match eo with
           | None ->
@@ -42279,14 +43277,15 @@ module Tables = struct
               (_startpos_c_, _endpos), label, e
         in
         label, mkexp_opt_constraint ~loc:constraint_loc e c )
-# 42283 "parsing/parser.ml"
-          
-        in
-        
-# 1151 "parsing/parser.mly"
+# 43281 "parsing/parser.ml"
+            
+          in
+          (
+# 1175 "parsing/parser.mly"
     ( [x] )
-# 42289 "parsing/parser.ml"
-         in
+# 43287 "parsing/parser.ml"
+           : ((Longident.t Asttypes.loc * Parsetree.expression) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42328,28 +43327,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_x_ in
-        let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 = 
+        let _v =
+          let _2 = 
 # 126 "<standard.mly>"
     ( Some x )
-# 42335 "parsing/parser.ml"
-         in
-        let x =
-          let label =
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+# 43335 "parsing/parser.ml"
+           in
+          let x =
+            let label =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 42345 "parsing/parser.ml"
+# 43345 "parsing/parser.ml"
+              
+            in
+            let _startpos_label_ = _startpos__1_ in
+            let _endpos = _endpos_eo_ in
+            let _symbolstartpos = _startpos_label_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _startpos_label_ = _startpos__1_ in
-          let _endpos = _endpos_eo_ in
-          let _symbolstartpos = _startpos_label_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2802 "parsing/parser.mly"
+# 2844 "parsing/parser.mly"
       ( let constraint_loc, label, e =
           match eo with
           | None ->
@@ -42359,14 +43359,15 @@ module Tables = struct
               (_startpos_c_, _endpos), label, e
         in
         label, mkexp_opt_constraint ~loc:constraint_loc e c )
-# 42363 "parsing/parser.ml"
-          
-        in
-        
-# 1151 "parsing/parser.mly"
+# 43363 "parsing/parser.ml"
+            
+          in
+          (
+# 1175 "parsing/parser.mly"
     ( [x] )
-# 42369 "parsing/parser.ml"
-         in
+# 43369 "parsing/parser.ml"
+           : ((Longident.t Asttypes.loc * Parsetree.expression) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42415,23 +43416,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let x =
-          let label =
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+        let _v =
+          let x =
+            let label =
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 42427 "parsing/parser.ml"
+# 43429 "parsing/parser.ml"
+              
+            in
+            let _startpos_label_ = _startpos__1_ in
+            let _endpos = _endpos_eo_ in
+            let _symbolstartpos = _startpos_label_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _startpos_label_ = _startpos__1_ in
-          let _endpos = _endpos_eo_ in
-          let _symbolstartpos = _startpos_label_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2802 "parsing/parser.mly"
+# 2844 "parsing/parser.mly"
       ( let constraint_loc, label, e =
           match eo with
           | None ->
@@ -42441,14 +43443,15 @@ module Tables = struct
               (_startpos_c_, _endpos), label, e
         in
         label, mkexp_opt_constraint ~loc:constraint_loc e c )
-# 42445 "parsing/parser.ml"
-          
-        in
-        
-# 1155 "parsing/parser.mly"
+# 43447 "parsing/parser.ml"
+            
+          in
+          (
+# 1179 "parsing/parser.mly"
     ( x :: xs )
-# 42451 "parsing/parser.ml"
-         in
+# 43453 "parsing/parser.ml"
+           : ((Longident.t Asttypes.loc * Parsetree.expression) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42469,16 +43472,18 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 = 
-# 2287 "parsing/parser.mly"
+        let _v =
+          let _1 = 
+# 2309 "parsing/parser.mly"
       ( _1 )
-# 42476 "parsing/parser.ml"
-         in
-        
-# 2325 "parsing/parser.mly"
+# 43480 "parsing/parser.ml"
+           in
+          (
+# 2347 "parsing/parser.mly"
                               ( _1 )
-# 42481 "parsing/parser.ml"
-         in
+# 43485 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42520,48 +43525,49 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _3 =
-            let xs =
-              let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _1 =
+            let _3 =
+              let xs =
+                let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 42530 "parsing/parser.ml"
-               in
+# 43536 "parsing/parser.ml"
+                 in
+                
+# 1200 "parsing/parser.mly"
+    ( xs )
+# 43541 "parsing/parser.ml"
+                
+              in
               
-# 1176 "parsing/parser.mly"
+# 2798 "parsing/parser.mly"
     ( xs )
-# 42535 "parsing/parser.ml"
+# 43547 "parsing/parser.ml"
               
             in
-            
-# 2756 "parsing/parser.mly"
-    ( xs )
-# 42541 "parsing/parser.ml"
-            
-          in
-          let _endpos__3_ = _endpos_xs_ in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _endpos__3_ = _endpos_xs_ in
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 42552 "parsing/parser.ml"
+# 43558 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 42558 "parsing/parser.ml"
+# 43564 "parsing/parser.ml"
+              
+            in
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos = _endpos__3_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2289 "parsing/parser.mly"
+# 2311 "parsing/parser.mly"
       ( let loc = make_loc _sloc in
         let cases = _3 in
         (* There are two choices of where to put attributes: on the
@@ -42574,14 +43580,15 @@ module Tables = struct
         let desc = mkfunction [] None (Pfunction_cases (cases, loc, [])) in
         mkexp_attrs ~loc:_sloc desc _2
       )
-# 42578 "parsing/parser.ml"
-          
-        in
-        
-# 2325 "parsing/parser.mly"
+# 43584 "parsing/parser.ml"
+            
+          in
+          (
+# 2347 "parsing/parser.mly"
                               ( _1 )
-# 42584 "parsing/parser.ml"
-         in
+# 43590 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42645,57 +43652,59 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
-          let _1 = _1_inlined4 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs =
+            let _1 = _1_inlined4 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 42654 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs_ = _endpos__1_inlined4_ in
-        let attrs2 =
-          let _1 = _1_inlined3 in
-          
-# 4062 "parsing/parser.mly"
+# 43662 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs_ = _endpos__1_inlined4_ in
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 42663 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined3_ in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 43671 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined3_ in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 42675 "parsing/parser.ml"
-          
-        in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 43683 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 42683 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs_ in
-        let _startpos = _startpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3272 "parsing/parser.mly"
+# 43691 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs_ in
+          let _startpos = _startpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3317 "parsing/parser.mly"
     ( let vars, args, res = vars_args_res in
       let loc = make_loc (_startpos, _endpos_attrs2_) in
       let docs = symbol_docs _sloc in
       Te.mk_exception ~attrs
         (Te.decl id ~vars ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
       , ext )
-# 42698 "parsing/parser.ml"
-         in
+# 43706 "parsing/parser.ml"
+           : (Parsetree.type_exception * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42716,26 +43725,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xss_ in
         let _endpos = _endpos_xss_ in
-        let _v : (Parsetree.signature) = let _1 =
-          let _1 = 
-# 260 "<standard.mly>"
+        let _v =
+          let _1 =
+            let _1 = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 42724 "parsing/parser.ml"
-           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
-          let _endpos = _endpos__1_ in
-          let _startpos = _startpos__1_ in
-          
-# 953 "parsing/parser.mly"
+# 43734 "parsing/parser.ml"
+             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+            let _endpos = _endpos__1_ in
+            let _startpos = _startpos__1_ in
+            
+# 977 "parsing/parser.mly"
                               ( extra_sig _startpos _endpos _1 )
-# 42732 "parsing/parser.ml"
-          
-        in
-        
-# 1733 "parsing/parser.mly"
+# 43742 "parsing/parser.ml"
+            
+          in
+          (
+# 1755 "parsing/parser.mly"
     ( _1 )
-# 42738 "parsing/parser.ml"
-         in
+# 43748 "parsing/parser.ml"
+           : (Parsetree.signature))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42763,24 +43774,26 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.signature_item) = let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 42772 "parsing/parser.ml"
-          
-        in
-        let _endpos__2_ = _endpos__1_inlined1_ in
-        let _endpos = _endpos__2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1748 "parsing/parser.mly"
+# 43784 "parsing/parser.ml"
+            
+          in
+          let _endpos__2_ = _endpos__1_inlined1_ in
+          let _endpos = _endpos__2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1770 "parsing/parser.mly"
       ( let docs = symbol_docs _sloc in
         mksig ~loc:_sloc (Psig_extension (_1, (add_docs_attrs docs _2))) )
-# 42783 "parsing/parser.ml"
-         in
+# 43795 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42801,26 +43814,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.signature_item) = let _1 =
-          let _1 = 
-# 1752 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1774 "parsing/parser.mly"
         ( Psig_attribute _1 )
-# 42809 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1001 "parsing/parser.mly"
+# 43823 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1025 "parsing/parser.mly"
     ( mksig ~loc:_sloc _1 )
-# 42817 "parsing/parser.ml"
-          
-        in
-        
-# 1754 "parsing/parser.mly"
+# 43831 "parsing/parser.ml"
+            
+          in
+          (
+# 1776 "parsing/parser.mly"
     ( _1 )
-# 42823 "parsing/parser.ml"
-         in
+# 43837 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42841,26 +43856,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.signature_item) = let _1 =
-          let _1 = 
-# 1757 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1779 "parsing/parser.mly"
         ( psig_value _1 )
-# 42849 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
+# 43865 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1042 "parsing/parser.mly"
     ( wrap_mksig_ext ~loc:_sloc _1 )
-# 42857 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+# 43873 "parsing/parser.ml"
+            
+          in
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 42863 "parsing/parser.ml"
-         in
+# 43879 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42881,26 +43898,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.signature_item) = let _1 =
-          let _1 = 
-# 1759 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1781 "parsing/parser.mly"
         ( psig_value _1 )
-# 42889 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
+# 43907 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1042 "parsing/parser.mly"
     ( wrap_mksig_ext ~loc:_sloc _1 )
-# 42897 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+# 43915 "parsing/parser.ml"
+            
+          in
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 42903 "parsing/parser.ml"
-         in
+# 43921 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42929,48 +43948,50 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_a_ in
         let _endpos = _endpos_bs_ in
-        let _v : (Parsetree.signature_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
               let _1 =
-                let _1 = 
-# 1212 "parsing/parser.mly"
+                let _1 =
+                  let _1 = 
+# 1236 "parsing/parser.mly"
     ( let (x, b) = a in x, b :: bs )
-# 42940 "parsing/parser.ml"
-                 in
-                
-# 3093 "parsing/parser.mly"
+# 43960 "parsing/parser.ml"
+                   in
+                  
+# 3138 "parsing/parser.mly"
   ( _1 )
-# 42945 "parsing/parser.ml"
+# 43965 "parsing/parser.ml"
+                  
+                in
+                
+# 3121 "parsing/parser.mly"
+    ( _1 )
+# 43971 "parsing/parser.ml"
                 
               in
               
-# 3076 "parsing/parser.mly"
-    ( _1 )
-# 42951 "parsing/parser.ml"
+# 1783 "parsing/parser.mly"
+        ( psig_type _1 )
+# 43977 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1761 "parsing/parser.mly"
-        ( psig_type _1 )
-# 42957 "parsing/parser.ml"
+# 1042 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 43987 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
-    ( wrap_mksig_ext ~loc:_sloc _1 )
-# 42967 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 42973 "parsing/parser.ml"
-         in
+# 43993 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -42999,48 +44020,50 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_a_ in
         let _endpos = _endpos_bs_ in
-        let _v : (Parsetree.signature_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
               let _1 =
-                let _1 = 
-# 1212 "parsing/parser.mly"
+                let _1 =
+                  let _1 = 
+# 1236 "parsing/parser.mly"
     ( let (x, b) = a in x, b :: bs )
-# 43010 "parsing/parser.ml"
-                 in
-                
-# 3093 "parsing/parser.mly"
+# 44032 "parsing/parser.ml"
+                   in
+                  
+# 3138 "parsing/parser.mly"
   ( _1 )
-# 43015 "parsing/parser.ml"
+# 44037 "parsing/parser.ml"
+                  
+                in
+                
+# 3126 "parsing/parser.mly"
+    ( _1 )
+# 44043 "parsing/parser.ml"
                 
               in
               
-# 3081 "parsing/parser.mly"
-    ( _1 )
-# 43021 "parsing/parser.ml"
+# 1785 "parsing/parser.mly"
+        ( psig_typesubst _1 )
+# 44049 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1763 "parsing/parser.mly"
-        ( psig_typesubst _1 )
-# 43027 "parsing/parser.ml"
+# 1042 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 44059 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
-    ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43037 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43043 "parsing/parser.ml"
-         in
+# 44065 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -43117,87 +44140,89 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.signature_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
               let _1 =
-                let attrs2 =
-                  let _1 = _1_inlined3 in
-                  
-# 4058 "parsing/parser.mly"
+                let _1 =
+                  let attrs2 =
+                    let _1 = _1_inlined3 in
+                    
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 43130 "parsing/parser.ml"
-                  
-                in
-                let _endpos_attrs2_ = _endpos__1_inlined3_ in
-                let cs = 
-# 1204 "parsing/parser.mly"
+# 44154 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos_attrs2_ = _endpos__1_inlined3_ in
+                  let cs = 
+# 1228 "parsing/parser.mly"
     ( List.rev xs )
-# 43137 "parsing/parser.ml"
-                 in
-                let tid =
-                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-                  let _endpos = _endpos__1_ in
-                  let _symbolstartpos = _startpos__1_ in
-                  let _sloc = (_symbolstartpos, _endpos) in
-                  
-# 960 "parsing/parser.mly"
+# 44161 "parsing/parser.ml"
+                   in
+                  let tid =
+                    let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                    let _endpos = _endpos__1_ in
+                    let _symbolstartpos = _startpos__1_ in
+                    let _sloc = (_symbolstartpos, _endpos) in
+                    
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 43147 "parsing/parser.ml"
-                  
-                in
-                let _4 = 
-# 3903 "parsing/parser.mly"
+# 44171 "parsing/parser.ml"
+                    
+                  in
+                  let _4 = 
+# 3955 "parsing/parser.mly"
                 ( Recursive )
-# 43153 "parsing/parser.ml"
-                 in
-                let attrs1 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+# 44177 "parsing/parser.ml"
+                   in
+                  let attrs1 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 43160 "parsing/parser.ml"
+# 44184 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos_attrs2_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos_attrs2_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 3346 "parsing/parser.mly"
+# 3391 "parsing/parser.mly"
     ( let docs = symbol_docs _sloc in
       let attrs = attrs1 @ attrs2 in
       Te.mk tid cs ~params ~priv ~attrs ~docs,
       ext )
-# 43172 "parsing/parser.ml"
+# 44196 "parsing/parser.ml"
+                  
+                in
+                
+# 3378 "parsing/parser.mly"
+    ( _1 )
+# 44202 "parsing/parser.ml"
                 
               in
               
-# 3333 "parsing/parser.mly"
-    ( _1 )
-# 43178 "parsing/parser.ml"
+# 1787 "parsing/parser.mly"
+        ( psig_typext _1 )
+# 44208 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1765 "parsing/parser.mly"
-        ( psig_typext _1 )
-# 43184 "parsing/parser.ml"
+# 1042 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 44218 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
-    ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43194 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43200 "parsing/parser.ml"
-         in
+# 44224 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -43281,93 +44306,95 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : (Parsetree.signature_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
               let _1 =
-                let attrs2 =
-                  let _1 = _1_inlined4 in
-                  
-# 4058 "parsing/parser.mly"
+                let _1 =
+                  let attrs2 =
+                    let _1 = _1_inlined4 in
+                    
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 43294 "parsing/parser.ml"
-                  
-                in
-                let _endpos_attrs2_ = _endpos__1_inlined4_ in
-                let cs = 
-# 1204 "parsing/parser.mly"
+# 44320 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos_attrs2_ = _endpos__1_inlined4_ in
+                  let cs = 
+# 1228 "parsing/parser.mly"
     ( List.rev xs )
-# 43301 "parsing/parser.ml"
-                 in
-                let tid =
-                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-                  let _endpos = _endpos__1_ in
-                  let _symbolstartpos = _startpos__1_ in
-                  let _sloc = (_symbolstartpos, _endpos) in
-                  
-# 960 "parsing/parser.mly"
+# 44327 "parsing/parser.ml"
+                   in
+                  let tid =
+                    let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+                    let _endpos = _endpos__1_ in
+                    let _symbolstartpos = _startpos__1_ in
+                    let _sloc = (_symbolstartpos, _endpos) in
+                    
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 43311 "parsing/parser.ml"
-                  
-                in
-                let _4 =
-                  let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
-                  let _endpos = _endpos__1_ in
-                  let _startpos = _startpos__1_ in
-                  let _loc = (_startpos, _endpos) in
-                  
-# 3905 "parsing/parser.mly"
+# 44337 "parsing/parser.ml"
+                    
+                  in
+                  let _4 =
+                    let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
+                    let _endpos = _endpos__1_ in
+                    let _startpos = _startpos__1_ in
+                    let _loc = (_startpos, _endpos) in
+                    
+# 3957 "parsing/parser.mly"
                 ( not_expecting _loc "nonrec flag" )
-# 43322 "parsing/parser.ml"
-                  
-                in
-                let attrs1 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+# 44348 "parsing/parser.ml"
+                    
+                  in
+                  let attrs1 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 43330 "parsing/parser.ml"
+# 44356 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos_attrs2_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos_attrs2_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 3346 "parsing/parser.mly"
+# 3391 "parsing/parser.mly"
     ( let docs = symbol_docs _sloc in
       let attrs = attrs1 @ attrs2 in
       Te.mk tid cs ~params ~priv ~attrs ~docs,
       ext )
-# 43342 "parsing/parser.ml"
+# 44368 "parsing/parser.ml"
+                  
+                in
+                
+# 3378 "parsing/parser.mly"
+    ( _1 )
+# 44374 "parsing/parser.ml"
                 
               in
               
-# 3333 "parsing/parser.mly"
-    ( _1 )
-# 43348 "parsing/parser.ml"
+# 1787 "parsing/parser.mly"
+        ( psig_typext _1 )
+# 44380 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1765 "parsing/parser.mly"
-        ( psig_typext _1 )
-# 43354 "parsing/parser.ml"
+# 1042 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 44390 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
-    ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43364 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43370 "parsing/parser.ml"
-         in
+# 44396 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -43388,26 +44415,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.signature_item) = let _1 =
-          let _1 = 
-# 1767 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1789 "parsing/parser.mly"
         ( psig_exception _1 )
-# 43396 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
+# 44424 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1042 "parsing/parser.mly"
     ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43404 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+# 44432 "parsing/parser.ml"
+            
+          in
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43410 "parsing/parser.ml"
-         in
+# 44438 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -43463,72 +44492,74 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.signature_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let attrs2 =
-                let _1 = _1_inlined3 in
-                
-# 4058 "parsing/parser.mly"
+              let _1 =
+                let attrs2 =
+                  let _1 = _1_inlined3 in
+                  
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 43475 "parsing/parser.ml"
-                
-              in
-              let _endpos_attrs2_ = _endpos__1_inlined3_ in
-              let name =
-                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 960 "parsing/parser.mly"
+# 44505 "parsing/parser.ml"
+                  
+                in
+                let _endpos_attrs2_ = _endpos__1_inlined3_ in
+                let name =
+                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 43487 "parsing/parser.ml"
-                
-              in
-              let attrs1 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+# 44517 "parsing/parser.ml"
+                  
+                in
+                let attrs1 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 43495 "parsing/parser.ml"
+# 44525 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos_attrs2_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos_attrs2_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 1798 "parsing/parser.mly"
+# 1820 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Md.mk name body ~attrs ~loc ~docs, ext
   )
-# 43509 "parsing/parser.ml"
+# 44539 "parsing/parser.ml"
+                
+              in
+              
+# 1791 "parsing/parser.mly"
+        ( let (body, ext) = _1 in (Psig_module body, ext) )
+# 44545 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1769 "parsing/parser.mly"
-        ( let (body, ext) = _1 in (Psig_module body, ext) )
-# 43515 "parsing/parser.ml"
+# 1042 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 44555 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
-    ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43525 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43531 "parsing/parser.ml"
-         in
+# 44561 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -43591,94 +44622,96 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : (Parsetree.signature_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let attrs2 =
-                let _1 = _1_inlined4 in
-                
-# 4058 "parsing/parser.mly"
+              let _1 =
+                let attrs2 =
+                  let _1 = _1_inlined4 in
+                  
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 43603 "parsing/parser.ml"
-                
-              in
-              let _endpos_attrs2_ = _endpos__1_inlined4_ in
-              let body =
-                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-                let id =
+# 44635 "parsing/parser.ml"
+                  
+                in
+                let _endpos_attrs2_ = _endpos__1_inlined4_ in
+                let body =
+                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+                  let id =
+                    let _endpos = _endpos__1_ in
+                    let _symbolstartpos = _startpos__1_ in
+                    let _sloc = (_symbolstartpos, _endpos) in
+                    
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 44648 "parsing/parser.ml"
+                    
+                  in
+                  let (_endpos_id_, _startpos_id_) = (_endpos__1_, _startpos__1_) in
+                  let _endpos = _endpos_id_ in
+                  let _symbolstartpos = _startpos_id_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 1859 "parsing/parser.mly"
+    ( Mty.alias ~loc:(make_loc _sloc) id )
+# 44658 "parsing/parser.ml"
+                  
+                in
+                let name =
+                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
                   let _endpos = _endpos__1_ in
                   let _symbolstartpos = _startpos__1_ in
                   let _sloc = (_symbolstartpos, _endpos) in
                   
-# 960 "parsing/parser.mly"
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 43616 "parsing/parser.ml"
+# 44669 "parsing/parser.ml"
                   
                 in
-                let (_endpos_id_, _startpos_id_) = (_endpos__1_, _startpos__1_) in
-                let _endpos = _endpos_id_ in
-                let _symbolstartpos = _startpos_id_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 1837 "parsing/parser.mly"
-    ( Mty.alias ~loc:(make_loc _sloc) id )
-# 43626 "parsing/parser.ml"
-                
-              in
-              let name =
-                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-                let _endpos = _endpos__1_ in
+                let attrs1 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
+    ( _1 )
+# 44677 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos_attrs2_ in
                 let _symbolstartpos = _startpos__1_ in
                 let _sloc = (_symbolstartpos, _endpos) in
                 
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 43637 "parsing/parser.ml"
-                
-              in
-              let attrs1 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
-    ( _1 )
-# 43645 "parsing/parser.ml"
-                
-              in
-              let _endpos = _endpos_attrs2_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 1828 "parsing/parser.mly"
+# 1850 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Md.mk name body ~attrs ~loc ~docs, ext
   )
-# 43659 "parsing/parser.ml"
+# 44691 "parsing/parser.ml"
+                
+              in
+              
+# 1793 "parsing/parser.mly"
+        ( let (body, ext) = _1 in (Psig_module body, ext) )
+# 44697 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1771 "parsing/parser.mly"
-        ( let (body, ext) = _1 in (Psig_module body, ext) )
-# 43665 "parsing/parser.ml"
+# 1042 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 44707 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
-    ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43675 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43681 "parsing/parser.ml"
-         in
+# 44713 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -43699,26 +44732,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.signature_item) = let _1 =
-          let _1 = 
-# 1773 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1795 "parsing/parser.mly"
         ( let (body, ext) = _1 in (Psig_modsubst body, ext) )
-# 43707 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
+# 44741 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1042 "parsing/parser.mly"
     ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43715 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+# 44749 "parsing/parser.ml"
+            
+          in
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43721 "parsing/parser.ml"
-         in
+# 44755 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -43795,86 +44830,88 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_bs_ in
-        let _v : (Parsetree.signature_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
               let _1 =
-                let a =
-                  let attrs2 =
-                    let _1 = _1_inlined3 in
-                    
-# 4058 "parsing/parser.mly"
+                let _1 =
+                  let a =
+                    let attrs2 =
+                      let _1 = _1_inlined3 in
+                      
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 43809 "parsing/parser.ml"
-                    
-                  in
-                  let _endpos_attrs2_ = _endpos__1_inlined3_ in
-                  let name =
-                    let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-                    let _endpos = _endpos__1_ in
-                    let _symbolstartpos = _startpos__1_ in
-                    let _sloc = (_symbolstartpos, _endpos) in
-                    
-# 960 "parsing/parser.mly"
+# 44845 "parsing/parser.ml"
+                      
+                    in
+                    let _endpos_attrs2_ = _endpos__1_inlined3_ in
+                    let name =
+                      let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                      let _endpos = _endpos__1_ in
+                      let _symbolstartpos = _startpos__1_ in
+                      let _sloc = (_symbolstartpos, _endpos) in
+                      
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 43821 "parsing/parser.ml"
-                    
-                  in
-                  let attrs1 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+# 44857 "parsing/parser.ml"
+                      
+                    in
+                    let attrs1 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 43829 "parsing/parser.ml"
+# 44865 "parsing/parser.ml"
+                      
+                    in
+                    let _endpos = _endpos_attrs2_ in
+                    let _symbolstartpos = _startpos__1_ in
+                    let _sloc = (_symbolstartpos, _endpos) in
                     
-                  in
-                  let _endpos = _endpos_attrs2_ in
-                  let _symbolstartpos = _startpos__1_ in
-                  let _sloc = (_symbolstartpos, _endpos) in
-                  
-# 1871 "parsing/parser.mly"
+# 1893 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     ext, Md.mk name mty ~attrs ~loc ~docs
   )
-# 43843 "parsing/parser.ml"
+# 44879 "parsing/parser.ml"
+                    
+                  in
+                  
+# 1236 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 44885 "parsing/parser.ml"
                   
                 in
                 
-# 1212 "parsing/parser.mly"
-    ( let (x, b) = a in x, b :: bs )
-# 43849 "parsing/parser.ml"
+# 1882 "parsing/parser.mly"
+    ( _1 )
+# 44891 "parsing/parser.ml"
                 
               in
               
-# 1860 "parsing/parser.mly"
-    ( _1 )
-# 43855 "parsing/parser.ml"
+# 1797 "parsing/parser.mly"
+        ( let (ext, l) = _1 in (Psig_recmodule l, ext) )
+# 44897 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos_bs_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1775 "parsing/parser.mly"
-        ( let (ext, l) = _1 in (Psig_recmodule l, ext) )
-# 43861 "parsing/parser.ml"
+# 1042 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 44907 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_bs_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
-    ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43871 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43877 "parsing/parser.ml"
-         in
+# 44913 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -43895,26 +44932,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.signature_item) = let _1 =
-          let _1 = 
-# 1777 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1799 "parsing/parser.mly"
         ( let (body, ext) = _1 in (Psig_modtype body, ext) )
-# 43903 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
+# 44941 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1042 "parsing/parser.mly"
     ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43911 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+# 44949 "parsing/parser.ml"
+            
+          in
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43917 "parsing/parser.ml"
-         in
+# 44955 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -43935,26 +44974,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.signature_item) = let _1 =
-          let _1 = 
-# 1779 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1801 "parsing/parser.mly"
         ( let (body, ext) = _1 in (Psig_modtypesubst body, ext) )
-# 43943 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
+# 44983 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1042 "parsing/parser.mly"
     ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43951 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+# 44991 "parsing/parser.ml"
+            
+          in
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43957 "parsing/parser.ml"
-         in
+# 44997 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -43975,26 +45016,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.signature_item) = let _1 =
-          let _1 = 
-# 1781 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1803 "parsing/parser.mly"
         ( let (body, ext) = _1 in (Psig_open body, ext) )
-# 43983 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
+# 45025 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1042 "parsing/parser.mly"
     ( wrap_mksig_ext ~loc:_sloc _1 )
-# 43991 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+# 45033 "parsing/parser.ml"
+            
+          in
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 43997 "parsing/parser.ml"
-         in
+# 45039 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44043,61 +45086,63 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.signature_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let attrs2 =
-                let _1 = _1_inlined2 in
-                
-# 4058 "parsing/parser.mly"
+              let _1 =
+                let attrs2 =
+                  let _1 = _1_inlined2 in
+                  
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 44055 "parsing/parser.ml"
-                
-              in
-              let _endpos_attrs2_ = _endpos__1_inlined2_ in
-              let attrs1 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+# 45099 "parsing/parser.ml"
+                  
+                in
+                let _endpos_attrs2_ = _endpos__1_inlined2_ in
+                let attrs1 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 44064 "parsing/parser.ml"
+# 45108 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos_attrs2_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos_attrs2_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 1621 "parsing/parser.mly"
+# 1645 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Incl.mk thing ~attrs ~loc ~docs, ext
   )
-# 44078 "parsing/parser.ml"
+# 45122 "parsing/parser.ml"
+                
+              in
+              
+# 1805 "parsing/parser.mly"
+        ( psig_include _1 )
+# 45128 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1783 "parsing/parser.mly"
-        ( psig_include _1 )
-# 44084 "parsing/parser.ml"
+# 1042 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 45138 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
-    ( wrap_mksig_ext ~loc:_sloc _1 )
-# 44094 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 44100 "parsing/parser.ml"
-         in
+# 45144 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44173,9 +45218,9 @@ module Tables = struct
         let cty : (Parsetree.class_type) = Obj.magic cty in
         let _7 : unit = Obj.magic _7 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 44179 "parsing/parser.ml"
+# 45224 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -44185,44 +45230,45 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_bs_ in
-        let _v : (Parsetree.signature_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
               let _1 =
-                let a =
-                  let attrs2 =
-                    let _1 = _1_inlined3 in
-                    
-# 4058 "parsing/parser.mly"
+                let _1 =
+                  let a =
+                    let attrs2 =
+                      let _1 = _1_inlined3 in
+                      
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 44199 "parsing/parser.ml"
-                    
-                  in
-                  let _endpos_attrs2_ = _endpos__1_inlined3_ in
-                  let id =
-                    let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-                    let _endpos = _endpos__1_ in
-                    let _symbolstartpos = _startpos__1_ in
-                    let _sloc = (_symbolstartpos, _endpos) in
-                    
-# 960 "parsing/parser.mly"
+# 45245 "parsing/parser.ml"
+                      
+                    in
+                    let _endpos_attrs2_ = _endpos__1_inlined3_ in
+                    let id =
+                      let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                      let _endpos = _endpos__1_ in
+                      let _symbolstartpos = _startpos__1_ in
+                      let _sloc = (_symbolstartpos, _endpos) in
+                      
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 44211 "parsing/parser.ml"
-                    
-                  in
-                  let attrs1 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+# 45257 "parsing/parser.ml"
+                      
+                    in
+                    let attrs1 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 44219 "parsing/parser.ml"
+# 45265 "parsing/parser.ml"
+                      
+                    in
+                    let _endpos = _endpos_attrs2_ in
+                    let _symbolstartpos = _startpos__1_ in
+                    let _sloc = (_symbolstartpos, _endpos) in
                     
-                  in
-                  let _endpos = _endpos_attrs2_ in
-                  let _symbolstartpos = _startpos__1_ in
-                  let _sloc = (_symbolstartpos, _endpos) in
-                  
-# 2218 "parsing/parser.mly"
+# 2240 "parsing/parser.mly"
     (
       let attrs = attrs1 @ attrs2 in
       let loc = make_loc _sloc in
@@ -44230,42 +45276,43 @@ module Tables = struct
       ext,
       Ci.mk id cty ~virt ~params ~attrs ~loc ~docs
     )
-# 44234 "parsing/parser.ml"
+# 45280 "parsing/parser.ml"
+                    
+                  in
+                  
+# 1236 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 45286 "parsing/parser.ml"
                   
                 in
                 
-# 1212 "parsing/parser.mly"
-    ( let (x, b) = a in x, b :: bs )
-# 44240 "parsing/parser.ml"
+# 2228 "parsing/parser.mly"
+    ( _1 )
+# 45292 "parsing/parser.ml"
                 
               in
               
-# 2206 "parsing/parser.mly"
-    ( _1 )
-# 44246 "parsing/parser.ml"
+# 1807 "parsing/parser.mly"
+        ( let (ext, l) = _1 in (Psig_class l, ext) )
+# 45298 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos_bs_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1785 "parsing/parser.mly"
-        ( let (ext, l) = _1 in (Psig_class l, ext) )
-# 44252 "parsing/parser.ml"
+# 1042 "parsing/parser.mly"
+    ( wrap_mksig_ext ~loc:_sloc _1 )
+# 45308 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_bs_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
-    ( wrap_mksig_ext ~loc:_sloc _1 )
-# 44262 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 44268 "parsing/parser.ml"
-         in
+# 45314 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44286,26 +45333,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.signature_item) = let _1 =
-          let _1 = 
-# 1787 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1809 "parsing/parser.mly"
         ( let (ext, l) = _1 in (Psig_class_type l, ext) )
-# 44294 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1018 "parsing/parser.mly"
+# 45342 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1042 "parsing/parser.mly"
     ( wrap_mksig_ext ~loc:_sloc _1 )
-# 44302 "parsing/parser.ml"
-          
-        in
-        
-# 1789 "parsing/parser.mly"
+# 45350 "parsing/parser.ml"
+            
+          in
+          (
+# 1811 "parsing/parser.mly"
     ( _1 )
-# 44308 "parsing/parser.ml"
-         in
+# 45356 "parsing/parser.ml"
+           : (Parsetree.signature_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44327,9 +45376,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.constant) = 
-# 3732 "parsing/parser.mly"
+# 3780 "parsing/parser.mly"
                  ( _1 )
-# 44333 "parsing/parser.ml"
+# 45382 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -44354,19 +45403,25 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _2 : (
-# 764 "parsing/parser.mly"
+# 783 "parsing/parser.mly"
        (string * char option)
-# 44360 "parsing/parser.ml"
+# 45409 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.constant) = 
-# 3733 "parsing/parser.mly"
-                 ( let (n, m) = _2 in Pconst_integer("-" ^ n, m) )
-# 44369 "parsing/parser.ml"
-         in
+        let _v =
+          let _endpos = _endpos__2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3781 "parsing/parser.mly"
+                 ( let (n, m) = _2 in
+                   mkconst ~loc:_sloc (Pconst_integer("-" ^ n, m)) )
+# 45423 "parsing/parser.ml"
+           : (Parsetree.constant))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44390,19 +45445,25 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _2 : (
-# 743 "parsing/parser.mly"
+# 762 "parsing/parser.mly"
        (string * char option)
-# 44396 "parsing/parser.ml"
+# 45451 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.constant) = 
-# 3734 "parsing/parser.mly"
-                 ( let (f, m) = _2 in Pconst_float("-" ^ f, m) )
-# 44405 "parsing/parser.ml"
-         in
+        let _v =
+          let _endpos = _endpos__2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3783 "parsing/parser.mly"
+                 ( let (f, m) = _2 in
+                   mkconst ~loc:_sloc (Pconst_float("-" ^ f, m)) )
+# 45465 "parsing/parser.ml"
+           : (Parsetree.constant))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44426,19 +45487,25 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _2 : (
-# 764 "parsing/parser.mly"
+# 783 "parsing/parser.mly"
        (string * char option)
-# 44432 "parsing/parser.ml"
+# 45493 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.constant) = 
-# 3735 "parsing/parser.mly"
-                 ( let (n, m) = _2 in Pconst_integer (n, m) )
-# 44441 "parsing/parser.ml"
-         in
+        let _v =
+          let _endpos = _endpos__2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3785 "parsing/parser.mly"
+                 ( let (n, m) = _2 in
+                   mkconst ~loc:_sloc (Pconst_integer (n, m)) )
+# 45507 "parsing/parser.ml"
+           : (Parsetree.constant))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44462,19 +45529,25 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _2 : (
-# 743 "parsing/parser.mly"
+# 762 "parsing/parser.mly"
        (string * char option)
-# 44468 "parsing/parser.ml"
+# 45535 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.constant) = 
-# 3736 "parsing/parser.mly"
-                 ( let (f, m) = _2 in Pconst_float(f, m) )
-# 44477 "parsing/parser.ml"
-         in
+        let _v =
+          let _endpos = _endpos__2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3787 "parsing/parser.mly"
+                 ( let (f, m) = _2 in
+                   mkconst ~loc:_sloc (Pconst_float(f, m)) )
+# 45549 "parsing/parser.ml"
+           : (Parsetree.constant))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44509,40 +45582,42 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let _1 = _1_inlined1 in
-              
-# 3005 "parsing/parser.mly"
+            let _1 =
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 3050 "parsing/parser.mly"
     ( let fields, closed = _1 in
       let closed = match closed with Some () -> Open | None -> Closed in
       fields, closed )
-# 44522 "parsing/parser.ml"
+# 45596 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 2976 "parsing/parser.mly"
+# 3021 "parsing/parser.mly"
       ( let (fields, closed) = _2 in
         Ppat_record(fields, closed) )
-# 44529 "parsing/parser.ml"
+# 45603 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 44539 "parsing/parser.ml"
-          
-        in
-        
-# 2990 "parsing/parser.mly"
+# 45613 "parsing/parser.ml"
+            
+          in
+          (
+# 3035 "parsing/parser.mly"
     ( _1 )
-# 44545 "parsing/parser.ml"
-         in
+# 45619 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44577,41 +45652,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let _1 = _1_inlined1 in
-              
-# 3005 "parsing/parser.mly"
+            let _1 =
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 3050 "parsing/parser.mly"
     ( let fields, closed = _1 in
       let closed = match closed with Some () -> Open | None -> Closed in
       fields, closed )
-# 44590 "parsing/parser.ml"
+# 45666 "parsing/parser.ml"
+                
+              in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 3024 "parsing/parser.mly"
+      ( unclosed "{" _loc__1_ "}" _loc__3_ )
+# 45674 "parsing/parser.ml"
               
             in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2979 "parsing/parser.mly"
-      ( unclosed "{" _loc__1_ "}" _loc__3_ )
-# 44598 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 45684 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 44608 "parsing/parser.ml"
-          
-        in
-        
-# 2990 "parsing/parser.mly"
+          (
+# 3035 "parsing/parser.mly"
     ( _1 )
-# 44614 "parsing/parser.ml"
-         in
+# 45690 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44646,35 +45723,37 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _2 = 
-# 2999 "parsing/parser.mly"
+            let _1 =
+              let _2 = 
+# 3044 "parsing/parser.mly"
     ( ps )
-# 44655 "parsing/parser.ml"
-             in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            
-# 2981 "parsing/parser.mly"
+# 45733 "parsing/parser.ml"
+               in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              
+# 3026 "parsing/parser.mly"
       ( fst (mktailpat _loc__3_ _2) )
-# 44661 "parsing/parser.ml"
+# 45739 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 44671 "parsing/parser.ml"
-          
-        in
-        
-# 2990 "parsing/parser.mly"
+# 45749 "parsing/parser.ml"
+            
+          in
+          (
+# 3035 "parsing/parser.mly"
     ( _1 )
-# 44677 "parsing/parser.ml"
-         in
+# 45755 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44709,36 +45788,38 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _2 = 
-# 2999 "parsing/parser.mly"
+            let _1 =
+              let _2 = 
+# 3044 "parsing/parser.mly"
     ( ps )
-# 44718 "parsing/parser.ml"
-             in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2983 "parsing/parser.mly"
+# 45798 "parsing/parser.ml"
+               in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 3028 "parsing/parser.mly"
       ( unclosed "[" _loc__1_ "]" _loc__3_ )
-# 44725 "parsing/parser.ml"
+# 45805 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 44735 "parsing/parser.ml"
-          
-        in
-        
-# 2990 "parsing/parser.mly"
+# 45815 "parsing/parser.ml"
+            
+          in
+          (
+# 3035 "parsing/parser.mly"
     ( _1 )
-# 44741 "parsing/parser.ml"
-         in
+# 45821 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44773,34 +45854,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _2 = 
-# 2999 "parsing/parser.mly"
+            let _1 =
+              let _2 = 
+# 3044 "parsing/parser.mly"
     ( ps )
-# 44782 "parsing/parser.ml"
-             in
-            
-# 2985 "parsing/parser.mly"
+# 45864 "parsing/parser.ml"
+               in
+              
+# 3030 "parsing/parser.mly"
       ( Ppat_array _2 )
-# 44787 "parsing/parser.ml"
+# 45869 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 44797 "parsing/parser.ml"
-          
-        in
-        
-# 2990 "parsing/parser.mly"
+# 45879 "parsing/parser.ml"
+            
+          in
+          (
+# 3035 "parsing/parser.mly"
     ( _1 )
-# 44803 "parsing/parser.ml"
-         in
+# 45885 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44828,27 +45911,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2987 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3032 "parsing/parser.mly"
       ( Ppat_array [] )
-# 44836 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 45920 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 44845 "parsing/parser.ml"
-          
-        in
-        
-# 2990 "parsing/parser.mly"
+# 45929 "parsing/parser.ml"
+            
+          in
+          (
+# 3035 "parsing/parser.mly"
     ( _1 )
-# 44851 "parsing/parser.ml"
-         in
+# 45935 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44883,36 +45968,38 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _2 = 
-# 2999 "parsing/parser.mly"
+            let _1 =
+              let _2 = 
+# 3044 "parsing/parser.mly"
     ( ps )
-# 44892 "parsing/parser.ml"
-             in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2989 "parsing/parser.mly"
+# 45978 "parsing/parser.ml"
+               in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 3034 "parsing/parser.mly"
       ( unclosed "[|" _loc__1_ "|]" _loc__3_ )
-# 44899 "parsing/parser.ml"
+# 45985 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 44909 "parsing/parser.ml"
-          
-        in
-        
-# 2990 "parsing/parser.mly"
+# 45995 "parsing/parser.ml"
+            
+          in
+          (
+# 3035 "parsing/parser.mly"
     ( _1 )
-# 44915 "parsing/parser.ml"
-         in
+# 46001 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44947,14 +46034,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2493 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2515 "parsing/parser.mly"
       ( reloc_exp ~loc:_sloc _2 )
-# 44957 "parsing/parser.ml"
-         in
+# 46045 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -44989,13 +46078,15 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 2495 "parsing/parser.mly"
+        let _v =
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 2517 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 44998 "parsing/parser.ml"
-         in
+# 46088 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45037,14 +46128,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.expression) = let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2497 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2519 "parsing/parser.mly"
       ( mkexp_constraint ~loc:_sloc _2 _3 )
-# 45047 "parsing/parser.ml"
-         in
+# 46139 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45093,27 +46186,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r = 
-# 2498 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r = 
+# 2520 "parsing/parser.mly"
                                 ( None )
-# 45101 "parsing/parser.ml"
-           in
-          
-# 2379 "parsing/parser.mly"
+# 46195 "parsing/parser.ml"
+             in
+            
+# 2401 "parsing/parser.mly"
     ( array, d, Paren,   i, r )
-# 45106 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2499 "parsing/parser.mly"
+# 46200 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2521 "parsing/parser.mly"
       ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 45116 "parsing/parser.ml"
-         in
+# 46210 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45162,27 +46257,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r = 
-# 2498 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r = 
+# 2520 "parsing/parser.mly"
                                 ( None )
-# 45170 "parsing/parser.ml"
-           in
-          
-# 2381 "parsing/parser.mly"
+# 46266 "parsing/parser.ml"
+             in
+            
+# 2403 "parsing/parser.mly"
     ( array, d, Brace,   i, r )
-# 45175 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2499 "parsing/parser.mly"
+# 46271 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2521 "parsing/parser.mly"
       ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 45185 "parsing/parser.ml"
-         in
+# 46281 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45231,27 +46328,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r = 
-# 2498 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r = 
+# 2520 "parsing/parser.mly"
                                 ( None )
-# 45239 "parsing/parser.ml"
-           in
-          
-# 2383 "parsing/parser.mly"
+# 46337 "parsing/parser.ml"
+             in
+            
+# 2405 "parsing/parser.mly"
     ( array, d, Bracket, i, r )
-# 45244 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2499 "parsing/parser.mly"
+# 46342 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2521 "parsing/parser.mly"
       ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
-# 45254 "parsing/parser.ml"
-         in
+# 46352 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45296,52 +46395,54 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 45302 "parsing/parser.ml"
+# 46401 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let array : (Parsetree.expression) = Obj.magic array in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r = 
-# 2500 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r = 
+# 2522 "parsing/parser.mly"
                                                   ( None )
-# 45312 "parsing/parser.ml"
-           in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 46412 "parsing/parser.ml"
+             in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 45317 "parsing/parser.ml"
-           in
-          let d =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 45323 "parsing/parser.ml"
+# 46417 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let d =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 46423 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 45328 "parsing/parser.ml"
+# 46428 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2379 "parsing/parser.mly"
+# 2401 "parsing/parser.mly"
     ( array, d, Paren,   i, r )
-# 45334 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2501 "parsing/parser.mly"
+# 46434 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2523 "parsing/parser.mly"
       ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 45344 "parsing/parser.ml"
-         in
+# 46444 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45398,9 +46499,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 45404 "parsing/parser.ml"
+# 46505 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1 : unit = Obj.magic _1 in
@@ -45408,52 +46509,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r = 
-# 2500 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r = 
+# 2522 "parsing/parser.mly"
                                                   ( None )
-# 45416 "parsing/parser.ml"
-           in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 46518 "parsing/parser.ml"
+             in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 45421 "parsing/parser.ml"
-           in
-          let d =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 46523 "parsing/parser.ml"
+             in
+            let d =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 45429 "parsing/parser.ml"
-               in
-              
+# 46531 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 45434 "parsing/parser.ml"
+# 46536 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 46542 "parsing/parser.ml"
               
             in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 45440 "parsing/parser.ml"
+# 2401 "parsing/parser.mly"
+    ( array, d, Paren,   i, r )
+# 46548 "parsing/parser.ml"
             
           in
-          
-# 2379 "parsing/parser.mly"
-    ( array, d, Paren,   i, r )
-# 45446 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2501 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2523 "parsing/parser.mly"
       ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 45456 "parsing/parser.ml"
-         in
+# 46558 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45498,52 +46601,54 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 45504 "parsing/parser.ml"
+# 46607 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let array : (Parsetree.expression) = Obj.magic array in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r = 
-# 2500 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r = 
+# 2522 "parsing/parser.mly"
                                                   ( None )
-# 45514 "parsing/parser.ml"
-           in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 46618 "parsing/parser.ml"
+             in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 45519 "parsing/parser.ml"
-           in
-          let d =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 45525 "parsing/parser.ml"
+# 46623 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let d =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 46629 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 45530 "parsing/parser.ml"
+# 46634 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2381 "parsing/parser.mly"
+# 2403 "parsing/parser.mly"
     ( array, d, Brace,   i, r )
-# 45536 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2501 "parsing/parser.mly"
+# 46640 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2523 "parsing/parser.mly"
       ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 45546 "parsing/parser.ml"
-         in
+# 46650 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45600,9 +46705,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 45606 "parsing/parser.ml"
+# 46711 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1 : unit = Obj.magic _1 in
@@ -45610,52 +46715,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r = 
-# 2500 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r = 
+# 2522 "parsing/parser.mly"
                                                   ( None )
-# 45618 "parsing/parser.ml"
-           in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 46724 "parsing/parser.ml"
+             in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 45623 "parsing/parser.ml"
-           in
-          let d =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 46729 "parsing/parser.ml"
+             in
+            let d =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 45631 "parsing/parser.ml"
-               in
-              
+# 46737 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 45636 "parsing/parser.ml"
+# 46742 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 46748 "parsing/parser.ml"
               
             in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 45642 "parsing/parser.ml"
+# 2403 "parsing/parser.mly"
+    ( array, d, Brace,   i, r )
+# 46754 "parsing/parser.ml"
             
           in
-          
-# 2381 "parsing/parser.mly"
-    ( array, d, Brace,   i, r )
-# 45648 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2501 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2523 "parsing/parser.mly"
       ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 45658 "parsing/parser.ml"
-         in
+# 46764 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45700,52 +46807,54 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 45706 "parsing/parser.ml"
+# 46813 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let array : (Parsetree.expression) = Obj.magic array in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r = 
-# 2500 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r = 
+# 2522 "parsing/parser.mly"
                                                   ( None )
-# 45716 "parsing/parser.ml"
-           in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 46824 "parsing/parser.ml"
+             in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 45721 "parsing/parser.ml"
-           in
-          let d =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 45727 "parsing/parser.ml"
+# 46829 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let d =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 46835 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 45732 "parsing/parser.ml"
+# 46840 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2383 "parsing/parser.mly"
+# 2405 "parsing/parser.mly"
     ( array, d, Bracket, i, r )
-# 45738 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2501 "parsing/parser.mly"
+# 46846 "parsing/parser.ml"
+            
+          in
+          let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2523 "parsing/parser.mly"
       ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 45748 "parsing/parser.ml"
-         in
+# 46856 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45802,9 +46911,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _3 : unit = Obj.magic _3 in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 45808 "parsing/parser.ml"
+# 46917 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1 : unit = Obj.magic _1 in
@@ -45812,52 +46921,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_array_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let r = 
-# 2500 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let r = 
+# 2522 "parsing/parser.mly"
                                                   ( None )
-# 45820 "parsing/parser.ml"
-           in
-          let i = 
-# 2831 "parsing/parser.mly"
+# 46930 "parsing/parser.ml"
+             in
+            let i = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 45825 "parsing/parser.ml"
-           in
-          let d =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 46935 "parsing/parser.ml"
+             in
+            let d =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 45833 "parsing/parser.ml"
-               in
-              
+# 46943 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 45838 "parsing/parser.ml"
+# 46948 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 46954 "parsing/parser.ml"
               
             in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 45844 "parsing/parser.ml"
+# 2405 "parsing/parser.mly"
+    ( array, d, Bracket, i, r )
+# 46960 "parsing/parser.ml"
             
           in
-          
-# 2383 "parsing/parser.mly"
-    ( array, d, Bracket, i, r )
-# 45850 "parsing/parser.ml"
-          
-        in
-        let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2501 "parsing/parser.mly"
+          let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2523 "parsing/parser.mly"
       ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
-# 45860 "parsing/parser.ml"
-         in
+# 46970 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45906,20 +47017,22 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__e_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _loc__p_ = (_startpos__p_, _endpos__p_) in
-          let _loc__e_ = (_startpos__e_, _endpos__e_) in
-          
-# 2388 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _loc__p_ = (_startpos__p_, _endpos__p_) in
+            let _loc__e_ = (_startpos__e_, _endpos__e_) in
+            
+# 2410 "parsing/parser.mly"
     ( indexop_unclosed_error _loc__p_  Paren _loc__e_ )
-# 45916 "parsing/parser.ml"
-          
-        in
-        
-# 2502 "parsing/parser.mly"
+# 47028 "parsing/parser.ml"
+            
+          in
+          (
+# 2524 "parsing/parser.mly"
                                   ( _1 )
-# 45922 "parsing/parser.ml"
-         in
+# 47034 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -45968,20 +47081,22 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__e_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _loc__p_ = (_startpos__p_, _endpos__p_) in
-          let _loc__e_ = (_startpos__e_, _endpos__e_) in
-          
-# 2390 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _loc__p_ = (_startpos__p_, _endpos__p_) in
+            let _loc__e_ = (_startpos__e_, _endpos__e_) in
+            
+# 2412 "parsing/parser.mly"
     ( indexop_unclosed_error _loc__p_ Brace _loc__e_ )
-# 45978 "parsing/parser.ml"
-          
-        in
-        
-# 2502 "parsing/parser.mly"
+# 47092 "parsing/parser.ml"
+            
+          in
+          (
+# 2524 "parsing/parser.mly"
                                   ( _1 )
-# 45984 "parsing/parser.ml"
-         in
+# 47098 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46030,20 +47145,22 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__e_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _loc__p_ = (_startpos__p_, _endpos__p_) in
-          let _loc__e_ = (_startpos__e_, _endpos__e_) in
-          
-# 2392 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _loc__p_ = (_startpos__p_, _endpos__p_) in
+            let _loc__e_ = (_startpos__e_, _endpos__e_) in
+            
+# 2414 "parsing/parser.mly"
     ( indexop_unclosed_error _loc__p_ Bracket _loc__e_ )
-# 46040 "parsing/parser.ml"
-          
-        in
-        
-# 2502 "parsing/parser.mly"
+# 47156 "parsing/parser.ml"
+            
+          in
+          (
+# 2524 "parsing/parser.mly"
                                   ( _1 )
-# 46046 "parsing/parser.ml"
-         in
+# 47162 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46088,45 +47205,47 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _p : unit = Obj.magic _p in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 46094 "parsing/parser.ml"
+# 47211 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _1 : (Parsetree.expression) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__e_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 = 
-# 2831 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 46104 "parsing/parser.ml"
-           in
-          let _2 =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 46110 "parsing/parser.ml"
+# 47222 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let _2 =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 47228 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 46115 "parsing/parser.ml"
+# 47233 "parsing/parser.ml"
+              
+            in
+            let _loc__p_ = (_startpos__p_, _endpos__p_) in
+            let _loc__e_ = (_startpos__e_, _endpos__e_) in
             
-          in
-          let _loc__p_ = (_startpos__p_, _endpos__p_) in
-          let _loc__e_ = (_startpos__e_, _endpos__e_) in
-          
-# 2388 "parsing/parser.mly"
+# 2410 "parsing/parser.mly"
     ( indexop_unclosed_error _loc__p_  Paren _loc__e_ )
-# 46123 "parsing/parser.ml"
-          
-        in
-        
-# 2503 "parsing/parser.mly"
+# 47241 "parsing/parser.ml"
+            
+          in
+          (
+# 2525 "parsing/parser.mly"
                                                     ( _1 )
-# 46129 "parsing/parser.ml"
-         in
+# 47247 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46183,9 +47302,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _p : unit = Obj.magic _p in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 46189 "parsing/parser.ml"
+# 47308 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1_inlined1 : unit = Obj.magic _1_inlined1 in
@@ -46193,45 +47312,47 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__e_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 = 
-# 2831 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 46201 "parsing/parser.ml"
-           in
-          let _2 =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 47321 "parsing/parser.ml"
+             in
+            let _2 =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 46209 "parsing/parser.ml"
-               in
-              
+# 47329 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 46214 "parsing/parser.ml"
+# 47334 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 47340 "parsing/parser.ml"
               
             in
+            let _loc__p_ = (_startpos__p_, _endpos__p_) in
+            let _loc__e_ = (_startpos__e_, _endpos__e_) in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 46220 "parsing/parser.ml"
+# 2410 "parsing/parser.mly"
+    ( indexop_unclosed_error _loc__p_  Paren _loc__e_ )
+# 47348 "parsing/parser.ml"
             
           in
-          let _loc__p_ = (_startpos__p_, _endpos__p_) in
-          let _loc__e_ = (_startpos__e_, _endpos__e_) in
-          
-# 2388 "parsing/parser.mly"
-    ( indexop_unclosed_error _loc__p_  Paren _loc__e_ )
-# 46228 "parsing/parser.ml"
-          
-        in
-        
-# 2503 "parsing/parser.mly"
+          (
+# 2525 "parsing/parser.mly"
                                                     ( _1 )
-# 46234 "parsing/parser.ml"
-         in
+# 47354 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46276,45 +47397,47 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _p : unit = Obj.magic _p in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 46282 "parsing/parser.ml"
+# 47403 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _1 : (Parsetree.expression) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__e_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 = 
-# 2831 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 46292 "parsing/parser.ml"
-           in
-          let _2 =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 46298 "parsing/parser.ml"
+# 47414 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let _2 =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 47420 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 46303 "parsing/parser.ml"
+# 47425 "parsing/parser.ml"
+              
+            in
+            let _loc__p_ = (_startpos__p_, _endpos__p_) in
+            let _loc__e_ = (_startpos__e_, _endpos__e_) in
             
-          in
-          let _loc__p_ = (_startpos__p_, _endpos__p_) in
-          let _loc__e_ = (_startpos__e_, _endpos__e_) in
-          
-# 2390 "parsing/parser.mly"
+# 2412 "parsing/parser.mly"
     ( indexop_unclosed_error _loc__p_ Brace _loc__e_ )
-# 46311 "parsing/parser.ml"
-          
-        in
-        
-# 2503 "parsing/parser.mly"
+# 47433 "parsing/parser.ml"
+            
+          in
+          (
+# 2525 "parsing/parser.mly"
                                                     ( _1 )
-# 46317 "parsing/parser.ml"
-         in
+# 47439 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46371,9 +47494,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _p : unit = Obj.magic _p in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 46377 "parsing/parser.ml"
+# 47500 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1_inlined1 : unit = Obj.magic _1_inlined1 in
@@ -46381,45 +47504,47 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__e_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 = 
-# 2831 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 46389 "parsing/parser.ml"
-           in
-          let _2 =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 47513 "parsing/parser.ml"
+             in
+            let _2 =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 46397 "parsing/parser.ml"
-               in
-              
+# 47521 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 46402 "parsing/parser.ml"
+# 47526 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 47532 "parsing/parser.ml"
               
             in
+            let _loc__p_ = (_startpos__p_, _endpos__p_) in
+            let _loc__e_ = (_startpos__e_, _endpos__e_) in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 46408 "parsing/parser.ml"
+# 2412 "parsing/parser.mly"
+    ( indexop_unclosed_error _loc__p_ Brace _loc__e_ )
+# 47540 "parsing/parser.ml"
             
           in
-          let _loc__p_ = (_startpos__p_, _endpos__p_) in
-          let _loc__e_ = (_startpos__e_, _endpos__e_) in
-          
-# 2390 "parsing/parser.mly"
-    ( indexop_unclosed_error _loc__p_ Brace _loc__e_ )
-# 46416 "parsing/parser.ml"
-          
-        in
-        
-# 2503 "parsing/parser.mly"
+          (
+# 2525 "parsing/parser.mly"
                                                     ( _1 )
-# 46422 "parsing/parser.ml"
-         in
+# 47546 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46464,45 +47589,47 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _p : unit = Obj.magic _p in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 46470 "parsing/parser.ml"
+# 47595 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _1 : (Parsetree.expression) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__e_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 = 
-# 2831 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 46480 "parsing/parser.ml"
-           in
-          let _2 =
-            let _1 = 
-# 124 "<standard.mly>"
-    ( None )
-# 46486 "parsing/parser.ml"
+# 47606 "parsing/parser.ml"
              in
-            
-# 2395 "parsing/parser.mly"
+            let _2 =
+              let _1 = 
+# 123 "<standard.mly>"
+    ( None )
+# 47612 "parsing/parser.ml"
+               in
+              
+# 2417 "parsing/parser.mly"
                                                                ( _1, _2 )
-# 46491 "parsing/parser.ml"
+# 47617 "parsing/parser.ml"
+              
+            in
+            let _loc__p_ = (_startpos__p_, _endpos__p_) in
+            let _loc__e_ = (_startpos__e_, _endpos__e_) in
             
-          in
-          let _loc__p_ = (_startpos__p_, _endpos__p_) in
-          let _loc__e_ = (_startpos__e_, _endpos__e_) in
-          
-# 2392 "parsing/parser.mly"
+# 2414 "parsing/parser.mly"
     ( indexop_unclosed_error _loc__p_ Bracket _loc__e_ )
-# 46499 "parsing/parser.ml"
-          
-        in
-        
-# 2503 "parsing/parser.mly"
+# 47625 "parsing/parser.ml"
+            
+          in
+          (
+# 2525 "parsing/parser.mly"
                                                     ( _1 )
-# 46505 "parsing/parser.ml"
-         in
+# 47631 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46559,9 +47686,9 @@ module Tables = struct
         let es : (Parsetree.expression list) = Obj.magic es in
         let _p : unit = Obj.magic _p in
         let _2 : (
-# 759 "parsing/parser.mly"
+# 778 "parsing/parser.mly"
        (string)
-# 46565 "parsing/parser.ml"
+# 47692 "parsing/parser.ml"
         ) = Obj.magic _2 in
         let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
         let _1_inlined1 : unit = Obj.magic _1_inlined1 in
@@ -46569,45 +47696,144 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__e_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _4 = 
-# 2831 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _4 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 46577 "parsing/parser.ml"
-           in
-          let _2 =
-            let _1 =
-              let _2 = _2_inlined1 in
-              let x = 
-# 2395 "parsing/parser.mly"
+# 47705 "parsing/parser.ml"
+             in
+            let _2 =
+              let _1 =
+                let _2 = _2_inlined1 in
+                let x = 
+# 2417 "parsing/parser.mly"
                                                    (_2)
-# 46585 "parsing/parser.ml"
-               in
-              
+# 47713 "parsing/parser.ml"
+                 in
+                
 # 126 "<standard.mly>"
     ( Some x )
-# 46590 "parsing/parser.ml"
+# 47718 "parsing/parser.ml"
+                
+              in
+              
+# 2417 "parsing/parser.mly"
+                                                               ( _1, _2 )
+# 47724 "parsing/parser.ml"
               
             in
+            let _loc__p_ = (_startpos__p_, _endpos__p_) in
+            let _loc__e_ = (_startpos__e_, _endpos__e_) in
             
-# 2395 "parsing/parser.mly"
-                                                               ( _1, _2 )
-# 46596 "parsing/parser.ml"
+# 2414 "parsing/parser.mly"
+    ( indexop_unclosed_error _loc__p_ Bracket _loc__e_ )
+# 47732 "parsing/parser.ml"
             
           in
-          let _loc__p_ = (_startpos__p_, _endpos__p_) in
-          let _loc__e_ = (_startpos__e_, _endpos__e_) in
-          
-# 2392 "parsing/parser.mly"
-    ( indexop_unclosed_error _loc__p_ Bracket _loc__e_ )
-# 46604 "parsing/parser.ml"
-          
-        in
-        
-# 2503 "parsing/parser.mly"
+          (
+# 2525 "parsing/parser.mly"
                                                     ( _1 )
-# 46610 "parsing/parser.ml"
-         in
+# 47738 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
+        {
+          MenhirLib.EngineTypes.state = _menhir_s;
+          MenhirLib.EngineTypes.semv = Obj.repr _v;
+          MenhirLib.EngineTypes.startp = _startpos;
+          MenhirLib.EngineTypes.endp = _endpos;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        });
+      (fun _menhir_env ->
+        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+        let {
+          MenhirLib.EngineTypes.state = _;
+          MenhirLib.EngineTypes.semv = e;
+          MenhirLib.EngineTypes.startp = _startpos_e_;
+          MenhirLib.EngineTypes.endp = _endpos_e_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _menhir_s;
+            MenhirLib.EngineTypes.semv = _1;
+            MenhirLib.EngineTypes.startp = _startpos__1_;
+            MenhirLib.EngineTypes.endp = _endpos__1_;
+            MenhirLib.EngineTypes.next = _menhir_stack;
+          };
+        } = _menhir_stack in
+        let e : (Parsetree.expression) = Obj.magic e in
+        let _1 : unit = Obj.magic _1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos__1_ in
+        let _endpos = _endpos_e_ in
+        let _v =
+          let _1 =
+            let _endpos = _endpos_e_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2565 "parsing/parser.mly"
+    ( wrap_exp_attrs ~loc:_sloc e
+       (Some (mknoloc "metaocaml.escape"), []) )
+# 47777 "parsing/parser.ml"
+            
+          in
+          (
+# 2526 "parsing/parser.mly"
+                   ( _1 )
+# 47783 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
+        {
+          MenhirLib.EngineTypes.state = _menhir_s;
+          MenhirLib.EngineTypes.semv = Obj.repr _v;
+          MenhirLib.EngineTypes.startp = _startpos;
+          MenhirLib.EngineTypes.endp = _endpos;
+          MenhirLib.EngineTypes.next = _menhir_stack;
+        });
+      (fun _menhir_env ->
+        let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+        let {
+          MenhirLib.EngineTypes.state = _;
+          MenhirLib.EngineTypes.semv = _3;
+          MenhirLib.EngineTypes.startp = _startpos__3_;
+          MenhirLib.EngineTypes.endp = _endpos__3_;
+          MenhirLib.EngineTypes.next = {
+            MenhirLib.EngineTypes.state = _;
+            MenhirLib.EngineTypes.semv = e;
+            MenhirLib.EngineTypes.startp = _startpos_e_;
+            MenhirLib.EngineTypes.endp = _endpos_e_;
+            MenhirLib.EngineTypes.next = {
+              MenhirLib.EngineTypes.state = _menhir_s;
+              MenhirLib.EngineTypes.semv = _1;
+              MenhirLib.EngineTypes.startp = _startpos__1_;
+              MenhirLib.EngineTypes.endp = _endpos__1_;
+              MenhirLib.EngineTypes.next = _menhir_stack;
+            };
+          };
+        } = _menhir_stack in
+        let _3 : unit = Obj.magic _3 in
+        let e : (Parsetree.expression) = Obj.magic e in
+        let _1 : unit = Obj.magic _1 in
+        let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+        let _startpos = _startpos__1_ in
+        let _endpos = _endpos__3_ in
+        let _v =
+          let _1 =
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 2568 "parsing/parser.mly"
+    ( wrap_exp_attrs ~loc:_sloc e
+       (Some  (mknoloc "metaocaml.bracket"),[]) )
+# 47829 "parsing/parser.ml"
+            
+          in
+          (
+# 2526 "parsing/parser.mly"
+                   ( _1 )
+# 47835 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46656,31 +47882,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let attrs =
-            let _1 = _1_inlined1 in
-            
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let attrs =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 46666 "parsing/parser.ml"
+# 47893 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2512 "parsing/parser.mly"
+# 2535 "parsing/parser.mly"
       ( e.pexp_desc, (ext, attrs @ e.pexp_attributes) )
-# 46672 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__5_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2505 "parsing/parser.mly"
+# 47899 "parsing/parser.ml"
+            
+          in
+          let _endpos__1_ = _endpos__5_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2528 "parsing/parser.mly"
     ( let desc, attrs = _1 in
       mkexp_attrs ~loc:_sloc desc attrs )
-# 46683 "parsing/parser.ml"
-         in
+# 47910 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46722,42 +47950,44 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+        let _v =
+          let _1 =
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 46734 "parsing/parser.ml"
+# 47963 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 47969 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__3_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 46740 "parsing/parser.ml"
+# 2537 "parsing/parser.mly"
+      ( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 )
+# 47978 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__3_ in
+          let _endpos__1_ = _endpos__3_ in
+          let _endpos = _endpos__1_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2514 "parsing/parser.mly"
-      ( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 )
-# 46749 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__3_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2505 "parsing/parser.mly"
+          (
+# 2528 "parsing/parser.mly"
     ( let desc, attrs = _1 in
       mkexp_attrs ~loc:_sloc desc attrs )
-# 46760 "parsing/parser.ml"
-         in
+# 47989 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46806,41 +48036,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+        let _v =
+          let _1 =
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 46818 "parsing/parser.ml"
+# 48049 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 48055 "parsing/parser.ml"
               
             in
+            let _loc__4_ = (_startpos__4_, _endpos__4_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 46824 "parsing/parser.ml"
+# 2539 "parsing/parser.mly"
+      ( unclosed "begin" _loc__1_ "end" _loc__4_ )
+# 48063 "parsing/parser.ml"
             
           in
-          let _loc__4_ = (_startpos__4_, _endpos__4_) in
-          let _loc__1_ = (_startpos__1_, _endpos__1_) in
-          
-# 2516 "parsing/parser.mly"
-      ( unclosed "begin" _loc__1_ "end" _loc__4_ )
-# 46832 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__4_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2505 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__4_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2528 "parsing/parser.mly"
     ( let desc, attrs = _1 in
       mkexp_attrs ~loc:_sloc desc attrs )
-# 46843 "parsing/parser.ml"
-         in
+# 48074 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46882,50 +48114,52 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _3 =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 960 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _3 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 46895 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 48128 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _2 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 46905 "parsing/parser.ml"
+# 48138 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 48144 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 46911 "parsing/parser.ml"
+# 2541 "parsing/parser.mly"
+      ( Pexp_new(_3), _2 )
+# 48150 "parsing/parser.ml"
             
           in
-          
-# 2518 "parsing/parser.mly"
-      ( Pexp_new(_3), _2 )
-# 46917 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__1_inlined3_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2505 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__1_inlined3_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2528 "parsing/parser.mly"
     ( let desc, attrs = _1 in
       mkexp_attrs ~loc:_sloc desc attrs )
-# 46928 "parsing/parser.ml"
-         in
+# 48161 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -46981,39 +48215,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _3 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _3 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 46993 "parsing/parser.ml"
+# 48228 "parsing/parser.ml"
+                
+              in
               
-            in
-            
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 46999 "parsing/parser.ml"
+# 48234 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 2520 "parsing/parser.mly"
+# 2543 "parsing/parser.mly"
       ( Pexp_pack _4, _3 )
-# 47005 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__5_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2505 "parsing/parser.mly"
+# 48240 "parsing/parser.ml"
+            
+          in
+          let _endpos__1_ = _endpos__5_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2528 "parsing/parser.mly"
     ( let desc, attrs = _1 in
       mkexp_attrs ~loc:_sloc desc attrs )
-# 47016 "parsing/parser.ml"
-         in
+# 48251 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47083,55 +48319,57 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _6 =
-            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-            let _endpos = _endpos__1_ in
-            let _symbolstartpos = _startpos__1_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 3646 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _6 =
+              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 47098 "parsing/parser.ml"
-            
-          in
-          let _3 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
+# 48335 "parsing/parser.ml"
               
-# 4062 "parsing/parser.mly"
+            in
+            let _3 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 47108 "parsing/parser.ml"
+# 48345 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 48351 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__7_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 47114 "parsing/parser.ml"
+# 2545 "parsing/parser.mly"
+      ( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 )
+# 48360 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__7_ in
+          let _endpos__1_ = _endpos__7_ in
+          let _endpos = _endpos__1_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 2522 "parsing/parser.mly"
-      ( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 )
-# 47123 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__7_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2505 "parsing/parser.mly"
+          (
+# 2528 "parsing/parser.mly"
     ( let desc, attrs = _1 in
       mkexp_attrs ~loc:_sloc desc attrs )
-# 47134 "parsing/parser.ml"
-         in
+# 48371 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47194,41 +48432,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _3 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-            let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _3 =
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 47206 "parsing/parser.ml"
+# 48445 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 48451 "parsing/parser.ml"
               
             in
+            let _loc__6_ = (_startpos__6_, _endpos__6_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 47212 "parsing/parser.ml"
+# 2547 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__6_ )
+# 48459 "parsing/parser.ml"
             
           in
-          let _loc__6_ = (_startpos__6_, _endpos__6_) in
-          let _loc__1_ = (_startpos__1_, _endpos__1_) in
-          
-# 2524 "parsing/parser.mly"
-      ( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 47220 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__6_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2505 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__6_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2528 "parsing/parser.mly"
     ( let desc, attrs = _1 in
       mkexp_attrs ~loc:_sloc desc attrs )
-# 47231 "parsing/parser.ml"
-         in
+# 48470 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47284,69 +48524,71 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _3 =
-            let _1 = _1_inlined3 in
-            let _2 =
-              let _1 =
-                let _1 = 
-# 260 "<standard.mly>"
+        let _v =
+          let _1 =
+            let _3 =
+              let _1 = _1_inlined3 in
+              let _2 =
+                let _1 =
+                  let _1 = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 47296 "parsing/parser.ml"
-                 in
-                
-# 2034 "parsing/parser.mly"
+# 48537 "parsing/parser.ml"
+                   in
+                  
+# 2056 "parsing/parser.mly"
     ( _1 )
-# 47301 "parsing/parser.ml"
+# 48542 "parsing/parser.ml"
+                  
+                in
+                let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+                let _endpos = _endpos__1_ in
+                let _startpos = _startpos__1_ in
+                
+# 978 "parsing/parser.mly"
+                               ( extra_cstr _startpos _endpos _1 )
+# 48551 "parsing/parser.ml"
                 
               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
-              let _endpos = _endpos__1_ in
-              let _startpos = _startpos__1_ in
               
-# 954 "parsing/parser.mly"
-                               ( extra_cstr _startpos _endpos _1 )
-# 47310 "parsing/parser.ml"
+# 2043 "parsing/parser.mly"
+       ( Cstr.mk _1 _2 )
+# 48557 "parsing/parser.ml"
               
             in
-            
-# 2021 "parsing/parser.mly"
-       ( Cstr.mk _1 _2 )
-# 47316 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 47326 "parsing/parser.ml"
+# 48567 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 48573 "parsing/parser.ml"
               
             in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 47332 "parsing/parser.ml"
+# 2549 "parsing/parser.mly"
+      ( Pexp_object _3, _2 )
+# 48579 "parsing/parser.ml"
             
           in
-          
-# 2526 "parsing/parser.mly"
-      ( Pexp_object _3, _2 )
-# 47338 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__4_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2505 "parsing/parser.mly"
+          let _endpos__1_ = _endpos__4_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2528 "parsing/parser.mly"
     ( let desc, attrs = _1 in
       mkexp_attrs ~loc:_sloc desc attrs )
-# 47349 "parsing/parser.ml"
-         in
+# 48590 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47402,71 +48644,73 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _3 =
-            let _1 = _1_inlined3 in
-            let _2 =
-              let _1 =
-                let _1 = 
-# 260 "<standard.mly>"
+        let _v =
+          let _1 =
+            let _3 =
+              let _1 = _1_inlined3 in
+              let _2 =
+                let _1 =
+                  let _1 = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 47414 "parsing/parser.ml"
-                 in
-                
-# 2034 "parsing/parser.mly"
+# 48657 "parsing/parser.ml"
+                   in
+                  
+# 2056 "parsing/parser.mly"
     ( _1 )
-# 47419 "parsing/parser.ml"
+# 48662 "parsing/parser.ml"
+                  
+                in
+                let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+                let _endpos = _endpos__1_ in
+                let _startpos = _startpos__1_ in
+                
+# 978 "parsing/parser.mly"
+                               ( extra_cstr _startpos _endpos _1 )
+# 48671 "parsing/parser.ml"
                 
               in
-              let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
-              let _endpos = _endpos__1_ in
-              let _startpos = _startpos__1_ in
               
-# 954 "parsing/parser.mly"
-                               ( extra_cstr _startpos _endpos _1 )
-# 47428 "parsing/parser.ml"
+# 2043 "parsing/parser.mly"
+       ( Cstr.mk _1 _2 )
+# 48677 "parsing/parser.ml"
               
             in
-            
-# 2021 "parsing/parser.mly"
-       ( Cstr.mk _1 _2 )
-# 47434 "parsing/parser.ml"
-            
-          in
-          let _2 =
-            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
             let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4062 "parsing/parser.mly"
+              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 47444 "parsing/parser.ml"
+# 48687 "parsing/parser.ml"
+                
+              in
+              
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 48693 "parsing/parser.ml"
               
             in
+            let _loc__4_ = (_startpos__4_, _endpos__4_) in
+            let _loc__1_ = (_startpos__1_, _endpos__1_) in
             
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 47450 "parsing/parser.ml"
+# 2551 "parsing/parser.mly"
+      ( unclosed "object" _loc__1_ "end" _loc__4_ )
+# 48701 "parsing/parser.ml"
             
           in
-          let _loc__4_ = (_startpos__4_, _endpos__4_) in
-          let _loc__1_ = (_startpos__1_, _endpos__1_) in
-          
+          let _endpos__1_ = _endpos__4_ in
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
 # 2528 "parsing/parser.mly"
-      ( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 47458 "parsing/parser.ml"
-          
-        in
-        let _endpos__1_ = _endpos__4_ in
-        let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2505 "parsing/parser.mly"
     ( let desc, attrs = _1 in
       mkexp_attrs ~loc:_sloc desc attrs )
-# 47469 "parsing/parser.ml"
-         in
+# 48712 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47487,38 +48731,40 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 47500 "parsing/parser.ml"
+# 48745 "parsing/parser.ml"
+                
+              in
+              
+# 2574 "parsing/parser.mly"
+      ( Pexp_ident (_1) )
+# 48751 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2532 "parsing/parser.mly"
-      ( Pexp_ident (_1) )
-# 47506 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 48760 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 47515 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 47521 "parsing/parser.ml"
-         in
+# 48766 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47539,26 +48785,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _1 = 
-# 2534 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2576 "parsing/parser.mly"
       ( Pexp_constant _1 )
-# 47547 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 48794 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 47555 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 48802 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 47561 "parsing/parser.ml"
-         in
+# 48808 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47579,38 +48827,40 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 47592 "parsing/parser.ml"
+# 48841 "parsing/parser.ml"
+                
+              in
+              
+# 2578 "parsing/parser.mly"
+      ( Pexp_construct(_1, None) )
+# 48847 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2536 "parsing/parser.mly"
-      ( Pexp_construct(_1, None) )
-# 47598 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 48856 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 47607 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 47613 "parsing/parser.ml"
-         in
+# 48862 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47631,26 +48881,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _1 = 
-# 2538 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2580 "parsing/parser.mly"
       ( Pexp_variant(_1, None) )
-# 47639 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 48890 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 47647 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 48898 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 47653 "parsing/parser.ml"
-         in
+# 48904 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47675,46 +48927,48 @@ module Tables = struct
         } = _menhir_stack in
         let _2 : (Parsetree.expression) = Obj.magic _2 in
         let _1 : (
-# 802 "parsing/parser.mly"
+# 821 "parsing/parser.mly"
        (string)
-# 47681 "parsing/parser.ml"
+# 48933 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 47695 "parsing/parser.ml"
+# 48948 "parsing/parser.ml"
+                
+              in
+              
+# 2582 "parsing/parser.mly"
+      ( Pexp_apply(_1, [Nolabel,_2]) )
+# 48954 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2540 "parsing/parser.mly"
-      ( Pexp_apply(_1, [Nolabel,_2]) )
-# 47701 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 48964 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 47711 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 47717 "parsing/parser.ml"
-         in
+# 48970 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47742,44 +48996,46 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _1 = 
-# 2541 "parsing/parser.mly"
+              let _1 =
+                let _1 = 
+# 2583 "parsing/parser.mly"
             ("!")
-# 47752 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+# 49007 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 47760 "parsing/parser.ml"
+# 49015 "parsing/parser.ml"
+                
+              in
+              
+# 2584 "parsing/parser.mly"
+      ( Pexp_apply(_1, [Nolabel,_2]) )
+# 49021 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2542 "parsing/parser.mly"
-      ( Pexp_apply(_1, [Nolabel,_2]) )
-# 47766 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 49031 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 47776 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 47782 "parsing/parser.ml"
-         in
+# 49037 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47814,34 +49070,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 = 
-# 2814 "parsing/parser.mly"
+            let _1 =
+              let _2 = 
+# 2856 "parsing/parser.mly"
     ( xs )
-# 47823 "parsing/parser.ml"
-             in
-            
-# 2544 "parsing/parser.mly"
+# 49080 "parsing/parser.ml"
+               in
+              
+# 2586 "parsing/parser.mly"
       ( Pexp_override _2 )
-# 47828 "parsing/parser.ml"
+# 49085 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 47838 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 49095 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 47844 "parsing/parser.ml"
-         in
+# 49101 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47876,36 +49134,38 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 = 
-# 2814 "parsing/parser.mly"
+            let _1 =
+              let _2 = 
+# 2856 "parsing/parser.mly"
     ( xs )
-# 47885 "parsing/parser.ml"
-             in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2546 "parsing/parser.mly"
+# 49144 "parsing/parser.ml"
+               in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 2588 "parsing/parser.mly"
       ( unclosed "{<" _loc__1_ ">}" _loc__3_ )
-# 47892 "parsing/parser.ml"
+# 49151 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 47902 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 49161 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 47908 "parsing/parser.ml"
-         in
+# 49167 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47933,27 +49193,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _1 = 
-# 2548 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2590 "parsing/parser.mly"
       ( Pexp_override [] )
-# 47941 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 49202 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 47950 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 49211 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 47956 "parsing/parser.ml"
-         in
+# 49217 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -47988,40 +49250,42 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _3 =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let _3 =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 48002 "parsing/parser.ml"
+# 49265 "parsing/parser.ml"
+                
+              in
+              
+# 2592 "parsing/parser.mly"
+      ( Pexp_field(_1, _3) )
+# 49271 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2550 "parsing/parser.mly"
-      ( Pexp_field(_1, _3) )
-# 48008 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 49281 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 48018 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48024 "parsing/parser.ml"
-         in
+# 49287 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48070,49 +49334,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let od =
-              let _1 =
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 960 "parsing/parser.mly"
+            let _1 =
+              let od =
+                let _1 =
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 48084 "parsing/parser.ml"
+# 49349 "parsing/parser.ml"
+                  
+                in
+                let _loc__1_ = (_startpos__1_, _endpos__1_) in
                 
-              in
-              let _loc__1_ = (_startpos__1_, _endpos__1_) in
-              
-# 1680 "parsing/parser.mly"
+# 1704 "parsing/parser.mly"
   ( let loc = make_loc _loc__1_ in
     let me = Mod.ident ~loc _1 in
     Opn.mk ~loc me )
-# 48093 "parsing/parser.ml"
+# 49358 "parsing/parser.ml"
+                
+              in
+              
+# 2594 "parsing/parser.mly"
+      ( Pexp_open(od, _4) )
+# 49364 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2552 "parsing/parser.mly"
-      ( Pexp_open(od, _4) )
-# 48099 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 49374 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 48109 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48115 "parsing/parser.ml"
-         in
+# 49380 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48161,59 +49427,61 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _4 = 
-# 2814 "parsing/parser.mly"
+            let _1 =
+              let _4 = 
+# 2856 "parsing/parser.mly"
     ( xs )
-# 48170 "parsing/parser.ml"
-             in
-            let od =
-              let _1 =
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 960 "parsing/parser.mly"
+# 49437 "parsing/parser.ml"
+               in
+              let od =
+                let _1 =
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 48180 "parsing/parser.ml"
+# 49447 "parsing/parser.ml"
+                  
+                in
+                let _loc__1_ = (_startpos__1_, _endpos__1_) in
                 
-              in
-              let _loc__1_ = (_startpos__1_, _endpos__1_) in
-              
-# 1680 "parsing/parser.mly"
+# 1704 "parsing/parser.mly"
   ( let loc = make_loc _loc__1_ in
     let me = Mod.ident ~loc _1 in
     Opn.mk ~loc me )
-# 48189 "parsing/parser.ml"
+# 49456 "parsing/parser.ml"
+                
+              in
+              let _startpos_od_ = _startpos__1_ in
+              let _endpos = _endpos__5_ in
+              let _symbolstartpos = _startpos_od_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 2596 "parsing/parser.mly"
+      ( (* TODO: review the location of Pexp_override *)
+        Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) )
+# 49467 "parsing/parser.ml"
               
             in
-            let _startpos_od_ = _startpos__1_ in
-            let _endpos = _endpos__5_ in
-            let _symbolstartpos = _startpos_od_ in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 2554 "parsing/parser.mly"
-      ( (* TODO: review the location of Pexp_override *)
-        Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) )
-# 48200 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 49477 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 48210 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48216 "parsing/parser.ml"
-         in
+# 49483 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48262,36 +49530,38 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _4 = 
-# 2814 "parsing/parser.mly"
+            let _1 =
+              let _4 = 
+# 2856 "parsing/parser.mly"
     ( xs )
-# 48271 "parsing/parser.ml"
-             in
-            let _loc__5_ = (_startpos__5_, _endpos__5_) in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            
-# 2557 "parsing/parser.mly"
+# 49540 "parsing/parser.ml"
+               in
+              let _loc__5_ = (_startpos__5_, _endpos__5_) in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              
+# 2599 "parsing/parser.mly"
       ( unclosed "{<" _loc__3_ ">}" _loc__5_ )
-# 48278 "parsing/parser.ml"
+# 49547 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 48288 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 49557 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48294 "parsing/parser.ml"
-         in
+# 49563 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48321,54 +49591,56 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 48327 "parsing/parser.ml"
+# 49597 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _2 : unit = Obj.magic _2 in
         let _1 : (Parsetree.expression) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _3 =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-              let _1 = 
-# 3720 "parsing/parser.mly"
+            let _1 =
+              let _3 =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+                let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 48341 "parsing/parser.ml"
-               in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+# 49612 "parsing/parser.ml"
+                 in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 48349 "parsing/parser.ml"
+# 49620 "parsing/parser.ml"
+                
+              in
+              
+# 2601 "parsing/parser.mly"
+      ( Pexp_send(_1, _3) )
+# 49626 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2559 "parsing/parser.mly"
-      ( Pexp_send(_1, _3) )
-# 48355 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 49636 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 48365 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48371 "parsing/parser.ml"
-         in
+# 49642 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48399,48 +49671,50 @@ module Tables = struct
         } = _menhir_stack in
         let _3 : (Parsetree.expression) = Obj.magic _3 in
         let _1_inlined1 : (
-# 813 "parsing/parser.mly"
+# 832 "parsing/parser.mly"
        (string)
-# 48405 "parsing/parser.ml"
+# 49677 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _1 : (Parsetree.expression) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 987 "parsing/parser.mly"
+            let _1 =
+              let _2 =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 1011 "parsing/parser.mly"
    ( mkoperator ~loc:_sloc _1 )
-# 48421 "parsing/parser.ml"
+# 49694 "parsing/parser.ml"
+                
+              in
+              
+# 2603 "parsing/parser.mly"
+      ( mkinfix _1 _2 _3 )
+# 49700 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2561 "parsing/parser.mly"
-      ( mkinfix _1 _2 _3 )
-# 48427 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 49710 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 48437 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48443 "parsing/parser.ml"
-         in
+# 49716 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48461,26 +49735,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _1 = 
-# 2563 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2605 "parsing/parser.mly"
       ( Pexp_extension _1 )
-# 48469 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 49744 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 48477 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 49752 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48483 "parsing/parser.ml"
-         in
+# 49758 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48522,68 +49798,70 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _3 =
-              let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
-              let _1 = 
-# 2564 "parsing/parser.mly"
+            let _1 =
+              let _3 =
+                let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
+                let _1 = 
+# 2606 "parsing/parser.mly"
                                                     (Lident "()")
-# 48533 "parsing/parser.ml"
-               in
-              let _endpos__1_ = _endpos__2_ in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 48542 "parsing/parser.ml"
-              
-            in
-            let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
-            let od =
-              let _1 =
+# 49810 "parsing/parser.ml"
+                 in
+                let _endpos__1_ = _endpos__2_ in
                 let _endpos = _endpos__1_ in
                 let _symbolstartpos = _startpos__1_ in
                 let _sloc = (_symbolstartpos, _endpos) in
                 
-# 960 "parsing/parser.mly"
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 48554 "parsing/parser.ml"
+# 49819 "parsing/parser.ml"
                 
               in
-              let _loc__1_ = (_startpos__1_, _endpos__1_) in
-              
-# 1680 "parsing/parser.mly"
+              let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
+              let od =
+                let _1 =
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 49831 "parsing/parser.ml"
+                  
+                in
+                let _loc__1_ = (_startpos__1_, _endpos__1_) in
+                
+# 1704 "parsing/parser.mly"
   ( let loc = make_loc _loc__1_ in
     let me = Mod.ident ~loc _1 in
     Opn.mk ~loc me )
-# 48563 "parsing/parser.ml"
+# 49840 "parsing/parser.ml"
+                
+              in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              
+# 2607 "parsing/parser.mly"
+      ( Pexp_open(od, mkexp ~loc:(_loc__3_) (Pexp_construct(_3, None))) )
+# 49847 "parsing/parser.ml"
               
             in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _endpos__1_ = _endpos__2_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2565 "parsing/parser.mly"
-      ( Pexp_open(od, mkexp ~loc:(_loc__3_) (Pexp_construct(_3, None))) )
-# 48570 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 49857 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__2_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 48580 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48586 "parsing/parser.ml"
-         in
+# 49863 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48632,31 +49910,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _loc__5_ = (_startpos__5_, _endpos__5_) in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            
-# 2567 "parsing/parser.mly"
+            let _1 =
+              let _loc__5_ = (_startpos__5_, _endpos__5_) in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              
+# 2609 "parsing/parser.mly"
       ( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 48643 "parsing/parser.ml"
+# 49922 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 48653 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 49932 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48659 "parsing/parser.ml"
-         in
+# 49938 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48692,28 +49972,30 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _1 = 
-# 2569 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2611 "parsing/parser.mly"
       ( let (exten, fields) = _2 in
         Pexp_record(fields, exten) )
-# 48701 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 49982 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 48710 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 49991 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48716 "parsing/parser.ml"
-         in
+# 49997 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48749,31 +50031,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2572 "parsing/parser.mly"
+            let _1 =
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 2614 "parsing/parser.mly"
       ( unclosed "{" _loc__1_ "}" _loc__3_ )
-# 48760 "parsing/parser.ml"
+# 50043 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 48770 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50053 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48776 "parsing/parser.ml"
-         in
+# 50059 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48823,52 +50107,54 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let od =
-              let _1 =
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 960 "parsing/parser.mly"
+            let _1 =
+              let od =
+                let _1 =
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 48837 "parsing/parser.ml"
+# 50122 "parsing/parser.ml"
+                  
+                in
+                let _loc__1_ = (_startpos__1_, _endpos__1_) in
                 
-              in
-              let _loc__1_ = (_startpos__1_, _endpos__1_) in
-              
-# 1680 "parsing/parser.mly"
+# 1704 "parsing/parser.mly"
   ( let loc = make_loc _loc__1_ in
     let me = Mod.ident ~loc _1 in
     Opn.mk ~loc me )
-# 48846 "parsing/parser.ml"
+# 50131 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__5_ in
               
-            in
-            let _endpos = _endpos__5_ in
-            
-# 2574 "parsing/parser.mly"
+# 2616 "parsing/parser.mly"
       ( let (exten, fields) = _4 in
         Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos)
                         (Pexp_record(fields, exten))) )
-# 48855 "parsing/parser.ml"
+# 50140 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 48865 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50150 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48871 "parsing/parser.ml"
-         in
+# 50156 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48918,31 +50204,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _loc__5_ = (_startpos__5_, _endpos__5_) in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            
-# 2578 "parsing/parser.mly"
+            let _1 =
+              let _loc__5_ = (_startpos__5_, _endpos__5_) in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              
+# 2620 "parsing/parser.mly"
       ( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 48929 "parsing/parser.ml"
+# 50216 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 48939 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50226 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 48945 "parsing/parser.ml"
-         in
+# 50232 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -48977,34 +50265,36 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 = 
-# 2831 "parsing/parser.mly"
+            let _1 =
+              let _2 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 48986 "parsing/parser.ml"
-             in
-            
-# 2580 "parsing/parser.mly"
+# 50275 "parsing/parser.ml"
+               in
+              
+# 2622 "parsing/parser.mly"
       ( Pexp_array(_2) )
-# 48991 "parsing/parser.ml"
+# 50280 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 49001 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50290 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49007 "parsing/parser.ml"
-         in
+# 50296 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49039,36 +50329,38 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 = 
-# 2831 "parsing/parser.mly"
+            let _1 =
+              let _2 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 49048 "parsing/parser.ml"
-             in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2582 "parsing/parser.mly"
+# 50339 "parsing/parser.ml"
+               in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 2624 "parsing/parser.mly"
       ( unclosed "[|" _loc__1_ "|]" _loc__3_ )
-# 49055 "parsing/parser.ml"
+# 50346 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 49065 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50356 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49071 "parsing/parser.ml"
-         in
+# 50362 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49096,27 +50388,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.expression) = let _1 =
-          let _1 = 
-# 2584 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2626 "parsing/parser.mly"
       ( Pexp_array [] )
-# 49104 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 50397 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 49113 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50406 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49119 "parsing/parser.ml"
-         in
+# 50412 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49165,55 +50459,57 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _4 = 
-# 2831 "parsing/parser.mly"
+            let _1 =
+              let _4 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 49174 "parsing/parser.ml"
-             in
-            let od =
-              let _1 =
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 960 "parsing/parser.mly"
+# 50469 "parsing/parser.ml"
+               in
+              let od =
+                let _1 =
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 49184 "parsing/parser.ml"
+# 50479 "parsing/parser.ml"
+                  
+                in
+                let _loc__1_ = (_startpos__1_, _endpos__1_) in
                 
-              in
-              let _loc__1_ = (_startpos__1_, _endpos__1_) in
-              
-# 1680 "parsing/parser.mly"
+# 1704 "parsing/parser.mly"
   ( let loc = make_loc _loc__1_ in
     let me = Mod.ident ~loc _1 in
     Opn.mk ~loc me )
-# 49193 "parsing/parser.ml"
+# 50488 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__5_ in
+              
+# 2628 "parsing/parser.mly"
+      ( Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array(_4))) )
+# 50495 "parsing/parser.ml"
               
             in
-            let _endpos = _endpos__5_ in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2586 "parsing/parser.mly"
-      ( Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array(_4))) )
-# 49200 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 50505 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 49210 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49216 "parsing/parser.ml"
-         in
+# 50511 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49255,51 +50551,53 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let od =
-              let _1 =
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 960 "parsing/parser.mly"
+            let _1 =
+              let od =
+                let _1 =
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 49269 "parsing/parser.ml"
+# 50566 "parsing/parser.ml"
+                  
+                in
+                let _loc__1_ = (_startpos__1_, _endpos__1_) in
                 
-              in
-              let _loc__1_ = (_startpos__1_, _endpos__1_) in
-              
-# 1680 "parsing/parser.mly"
+# 1704 "parsing/parser.mly"
   ( let loc = make_loc _loc__1_ in
     let me = Mod.ident ~loc _1 in
     Opn.mk ~loc me )
-# 49278 "parsing/parser.ml"
+# 50575 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__4_ in
               
-            in
-            let _endpos = _endpos__4_ in
-            
-# 2588 "parsing/parser.mly"
+# 2630 "parsing/parser.mly"
       ( (* TODO: review the location of Pexp_array *)
         Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array [])) )
-# 49286 "parsing/parser.ml"
+# 50583 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 49296 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50593 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49302 "parsing/parser.ml"
-         in
+# 50599 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49348,36 +50646,38 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _4 = 
-# 2831 "parsing/parser.mly"
+            let _1 =
+              let _4 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 49357 "parsing/parser.ml"
-             in
-            let _loc__5_ = (_startpos__5_, _endpos__5_) in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            
-# 2592 "parsing/parser.mly"
+# 50656 "parsing/parser.ml"
+               in
+              let _loc__5_ = (_startpos__5_, _endpos__5_) in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              
+# 2634 "parsing/parser.mly"
       ( unclosed "[|" _loc__3_ "|]" _loc__5_ )
-# 49364 "parsing/parser.ml"
+# 50663 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 49374 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50673 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49380 "parsing/parser.ml"
-         in
+# 50679 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49412,35 +50712,37 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 = 
-# 2831 "parsing/parser.mly"
+            let _1 =
+              let _2 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 49421 "parsing/parser.ml"
-             in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            
-# 2594 "parsing/parser.mly"
+# 50722 "parsing/parser.ml"
+               in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              
+# 2636 "parsing/parser.mly"
       ( fst (mktailexp _loc__3_ _2) )
-# 49427 "parsing/parser.ml"
+# 50728 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 49437 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50738 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49443 "parsing/parser.ml"
-         in
+# 50744 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49475,36 +50777,38 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _2 = 
-# 2831 "parsing/parser.mly"
+            let _1 =
+              let _2 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 49484 "parsing/parser.ml"
-             in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2596 "parsing/parser.mly"
+# 50787 "parsing/parser.ml"
+               in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 2638 "parsing/parser.mly"
       ( unclosed "[" _loc__1_ "]" _loc__3_ )
-# 49491 "parsing/parser.ml"
+# 50794 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 49501 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50804 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49507 "parsing/parser.ml"
-         in
+# 50810 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49553,60 +50857,62 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _4 = 
-# 2831 "parsing/parser.mly"
+            let _1 =
+              let _4 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 49562 "parsing/parser.ml"
-             in
-            let od =
-              let _1 =
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 960 "parsing/parser.mly"
+# 50867 "parsing/parser.ml"
+               in
+              let od =
+                let _1 =
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 49572 "parsing/parser.ml"
+# 50877 "parsing/parser.ml"
+                  
+                in
+                let _loc__1_ = (_startpos__1_, _endpos__1_) in
                 
-              in
-              let _loc__1_ = (_startpos__1_, _endpos__1_) in
-              
-# 1680 "parsing/parser.mly"
+# 1704 "parsing/parser.mly"
   ( let loc = make_loc _loc__1_ in
     let me = Mod.ident ~loc _1 in
     Opn.mk ~loc me )
-# 49581 "parsing/parser.ml"
+# 50886 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__5_ in
+              let _loc__5_ = (_startpos__5_, _endpos__5_) in
               
-            in
-            let _endpos = _endpos__5_ in
-            let _loc__5_ = (_startpos__5_, _endpos__5_) in
-            
-# 2598 "parsing/parser.mly"
+# 2640 "parsing/parser.mly"
       ( let list_exp =
           (* TODO: review the location of list_exp *)
           let tail_exp, _tail_loc = mktailexp _loc__5_ _4 in
           mkexp ~loc:(_startpos__3_, _endpos) tail_exp in
         Pexp_open(od, list_exp) )
-# 49593 "parsing/parser.ml"
+# 50898 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 49603 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 50908 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49609 "parsing/parser.ml"
-         in
+# 50914 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49648,68 +50954,70 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_inlined1_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _3 =
-              let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
-              let _1 = 
-# 2603 "parsing/parser.mly"
+            let _1 =
+              let _3 =
+                let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
+                let _1 = 
+# 2645 "parsing/parser.mly"
                                                         (Lident "[]")
-# 49659 "parsing/parser.ml"
-               in
-              let _endpos__1_ = _endpos__2_ in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 49668 "parsing/parser.ml"
-              
-            in
-            let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
-            let od =
-              let _1 =
+# 50966 "parsing/parser.ml"
+                 in
+                let _endpos__1_ = _endpos__2_ in
                 let _endpos = _endpos__1_ in
                 let _symbolstartpos = _startpos__1_ in
                 let _sloc = (_symbolstartpos, _endpos) in
                 
-# 960 "parsing/parser.mly"
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 49680 "parsing/parser.ml"
+# 50975 "parsing/parser.ml"
                 
               in
-              let _loc__1_ = (_startpos__1_, _endpos__1_) in
-              
-# 1680 "parsing/parser.mly"
+              let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
+              let od =
+                let _1 =
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 50987 "parsing/parser.ml"
+                  
+                in
+                let _loc__1_ = (_startpos__1_, _endpos__1_) in
+                
+# 1704 "parsing/parser.mly"
   ( let loc = make_loc _loc__1_ in
     let me = Mod.ident ~loc _1 in
     Opn.mk ~loc me )
-# 49689 "parsing/parser.ml"
+# 50996 "parsing/parser.ml"
+                
+              in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              
+# 2646 "parsing/parser.mly"
+      ( Pexp_open(od, mkexp ~loc:_loc__3_ (Pexp_construct(_3, None))) )
+# 51003 "parsing/parser.ml"
               
             in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _endpos__1_ = _endpos__2_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2604 "parsing/parser.mly"
-      ( Pexp_open(od, mkexp ~loc:_loc__3_ (Pexp_construct(_3, None))) )
-# 49696 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 51013 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__2_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 49706 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49712 "parsing/parser.ml"
-         in
+# 51019 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49758,36 +51066,38 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _4 = 
-# 2831 "parsing/parser.mly"
+            let _1 =
+              let _4 = 
+# 2873 "parsing/parser.mly"
     ( es )
-# 49767 "parsing/parser.ml"
-             in
-            let _loc__5_ = (_startpos__5_, _endpos__5_) in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            
-# 2607 "parsing/parser.mly"
+# 51076 "parsing/parser.ml"
+               in
+              let _loc__5_ = (_startpos__5_, _endpos__5_) in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              
+# 2649 "parsing/parser.mly"
       ( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 49774 "parsing/parser.ml"
+# 51083 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 49784 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 51093 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49790 "parsing/parser.ml"
-         in
+# 51099 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -49871,85 +51181,87 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__9_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _8 =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 3646 "parsing/parser.mly"
+            let _1 =
+              let _8 =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 49887 "parsing/parser.ml"
-              
-            in
-            let _5 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-              let _2 =
-                let _1 = _1_inlined1 in
+# 51198 "parsing/parser.ml"
                 
-# 4062 "parsing/parser.mly"
+              in
+              let _5 =
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 49897 "parsing/parser.ml"
+# 51208 "parsing/parser.ml"
+                  
+                in
                 
-              in
-              
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 49903 "parsing/parser.ml"
-              
-            in
-            let od =
-              let _1 =
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
+# 51214 "parsing/parser.ml"
                 
-# 960 "parsing/parser.mly"
+              in
+              let od =
+                let _1 =
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 49914 "parsing/parser.ml"
+# 51225 "parsing/parser.ml"
+                  
+                in
+                let _loc__1_ = (_startpos__1_, _endpos__1_) in
                 
-              in
-              let _loc__1_ = (_startpos__1_, _endpos__1_) in
-              
-# 1680 "parsing/parser.mly"
+# 1704 "parsing/parser.mly"
   ( let loc = make_loc _loc__1_ in
     let me = Mod.ident ~loc _1 in
     Opn.mk ~loc me )
-# 49923 "parsing/parser.ml"
+# 51234 "parsing/parser.ml"
+                
+              in
+              let _startpos_od_ = _startpos__1_ in
+              let _endpos = _endpos__9_ in
+              let _symbolstartpos = _startpos_od_ in
+              let _sloc = (_symbolstartpos, _endpos) in
               
-            in
-            let _startpos_od_ = _startpos__1_ in
-            let _endpos = _endpos__9_ in
-            let _symbolstartpos = _startpos_od_ in
-            let _sloc = (_symbolstartpos, _endpos) in
-            
-# 2610 "parsing/parser.mly"
+# 2652 "parsing/parser.mly"
       ( let modexp =
           mkexp_attrs ~loc:(_startpos__3_, _endpos)
             (Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _6), _8)) _5 in
         Pexp_open(od, modexp) )
-# 49936 "parsing/parser.ml"
+# 51247 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__9_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__9_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
     ( mkexp ~loc:_sloc _1 )
-# 49946 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+# 51257 "parsing/parser.ml"
+            
+          in
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 49952 "parsing/parser.ml"
-         in
+# 51263 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50026,47 +51338,49 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__8_ in
-        let _v : (Parsetree.expression) = let _1 =
+        let _v =
           let _1 =
-            let _5 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-              let _2 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+            let _1 =
+              let _5 =
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 50039 "parsing/parser.ml"
+# 51352 "parsing/parser.ml"
+                  
+                in
+                
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 51358 "parsing/parser.ml"
                 
               in
+              let _loc__8_ = (_startpos__8_, _endpos__8_) in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
               
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 50045 "parsing/parser.ml"
+# 2658 "parsing/parser.mly"
+      ( unclosed "(" _loc__3_ ")" _loc__8_ )
+# 51366 "parsing/parser.ml"
               
             in
-            let _loc__8_ = (_startpos__8_, _endpos__8_) in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
+            let _endpos__1_ = _endpos__8_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2616 "parsing/parser.mly"
-      ( unclosed "(" _loc__3_ ")" _loc__8_ )
-# 50053 "parsing/parser.ml"
+# 1017 "parsing/parser.mly"
+    ( mkexp ~loc:_sloc _1 )
+# 51376 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__8_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 993 "parsing/parser.mly"
-    ( mkexp ~loc:_sloc _1 )
-# 50063 "parsing/parser.ml"
-          
-        in
-        
-# 2508 "parsing/parser.mly"
+          (
+# 2531 "parsing/parser.mly"
       ( _1 )
-# 50069 "parsing/parser.ml"
-         in
+# 51382 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50087,38 +51401,40 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 50100 "parsing/parser.ml"
+# 51415 "parsing/parser.ml"
+                
+              in
+              
+# 2959 "parsing/parser.mly"
+      ( Ppat_var (_1) )
+# 51421 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2914 "parsing/parser.mly"
-      ( Ppat_var (_1) )
-# 50106 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 51430 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 50115 "parsing/parser.ml"
-          
-        in
-        
-# 2915 "parsing/parser.mly"
+          (
+# 2960 "parsing/parser.mly"
       ( _1 )
-# 50121 "parsing/parser.ml"
-         in
+# 51436 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50140,9 +51456,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.pattern) = 
-# 2916 "parsing/parser.mly"
+# 2961 "parsing/parser.mly"
                              ( _1 )
-# 50146 "parsing/parser.ml"
+# 51462 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -50178,14 +51494,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _endpos = _endpos__3_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2921 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__3_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2966 "parsing/parser.mly"
       ( reloc_pat ~loc:_sloc _2 )
-# 50188 "parsing/parser.ml"
-         in
+# 51505 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50207,9 +51525,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.pattern) = 
-# 2923 "parsing/parser.mly"
+# 2968 "parsing/parser.mly"
       ( _1 )
-# 50213 "parsing/parser.ml"
+# 51531 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -50266,41 +51584,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.pattern) = let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 50278 "parsing/parser.ml"
-          
-        in
-        let _3 =
-          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-          let _2 =
-            let _1 = _1_inlined1 in
+# 51597 "parsing/parser.ml"
             
-# 4062 "parsing/parser.mly"
+          in
+          let _3 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 50288 "parsing/parser.ml"
+# 51607 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 50294 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2925 "parsing/parser.mly"
+# 51613 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2970 "parsing/parser.mly"
       ( mkpat_attrs ~loc:_sloc (Ppat_unpack _4) _3 )
-# 50303 "parsing/parser.ml"
-         in
+# 51622 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50370,58 +51690,60 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : (Parsetree.pattern) = let _6 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined4_, _startpos__1_inlined4_, _1_inlined4) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 3646 "parsing/parser.mly"
+        let _v =
+          let _6 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined4_, _startpos__1_inlined4_, _1_inlined4) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 50384 "parsing/parser.ml"
-          
-        in
-        let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 51705 "parsing/parser.ml"
+            
+          in
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 50395 "parsing/parser.ml"
-          
-        in
-        let (_endpos__4_, _startpos__4_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in
-        let _3 =
-          let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-          let _2 =
-            let _1 = _1_inlined1 in
+# 51716 "parsing/parser.ml"
             
-# 4062 "parsing/parser.mly"
+          in
+          let (_endpos__4_, _startpos__4_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in
+          let _3 =
+            let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+            let _2 =
+              let _1 = _1_inlined1 in
+              
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 50406 "parsing/parser.ml"
+# 51727 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 4075 "parsing/parser.mly"
+# 4127 "parsing/parser.mly"
                     ( _1, _2 )
-# 50412 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__7_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _loc__4_ = (_startpos__4_, _endpos__4_) in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2927 "parsing/parser.mly"
+# 51733 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _loc__4_ = (_startpos__4_, _endpos__4_) in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2972 "parsing/parser.mly"
       ( mkpat_attrs ~loc:_sloc
           (Ppat_constraint(mkpat ~loc:_loc__4_ (Ppat_unpack _4), _6))
           _3 )
-# 50424 "parsing/parser.ml"
-         in
+# 51745 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50442,26 +51764,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2935 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2980 "parsing/parser.mly"
       ( Ppat_any )
-# 50450 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 51773 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 50458 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 51781 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 50464 "parsing/parser.ml"
-         in
+# 51787 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50482,26 +51806,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2937 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2982 "parsing/parser.mly"
       ( Ppat_constant _1 )
-# 50490 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 51815 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 50498 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 51823 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 50504 "parsing/parser.ml"
-         in
+# 51829 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50536,27 +51862,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2939 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2984 "parsing/parser.mly"
       ( Ppat_interval (_1, _3) )
-# 50544 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 51871 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 50553 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 51880 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 50559 "parsing/parser.ml"
-         in
+# 51886 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50577,38 +51905,40 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 50590 "parsing/parser.ml"
+# 51919 "parsing/parser.ml"
+                
+              in
+              
+# 2986 "parsing/parser.mly"
+      ( Ppat_construct(_1, None) )
+# 51925 "parsing/parser.ml"
               
             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2941 "parsing/parser.mly"
-      ( Ppat_construct(_1, None) )
-# 50596 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 51934 "parsing/parser.ml"
             
           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 50605 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 50611 "parsing/parser.ml"
-         in
+# 51940 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50629,26 +51959,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2943 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 2988 "parsing/parser.mly"
       ( Ppat_variant(_1, None) )
-# 50637 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 51968 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 50645 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 51976 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 50651 "parsing/parser.ml"
-         in
+# 51982 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50676,40 +52008,42 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+            let _1 =
+              let _2 =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 50690 "parsing/parser.ml"
+# 52023 "parsing/parser.ml"
+                
+              in
+              
+# 2990 "parsing/parser.mly"
+      ( Ppat_type (_2) )
+# 52029 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined1_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2945 "parsing/parser.mly"
-      ( Ppat_type (_2) )
-# 50696 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 52039 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 50706 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 50712 "parsing/parser.ml"
-         in
+# 52045 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50744,39 +52078,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 50757 "parsing/parser.ml"
+# 52092 "parsing/parser.ml"
+                
+              in
+              
+# 2992 "parsing/parser.mly"
+      ( Ppat_open(_1, _3) )
+# 52098 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2947 "parsing/parser.mly"
-      ( Ppat_open(_1, _3) )
-# 50763 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 52108 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 50773 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 50779 "parsing/parser.ml"
-         in
+# 52114 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50818,60 +52154,62 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_inlined1_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _3 =
-              let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
-              let _1 = 
-# 2948 "parsing/parser.mly"
+            let _1 =
+              let _3 =
+                let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
+                let _1 = 
+# 2993 "parsing/parser.mly"
                                                      (Lident "[]")
-# 50829 "parsing/parser.ml"
-               in
-              let _endpos__1_ = _endpos__2_ in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+# 52166 "parsing/parser.ml"
+                 in
+                let _endpos__1_ = _endpos__2_ in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 50838 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos__2_inlined1_ in
-            let _1 =
-              let _endpos = _endpos__1_ in
+# 52175 "parsing/parser.ml"
+                
+              in
+              let _endpos__3_ = _endpos__2_inlined1_ in
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 52186 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
               let _symbolstartpos = _startpos__1_ in
               let _sloc = (_symbolstartpos, _endpos) in
               
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 50849 "parsing/parser.ml"
+# 2994 "parsing/parser.mly"
+    ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
+# 52195 "parsing/parser.ml"
               
             in
-            let _endpos = _endpos__3_ in
+            let _endpos__1_ = _endpos__2_inlined1_ in
+            let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 2949 "parsing/parser.mly"
-    ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 50858 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 52205 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__2_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 50868 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 50874 "parsing/parser.ml"
-         in
+# 52211 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -50913,60 +52251,62 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_inlined1_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _3 =
-              let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
-              let _1 = 
-# 2950 "parsing/parser.mly"
+            let _1 =
+              let _3 =
+                let (_endpos__2_, _startpos__1_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
+                let _1 = 
+# 2995 "parsing/parser.mly"
                                                  (Lident "()")
-# 50924 "parsing/parser.ml"
-               in
-              let _endpos__1_ = _endpos__2_ in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+# 52263 "parsing/parser.ml"
+                 in
+                let _endpos__1_ = _endpos__2_ in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 50933 "parsing/parser.ml"
-              
-            in
-            let _endpos__3_ = _endpos__2_inlined1_ in
-            let _1 =
-              let _endpos = _endpos__1_ in
+# 52272 "parsing/parser.ml"
+                
+              in
+              let _endpos__3_ = _endpos__2_inlined1_ in
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 52283 "parsing/parser.ml"
+                
+              in
+              let _endpos = _endpos__3_ in
               let _symbolstartpos = _startpos__1_ in
               let _sloc = (_symbolstartpos, _endpos) in
               
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 50944 "parsing/parser.ml"
+# 2996 "parsing/parser.mly"
+    ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
+# 52292 "parsing/parser.ml"
               
             in
-            let _endpos = _endpos__3_ in
+            let _endpos__1_ = _endpos__2_inlined1_ in
+            let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 2951 "parsing/parser.mly"
-    ( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 50953 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 52302 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__2_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 50963 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 50969 "parsing/parser.ml"
-         in
+# 52308 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -51015,39 +52355,41 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 960 "parsing/parser.mly"
+              let _1 =
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 51028 "parsing/parser.ml"
+# 52369 "parsing/parser.ml"
+                
+              in
+              
+# 2998 "parsing/parser.mly"
+      ( Ppat_open (_1, _4) )
+# 52375 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2953 "parsing/parser.mly"
-      ( Ppat_open (_1, _4) )
-# 51034 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 52385 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 51044 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 51050 "parsing/parser.ml"
-         in
+# 52391 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -51096,31 +52438,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _loc__5_ = (_startpos__5_, _endpos__5_) in
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            
-# 2955 "parsing/parser.mly"
+            let _1 =
+              let _loc__5_ = (_startpos__5_, _endpos__5_) in
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              
+# 3000 "parsing/parser.mly"
       ( unclosed "(" _loc__3_ ")" _loc__5_  )
-# 51107 "parsing/parser.ml"
+# 52450 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 51117 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 52460 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 51123 "parsing/parser.ml"
-         in
+# 52466 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -51162,30 +52506,32 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _loc__4_ = (_startpos__4_, _endpos__4_) in
-            
-# 2957 "parsing/parser.mly"
+            let _1 =
+              let _loc__4_ = (_startpos__4_, _endpos__4_) in
+              
+# 3002 "parsing/parser.mly"
       ( expecting _loc__4_ "pattern" )
-# 51172 "parsing/parser.ml"
+# 52517 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 51182 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 52527 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 51188 "parsing/parser.ml"
-         in
+# 52533 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -51220,31 +52566,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _loc__3_ = (_startpos__3_, _endpos__3_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2959 "parsing/parser.mly"
+            let _1 =
+              let _loc__3_ = (_startpos__3_, _endpos__3_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 3004 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 51231 "parsing/parser.ml"
+# 52578 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 51241 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 52588 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 51247 "parsing/parser.ml"
-         in
+# 52594 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -51293,27 +52641,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2961 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3006 "parsing/parser.mly"
       ( Ppat_constraint(_2, _4) )
-# 51301 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 52650 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 51310 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 52659 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 51316 "parsing/parser.ml"
-         in
+# 52665 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -51362,31 +52712,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__5_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _loc__5_ = (_startpos__5_, _endpos__5_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
-            
-# 2963 "parsing/parser.mly"
+            let _1 =
+              let _loc__5_ = (_startpos__5_, _endpos__5_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
+              
+# 3008 "parsing/parser.mly"
       ( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 51373 "parsing/parser.ml"
+# 52724 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__5_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__5_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 51383 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 52734 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 51389 "parsing/parser.ml"
-         in
+# 52740 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -51428,30 +52780,32 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _loc__4_ = (_startpos__4_, _endpos__4_) in
-            
-# 2965 "parsing/parser.mly"
+            let _1 =
+              let _loc__4_ = (_startpos__4_, _endpos__4_) in
+              
+# 3010 "parsing/parser.mly"
       ( expecting _loc__4_ "type" )
-# 51438 "parsing/parser.ml"
+# 52791 "parsing/parser.ml"
+              
+            in
+            let _endpos__1_ = _endpos__4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-          in
-          let _endpos__1_ = _endpos__4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 51448 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 52801 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 51454 "parsing/parser.ml"
-         in
+# 52807 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -51521,60 +52875,62 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : (Parsetree.pattern) = let _1 =
+        let _v =
           let _1 =
-            let _6 =
-              let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-              let _endpos = _endpos__1_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 3646 "parsing/parser.mly"
+            let _1 =
+              let _6 =
+                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+                let _endpos = _endpos__1_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
+                
+# 3691 "parsing/parser.mly"
       ( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
         let descr = Ptyp_package (lid, cstrs) in
         mktyp ~loc:_sloc ~attrs descr )
-# 51537 "parsing/parser.ml"
-              
-            in
-            let _3 =
-              let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
-              let _2 =
-                let _1 = _1_inlined1 in
+# 52892 "parsing/parser.ml"
                 
-# 4062 "parsing/parser.mly"
+              in
+              let _3 =
+                let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
+                let _2 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 51547 "parsing/parser.ml"
+# 52902 "parsing/parser.ml"
+                  
+                in
+                
+# 4127 "parsing/parser.mly"
+                    ( _1, _2 )
+# 52908 "parsing/parser.ml"
                 
               in
+              let _loc__7_ = (_startpos__7_, _endpos__7_) in
+              let _loc__1_ = (_startpos__1_, _endpos__1_) in
               
-# 4075 "parsing/parser.mly"
-                    ( _1, _2 )
-# 51553 "parsing/parser.ml"
+# 3013 "parsing/parser.mly"
+      ( unclosed "(" _loc__1_ ")" _loc__7_ )
+# 52916 "parsing/parser.ml"
               
             in
-            let _loc__7_ = (_startpos__7_, _endpos__7_) in
-            let _loc__1_ = (_startpos__1_, _endpos__1_) in
+            let _endpos__1_ = _endpos__7_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 2968 "parsing/parser.mly"
-      ( unclosed "(" _loc__1_ ")" _loc__7_ )
-# 51561 "parsing/parser.ml"
+# 1019 "parsing/parser.mly"
+    ( mkpat ~loc:_sloc _1 )
+# 52926 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__7_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
-    ( mkpat ~loc:_sloc _1 )
-# 51571 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 51577 "parsing/parser.ml"
-         in
+# 52932 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -51595,26 +52951,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.pattern) = let _1 =
-          let _1 = 
-# 2970 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3015 "parsing/parser.mly"
       ( Ppat_extension _1 )
-# 51603 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 995 "parsing/parser.mly"
+# 52960 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1019 "parsing/parser.mly"
     ( mkpat ~loc:_sloc _1 )
-# 51611 "parsing/parser.ml"
-          
-        in
-        
-# 2931 "parsing/parser.mly"
+# 52968 "parsing/parser.ml"
+            
+          in
+          (
+# 2976 "parsing/parser.mly"
       ( _1 )
-# 51617 "parsing/parser.ml"
-         in
+# 52974 "parsing/parser.ml"
+           : (Parsetree.pattern))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -51632,17 +52990,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 51638 "parsing/parser.ml"
+# 52996 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3983 "parsing/parser.mly"
+# 4035 "parsing/parser.mly"
            ( _1 )
-# 51646 "parsing/parser.ml"
+# 53004 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51661,17 +53019,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 829 "parsing/parser.mly"
+# 848 "parsing/parser.mly"
        (string)
-# 51667 "parsing/parser.ml"
+# 53025 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3984 "parsing/parser.mly"
+# 4036 "parsing/parser.mly"
            ( _1 )
-# 51675 "parsing/parser.ml"
+# 53033 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51694,9 +53052,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3985 "parsing/parser.mly"
+# 4037 "parsing/parser.mly"
         ( "and" )
-# 51700 "parsing/parser.ml"
+# 53058 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51719,9 +53077,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3986 "parsing/parser.mly"
+# 4038 "parsing/parser.mly"
        ( "as" )
-# 51725 "parsing/parser.ml"
+# 53083 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51744,9 +53102,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3987 "parsing/parser.mly"
+# 4039 "parsing/parser.mly"
            ( "assert" )
-# 51750 "parsing/parser.ml"
+# 53108 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51769,9 +53127,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3988 "parsing/parser.mly"
+# 4040 "parsing/parser.mly"
           ( "begin" )
-# 51775 "parsing/parser.ml"
+# 53133 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51794,9 +53152,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3989 "parsing/parser.mly"
+# 4041 "parsing/parser.mly"
           ( "class" )
-# 51800 "parsing/parser.ml"
+# 53158 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51819,9 +53177,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3990 "parsing/parser.mly"
+# 4042 "parsing/parser.mly"
                ( "constraint" )
-# 51825 "parsing/parser.ml"
+# 53183 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51844,9 +53202,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3991 "parsing/parser.mly"
+# 4043 "parsing/parser.mly"
        ( "do" )
-# 51850 "parsing/parser.ml"
+# 53208 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51869,9 +53227,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3992 "parsing/parser.mly"
+# 4044 "parsing/parser.mly"
          ( "done" )
-# 51875 "parsing/parser.ml"
+# 53233 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51894,9 +53252,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3993 "parsing/parser.mly"
+# 4045 "parsing/parser.mly"
            ( "downto" )
-# 51900 "parsing/parser.ml"
+# 53258 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51919,9 +53277,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3994 "parsing/parser.mly"
+# 4046 "parsing/parser.mly"
          ( "else" )
-# 51925 "parsing/parser.ml"
+# 53283 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51944,9 +53302,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3995 "parsing/parser.mly"
+# 4047 "parsing/parser.mly"
         ( "end" )
-# 51950 "parsing/parser.ml"
+# 53308 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51969,9 +53327,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3996 "parsing/parser.mly"
+# 4048 "parsing/parser.mly"
               ( "exception" )
-# 51975 "parsing/parser.ml"
+# 53333 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -51994,9 +53352,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3997 "parsing/parser.mly"
+# 4049 "parsing/parser.mly"
              ( "external" )
-# 52000 "parsing/parser.ml"
+# 53358 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52019,9 +53377,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3998 "parsing/parser.mly"
+# 4050 "parsing/parser.mly"
           ( "false" )
-# 52025 "parsing/parser.ml"
+# 53383 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52044,9 +53402,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3999 "parsing/parser.mly"
+# 4051 "parsing/parser.mly"
         ( "for" )
-# 52050 "parsing/parser.ml"
+# 53408 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52069,9 +53427,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4000 "parsing/parser.mly"
+# 4052 "parsing/parser.mly"
         ( "fun" )
-# 52075 "parsing/parser.ml"
+# 53433 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52094,9 +53452,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4001 "parsing/parser.mly"
+# 4053 "parsing/parser.mly"
              ( "function" )
-# 52100 "parsing/parser.ml"
+# 53458 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52119,9 +53477,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4002 "parsing/parser.mly"
+# 4054 "parsing/parser.mly"
             ( "functor" )
-# 52125 "parsing/parser.ml"
+# 53483 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52144,9 +53502,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4003 "parsing/parser.mly"
+# 4055 "parsing/parser.mly"
        ( "if" )
-# 52150 "parsing/parser.ml"
+# 53508 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52169,9 +53527,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4004 "parsing/parser.mly"
+# 4056 "parsing/parser.mly"
        ( "in" )
-# 52175 "parsing/parser.ml"
+# 53533 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52194,9 +53552,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4005 "parsing/parser.mly"
+# 4057 "parsing/parser.mly"
             ( "include" )
-# 52200 "parsing/parser.ml"
+# 53558 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52219,9 +53577,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4006 "parsing/parser.mly"
+# 4058 "parsing/parser.mly"
             ( "inherit" )
-# 52225 "parsing/parser.ml"
+# 53583 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52244,9 +53602,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4007 "parsing/parser.mly"
+# 4059 "parsing/parser.mly"
                 ( "initializer" )
-# 52250 "parsing/parser.ml"
+# 53608 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52269,9 +53627,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4008 "parsing/parser.mly"
+# 4060 "parsing/parser.mly"
          ( "lazy" )
-# 52275 "parsing/parser.ml"
+# 53633 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52294,9 +53652,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4009 "parsing/parser.mly"
+# 4061 "parsing/parser.mly"
         ( "let" )
-# 52300 "parsing/parser.ml"
+# 53658 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52319,9 +53677,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4010 "parsing/parser.mly"
+# 4062 "parsing/parser.mly"
           ( "match" )
-# 52325 "parsing/parser.ml"
+# 53683 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52344,9 +53702,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4011 "parsing/parser.mly"
+# 4063 "parsing/parser.mly"
            ( "method" )
-# 52350 "parsing/parser.ml"
+# 53708 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52369,9 +53727,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4012 "parsing/parser.mly"
+# 4064 "parsing/parser.mly"
            ( "module" )
-# 52375 "parsing/parser.ml"
+# 53733 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52394,9 +53752,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4013 "parsing/parser.mly"
+# 4065 "parsing/parser.mly"
             ( "mutable" )
-# 52400 "parsing/parser.ml"
+# 53758 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52419,9 +53777,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4014 "parsing/parser.mly"
+# 4066 "parsing/parser.mly"
         ( "new" )
-# 52425 "parsing/parser.ml"
+# 53783 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52444,9 +53802,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4015 "parsing/parser.mly"
+# 4067 "parsing/parser.mly"
            ( "nonrec" )
-# 52450 "parsing/parser.ml"
+# 53808 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52469,9 +53827,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4016 "parsing/parser.mly"
+# 4068 "parsing/parser.mly"
            ( "object" )
-# 52475 "parsing/parser.ml"
+# 53833 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52494,9 +53852,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4017 "parsing/parser.mly"
+# 4069 "parsing/parser.mly"
        ( "of" )
-# 52500 "parsing/parser.ml"
+# 53858 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52519,9 +53877,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4018 "parsing/parser.mly"
+# 4070 "parsing/parser.mly"
          ( "open" )
-# 52525 "parsing/parser.ml"
+# 53883 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52544,9 +53902,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4019 "parsing/parser.mly"
+# 4071 "parsing/parser.mly"
        ( "or" )
-# 52550 "parsing/parser.ml"
+# 53908 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52569,9 +53927,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4020 "parsing/parser.mly"
+# 4072 "parsing/parser.mly"
             ( "private" )
-# 52575 "parsing/parser.ml"
+# 53933 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52594,9 +53952,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4021 "parsing/parser.mly"
+# 4073 "parsing/parser.mly"
         ( "rec" )
-# 52600 "parsing/parser.ml"
+# 53958 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52619,9 +53977,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4022 "parsing/parser.mly"
+# 4074 "parsing/parser.mly"
         ( "sig" )
-# 52625 "parsing/parser.ml"
+# 53983 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52644,9 +54002,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4023 "parsing/parser.mly"
+# 4075 "parsing/parser.mly"
            ( "struct" )
-# 52650 "parsing/parser.ml"
+# 54008 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52669,9 +54027,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4024 "parsing/parser.mly"
+# 4076 "parsing/parser.mly"
          ( "then" )
-# 52675 "parsing/parser.ml"
+# 54033 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52694,9 +54052,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4025 "parsing/parser.mly"
+# 4077 "parsing/parser.mly"
        ( "to" )
-# 52700 "parsing/parser.ml"
+# 54058 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52719,9 +54077,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4026 "parsing/parser.mly"
+# 4078 "parsing/parser.mly"
          ( "true" )
-# 52725 "parsing/parser.ml"
+# 54083 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52744,9 +54102,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4027 "parsing/parser.mly"
+# 4079 "parsing/parser.mly"
         ( "try" )
-# 52750 "parsing/parser.ml"
+# 54108 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52769,9 +54127,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4028 "parsing/parser.mly"
+# 4080 "parsing/parser.mly"
          ( "type" )
-# 52775 "parsing/parser.ml"
+# 54133 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52794,9 +54152,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4029 "parsing/parser.mly"
+# 4081 "parsing/parser.mly"
         ( "val" )
-# 52800 "parsing/parser.ml"
+# 54158 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52819,9 +54177,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4030 "parsing/parser.mly"
+# 4082 "parsing/parser.mly"
             ( "virtual" )
-# 52825 "parsing/parser.ml"
+# 54183 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52844,9 +54202,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4031 "parsing/parser.mly"
+# 4083 "parsing/parser.mly"
          ( "when" )
-# 52850 "parsing/parser.ml"
+# 54208 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52869,9 +54227,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4032 "parsing/parser.mly"
+# 4084 "parsing/parser.mly"
           ( "while" )
-# 52875 "parsing/parser.ml"
+# 54233 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52894,9 +54252,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 4033 "parsing/parser.mly"
+# 4085 "parsing/parser.mly"
          ( "with" )
-# 52900 "parsing/parser.ml"
+# 54258 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52919,9 +54277,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.type_exception * string Asttypes.loc option) = 
-# 3249 "parsing/parser.mly"
+# 3294 "parsing/parser.mly"
     ( _1 )
-# 52925 "parsing/parser.ml"
+# 54283 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -52992,65 +54350,67 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined5_ in
-        let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
-          let _1 = _1_inlined5 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs =
+            let _1 = _1_inlined5 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 53001 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs_ = _endpos__1_inlined5_ in
-        let attrs2 =
-          let _1 = _1_inlined4 in
-          
-# 4062 "parsing/parser.mly"
+# 54360 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs_ = _endpos__1_inlined5_ in
+          let attrs2 =
+            let _1 = _1_inlined4 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 53010 "parsing/parser.ml"
-          
-        in
-        let lid =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 54369 "parsing/parser.ml"
+            
+          in
+          let lid =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 53021 "parsing/parser.ml"
-          
-        in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 54380 "parsing/parser.ml"
+            
+          in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 53032 "parsing/parser.ml"
-          
-        in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 54391 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 53040 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3258 "parsing/parser.mly"
+# 54399 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3303 "parsing/parser.mly"
   ( let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Te.mk_exception ~attrs
       (Te.rebind id lid ~attrs:(attrs1 @ attrs2) ~loc ~docs)
     , ext )
-# 53053 "parsing/parser.ml"
-         in
+# 54412 "parsing/parser.ml"
+           : (Parsetree.type_exception * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53079,9 +54439,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.expression) = 
-# 2735 "parsing/parser.mly"
+# 2777 "parsing/parser.mly"
       ( _2 )
-# 53085 "parsing/parser.ml"
+# 54445 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -53124,15 +54484,17 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
-        let _v : (Parsetree.expression) = let _endpos = _endpos__4_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2737 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__4_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2779 "parsing/parser.mly"
       ( ghexp ~loc:_sloc (mkfunction _1 _2 _4)
       )
-# 53135 "parsing/parser.ml"
-         in
+# 54496 "parsing/parser.ml"
+           : (Parsetree.expression))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53153,45 +54515,47 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xss_ in
         let _endpos = _endpos_xss_ in
-        let _v : (Parsetree.structure) = let _1 =
+        let _v =
           let _1 =
-            let ys = 
-# 260 "<standard.mly>"
+            let _1 =
+              let ys = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 53162 "parsing/parser.ml"
-             in
-            let xs =
-              let items = 
-# 1030 "parsing/parser.mly"
-    ( [] )
-# 53168 "parsing/parser.ml"
+# 54525 "parsing/parser.ml"
                in
-              
-# 1481 "parsing/parser.mly"
+              let xs =
+                let items = 
+# 1054 "parsing/parser.mly"
+    ( [] )
+# 54531 "parsing/parser.ml"
+                 in
+                
+# 1505 "parsing/parser.mly"
     ( items )
-# 53173 "parsing/parser.ml"
+# 54536 "parsing/parser.ml"
+                
+              in
+              
+# 278 "<standard.mly>"
+    ( xs @ ys )
+# 54542 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+            let _endpos = _endpos__1_ in
+            let _startpos = _startpos__1_ in
             
-# 267 "<standard.mly>"
-    ( xs @ ys )
-# 53179 "parsing/parser.ml"
+# 976 "parsing/parser.mly"
+                              ( extra_str _startpos _endpos _1 )
+# 54551 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
-          let _endpos = _endpos__1_ in
-          let _startpos = _startpos__1_ in
-          
-# 952 "parsing/parser.mly"
-                              ( extra_str _startpos _endpos _1 )
-# 53188 "parsing/parser.ml"
-          
-        in
-        
-# 1474 "parsing/parser.mly"
+          (
+# 1498 "parsing/parser.mly"
   ( _1 )
-# 53194 "parsing/parser.ml"
-         in
+# 54557 "parsing/parser.ml"
+           : (Parsetree.structure))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53226,79 +54590,81 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e_ in
         let _endpos = _endpos_xss_ in
-        let _v : (Parsetree.structure) = let _1 =
+        let _v =
           let _1 =
-            let ys = 
-# 260 "<standard.mly>"
+            let _1 =
+              let ys = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 53235 "parsing/parser.ml"
-             in
-            let xs =
-              let items =
-                let x =
-                  let _1 =
+# 54600 "parsing/parser.ml"
+               in
+              let xs =
+                let items =
+                  let x =
                     let _1 =
-                      let attrs = 
-# 4058 "parsing/parser.mly"
-    ( _1 )
-# 53245 "parsing/parser.ml"
-                       in
-                      
-# 1488 "parsing/parser.mly"
+                      let _1 =
+                        let attrs = 
+# 4110 "parsing/parser.mly"
+    ( _1 )
+# 54610 "parsing/parser.ml"
+                         in
+                        
+# 1512 "parsing/parser.mly"
     ( mkstrexp e attrs )
-# 53250 "parsing/parser.ml"
+# 54615 "parsing/parser.ml"
+                        
+                      in
+                      let _startpos__1_ = _startpos_e_ in
+                      let _startpos = _startpos__1_ in
+                      
+# 988 "parsing/parser.mly"
+  ( text_str _startpos @ [_1] )
+# 54623 "parsing/parser.ml"
                       
                     in
                     let _startpos__1_ = _startpos_e_ in
+                    let _endpos = _endpos__1_ in
                     let _startpos = _startpos__1_ in
                     
-# 964 "parsing/parser.mly"
-  ( text_str _startpos @ [_1] )
-# 53258 "parsing/parser.ml"
+# 1007 "parsing/parser.mly"
+  ( mark_rhs_docs _startpos _endpos;
+    _1 )
+# 54633 "parsing/parser.ml"
                     
                   in
-                  let _startpos__1_ = _startpos_e_ in
-                  let _endpos = _endpos__1_ in
-                  let _startpos = _startpos__1_ in
                   
-# 983 "parsing/parser.mly"
-  ( mark_rhs_docs _startpos _endpos;
-    _1 )
-# 53268 "parsing/parser.ml"
+# 1056 "parsing/parser.mly"
+    ( x )
+# 54639 "parsing/parser.ml"
                   
                 in
                 
-# 1032 "parsing/parser.mly"
-    ( x )
-# 53274 "parsing/parser.ml"
+# 1505 "parsing/parser.mly"
+    ( items )
+# 54645 "parsing/parser.ml"
                 
               in
               
-# 1481 "parsing/parser.mly"
-    ( items )
-# 53280 "parsing/parser.ml"
+# 278 "<standard.mly>"
+    ( xs @ ys )
+# 54651 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
+            let _endpos = _endpos__1_ in
+            let _startpos = _startpos__1_ in
             
-# 267 "<standard.mly>"
-    ( xs @ ys )
-# 53286 "parsing/parser.ml"
+# 976 "parsing/parser.mly"
+                              ( extra_str _startpos _endpos _1 )
+# 54660 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
-          let _endpos = _endpos__1_ in
-          let _startpos = _startpos__1_ in
-          
-# 952 "parsing/parser.mly"
-                              ( extra_str _startpos _endpos _1 )
-# 53295 "parsing/parser.ml"
-          
-        in
-        
-# 1474 "parsing/parser.mly"
+          (
+# 1498 "parsing/parser.mly"
   ( _1 )
-# 53301 "parsing/parser.ml"
-         in
+# 54666 "parsing/parser.ml"
+           : (Parsetree.structure))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53319,14 +54685,16 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.structure_item) = let _endpos = _endpos__1_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 1503 "parsing/parser.mly"
+        let _v =
+          let _endpos = _endpos__1_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 1527 "parsing/parser.mly"
       ( val_of_let_bindings ~loc:_sloc _1 )
-# 53329 "parsing/parser.ml"
-         in
+# 54696 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53354,42 +54722,44 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.structure_item) = let _1 =
+        let _v =
           let _1 =
-            let _2 =
-              let _1 = _1_inlined1 in
-              
-# 4058 "parsing/parser.mly"
+            let _1 =
+              let _2 =
+                let _1 = _1_inlined1 in
+                
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 53365 "parsing/parser.ml"
+# 54734 "parsing/parser.ml"
+                
+              in
+              let _endpos__2_ = _endpos__1_inlined1_ in
+              let _endpos = _endpos__2_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1530 "parsing/parser.mly"
+        ( let docs = symbol_docs _sloc in
+          Pstr_extension (_1, add_docs_attrs docs _2) )
+# 54745 "parsing/parser.ml"
               
             in
-            let _endpos__2_ = _endpos__1_inlined1_ in
-            let _endpos = _endpos__2_ in
+            let _endpos__1_ = _endpos__1_inlined1_ in
+            let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 1506 "parsing/parser.mly"
-        ( let docs = symbol_docs _sloc in
-          Pstr_extension (_1, add_docs_attrs docs _2) )
-# 53376 "parsing/parser.ml"
+# 1023 "parsing/parser.mly"
+    ( mkstr ~loc:_sloc _1 )
+# 54755 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined1_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 999 "parsing/parser.mly"
-    ( mkstr ~loc:_sloc _1 )
-# 53386 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 53392 "parsing/parser.ml"
-         in
+# 54761 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53410,26 +54780,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.structure_item) = let _1 =
-          let _1 = 
-# 1509 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1533 "parsing/parser.mly"
         ( Pstr_attribute _1 )
-# 53418 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 999 "parsing/parser.mly"
+# 54789 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1023 "parsing/parser.mly"
     ( mkstr ~loc:_sloc _1 )
-# 53426 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+# 54797 "parsing/parser.ml"
+            
+          in
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 53432 "parsing/parser.ml"
-         in
+# 54803 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53450,26 +54822,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.structure_item) = let _1 =
-          let _1 = 
-# 1513 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1537 "parsing/parser.mly"
         ( pstr_primitive _1 )
-# 53458 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
+# 54831 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1040 "parsing/parser.mly"
     ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 53466 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+# 54839 "parsing/parser.ml"
+            
+          in
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 53472 "parsing/parser.ml"
-         in
+# 54845 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53490,26 +54864,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.structure_item) = let _1 =
-          let _1 = 
-# 1515 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1539 "parsing/parser.mly"
         ( pstr_primitive _1 )
-# 53498 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
+# 54873 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1040 "parsing/parser.mly"
     ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 53506 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+# 54881 "parsing/parser.ml"
+            
+          in
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 53512 "parsing/parser.ml"
-         in
+# 54887 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53538,48 +54914,50 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_a_ in
         let _endpos = _endpos_bs_ in
-        let _v : (Parsetree.structure_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
               let _1 =
-                let _1 = 
-# 1212 "parsing/parser.mly"
+                let _1 =
+                  let _1 = 
+# 1236 "parsing/parser.mly"
     ( let (x, b) = a in x, b :: bs )
-# 53549 "parsing/parser.ml"
-                 in
-                
-# 3093 "parsing/parser.mly"
+# 54926 "parsing/parser.ml"
+                   in
+                  
+# 3138 "parsing/parser.mly"
   ( _1 )
-# 53554 "parsing/parser.ml"
+# 54931 "parsing/parser.ml"
+                  
+                in
+                
+# 3121 "parsing/parser.mly"
+    ( _1 )
+# 54937 "parsing/parser.ml"
                 
               in
               
-# 3076 "parsing/parser.mly"
-    ( _1 )
-# 53560 "parsing/parser.ml"
+# 1541 "parsing/parser.mly"
+        ( pstr_type _1 )
+# 54943 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1517 "parsing/parser.mly"
-        ( pstr_type _1 )
-# 53566 "parsing/parser.ml"
+# 1040 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 54953 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
-    ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 53576 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 53582 "parsing/parser.ml"
-         in
+# 54959 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53656,87 +55034,89 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.structure_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
               let _1 =
-                let attrs2 =
-                  let _1 = _1_inlined3 in
-                  
-# 4058 "parsing/parser.mly"
+                let _1 =
+                  let attrs2 =
+                    let _1 = _1_inlined3 in
+                    
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 53669 "parsing/parser.ml"
-                  
-                in
-                let _endpos_attrs2_ = _endpos__1_inlined3_ in
-                let cs = 
-# 1204 "parsing/parser.mly"
+# 55048 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos_attrs2_ = _endpos__1_inlined3_ in
+                  let cs = 
+# 1228 "parsing/parser.mly"
     ( List.rev xs )
-# 53676 "parsing/parser.ml"
-                 in
-                let tid =
-                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-                  let _endpos = _endpos__1_ in
-                  let _symbolstartpos = _startpos__1_ in
-                  let _sloc = (_symbolstartpos, _endpos) in
-                  
-# 960 "parsing/parser.mly"
+# 55055 "parsing/parser.ml"
+                   in
+                  let tid =
+                    let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                    let _endpos = _endpos__1_ in
+                    let _symbolstartpos = _startpos__1_ in
+                    let _sloc = (_symbolstartpos, _endpos) in
+                    
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 53686 "parsing/parser.ml"
-                  
-                in
-                let _4 = 
-# 3903 "parsing/parser.mly"
+# 55065 "parsing/parser.ml"
+                    
+                  in
+                  let _4 = 
+# 3955 "parsing/parser.mly"
                 ( Recursive )
-# 53692 "parsing/parser.ml"
-                 in
-                let attrs1 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+# 55071 "parsing/parser.ml"
+                   in
+                  let attrs1 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 53699 "parsing/parser.ml"
+# 55078 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos_attrs2_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos_attrs2_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 3346 "parsing/parser.mly"
+# 3391 "parsing/parser.mly"
     ( let docs = symbol_docs _sloc in
       let attrs = attrs1 @ attrs2 in
       Te.mk tid cs ~params ~priv ~attrs ~docs,
       ext )
-# 53711 "parsing/parser.ml"
+# 55090 "parsing/parser.ml"
+                  
+                in
+                
+# 3374 "parsing/parser.mly"
+    ( _1 )
+# 55096 "parsing/parser.ml"
                 
               in
               
-# 3329 "parsing/parser.mly"
-    ( _1 )
-# 53717 "parsing/parser.ml"
+# 1543 "parsing/parser.mly"
+        ( pstr_typext _1 )
+# 55102 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1519 "parsing/parser.mly"
-        ( pstr_typext _1 )
-# 53723 "parsing/parser.ml"
+# 1040 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 55112 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
-    ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 53733 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 53739 "parsing/parser.ml"
-         in
+# 55118 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53820,93 +55200,95 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined4_ in
-        let _v : (Parsetree.structure_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
               let _1 =
-                let attrs2 =
-                  let _1 = _1_inlined4 in
-                  
-# 4058 "parsing/parser.mly"
+                let _1 =
+                  let attrs2 =
+                    let _1 = _1_inlined4 in
+                    
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 53833 "parsing/parser.ml"
-                  
-                in
-                let _endpos_attrs2_ = _endpos__1_inlined4_ in
-                let cs = 
-# 1204 "parsing/parser.mly"
+# 55214 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos_attrs2_ = _endpos__1_inlined4_ in
+                  let cs = 
+# 1228 "parsing/parser.mly"
     ( List.rev xs )
-# 53840 "parsing/parser.ml"
-                 in
-                let tid =
-                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
-                  let _endpos = _endpos__1_ in
-                  let _symbolstartpos = _startpos__1_ in
-                  let _sloc = (_symbolstartpos, _endpos) in
-                  
-# 960 "parsing/parser.mly"
+# 55221 "parsing/parser.ml"
+                   in
+                  let tid =
+                    let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
+                    let _endpos = _endpos__1_ in
+                    let _symbolstartpos = _startpos__1_ in
+                    let _sloc = (_symbolstartpos, _endpos) in
+                    
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 53850 "parsing/parser.ml"
-                  
-                in
-                let _4 =
-                  let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
-                  let _endpos = _endpos__1_ in
-                  let _startpos = _startpos__1_ in
-                  let _loc = (_startpos, _endpos) in
-                  
-# 3905 "parsing/parser.mly"
+# 55231 "parsing/parser.ml"
+                    
+                  in
+                  let _4 =
+                    let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
+                    let _endpos = _endpos__1_ in
+                    let _startpos = _startpos__1_ in
+                    let _loc = (_startpos, _endpos) in
+                    
+# 3957 "parsing/parser.mly"
                 ( not_expecting _loc "nonrec flag" )
-# 53861 "parsing/parser.ml"
-                  
-                in
-                let attrs1 =
-                  let _1 = _1_inlined1 in
-                  
-# 4062 "parsing/parser.mly"
+# 55242 "parsing/parser.ml"
+                    
+                  in
+                  let attrs1 =
+                    let _1 = _1_inlined1 in
+                    
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 53869 "parsing/parser.ml"
+# 55250 "parsing/parser.ml"
+                    
+                  in
+                  let _endpos = _endpos_attrs2_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
                   
-                in
-                let _endpos = _endpos_attrs2_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 3346 "parsing/parser.mly"
+# 3391 "parsing/parser.mly"
     ( let docs = symbol_docs _sloc in
       let attrs = attrs1 @ attrs2 in
       Te.mk tid cs ~params ~priv ~attrs ~docs,
       ext )
-# 53881 "parsing/parser.ml"
+# 55262 "parsing/parser.ml"
+                  
+                in
+                
+# 3374 "parsing/parser.mly"
+    ( _1 )
+# 55268 "parsing/parser.ml"
                 
               in
               
-# 3329 "parsing/parser.mly"
-    ( _1 )
-# 53887 "parsing/parser.ml"
+# 1543 "parsing/parser.mly"
+        ( pstr_typext _1 )
+# 55274 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined4_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1519 "parsing/parser.mly"
-        ( pstr_typext _1 )
-# 53893 "parsing/parser.ml"
+# 1040 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 55284 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined4_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
-    ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 53903 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 53909 "parsing/parser.ml"
-         in
+# 55290 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -53927,26 +55309,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.structure_item) = let _1 =
-          let _1 = 
-# 1521 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1545 "parsing/parser.mly"
         ( pstr_exception _1 )
-# 53935 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
+# 55318 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1040 "parsing/parser.mly"
     ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 53943 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+# 55326 "parsing/parser.ml"
+            
+          in
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 53949 "parsing/parser.ml"
-         in
+# 55332 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54002,71 +55386,73 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.structure_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let attrs2 =
-                let _1 = _1_inlined3 in
-                
-# 4058 "parsing/parser.mly"
+              let _1 =
+                let attrs2 =
+                  let _1 = _1_inlined3 in
+                  
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 54014 "parsing/parser.ml"
-                
-              in
-              let _endpos_attrs2_ = _endpos__1_inlined3_ in
-              let name =
-                let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-                let _endpos = _endpos__1_ in
-                let _symbolstartpos = _startpos__1_ in
-                let _sloc = (_symbolstartpos, _endpos) in
-                
-# 960 "parsing/parser.mly"
+# 55399 "parsing/parser.ml"
+                  
+                in
+                let _endpos_attrs2_ = _endpos__1_inlined3_ in
+                let name =
+                  let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                  let _endpos = _endpos__1_ in
+                  let _symbolstartpos = _startpos__1_ in
+                  let _sloc = (_symbolstartpos, _endpos) in
+                  
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 54026 "parsing/parser.ml"
-                
-              in
-              let attrs1 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+# 55411 "parsing/parser.ml"
+                  
+                in
+                let attrs1 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 54034 "parsing/parser.ml"
+# 55419 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos_attrs2_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos_attrs2_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 1547 "parsing/parser.mly"
+# 1571 "parsing/parser.mly"
     ( let docs = symbol_docs _sloc in
       let loc = make_loc _sloc in
       let attrs = attrs1 @ attrs2 in
       let body = Mb.mk name body ~attrs ~loc ~docs in
       Pstr_module body, ext )
-# 54047 "parsing/parser.ml"
+# 55432 "parsing/parser.ml"
+                
+              in
+              
+# 1547 "parsing/parser.mly"
+        ( _1 )
+# 55438 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined3_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1523 "parsing/parser.mly"
-        ( _1 )
-# 54053 "parsing/parser.ml"
+# 1040 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 55448 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined3_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
-    ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 54063 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 54069 "parsing/parser.ml"
-         in
+# 55454 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54136,44 +55522,45 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_bs_ in
-        let _v : (Parsetree.structure_item) = let _1 =
+        let _v =
           let _1 =
-            let _1 =
-              let _1 =
-                let a =
-                  let attrs2 =
-                    let _1 = _1_inlined3 in
-                    
-# 4058 "parsing/parser.mly"
+            let _1 =
+              let _1 =
+                let _1 =
+                  let a =
+                    let attrs2 =
+                      let _1 = _1_inlined3 in
+                      
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 54150 "parsing/parser.ml"
-                    
-                  in
-                  let _endpos_attrs2_ = _endpos__1_inlined3_ in
-                  let name =
-                    let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-                    let _endpos = _endpos__1_ in
-                    let _symbolstartpos = _startpos__1_ in
-                    let _sloc = (_symbolstartpos, _endpos) in
-                    
-# 960 "parsing/parser.mly"
+# 55537 "parsing/parser.ml"
+                      
+                    in
+                    let _endpos_attrs2_ = _endpos__1_inlined3_ in
+                    let name =
+                      let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                      let _endpos = _endpos__1_ in
+                      let _symbolstartpos = _startpos__1_ in
+                      let _sloc = (_symbolstartpos, _endpos) in
+                      
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 54162 "parsing/parser.ml"
-                    
-                  in
-                  let attrs1 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+# 55549 "parsing/parser.ml"
+                      
+                    in
+                    let attrs1 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 54170 "parsing/parser.ml"
+# 55557 "parsing/parser.ml"
+                      
+                    in
+                    let _endpos = _endpos_attrs2_ in
+                    let _symbolstartpos = _startpos__1_ in
+                    let _sloc = (_symbolstartpos, _endpos) in
                     
-                  in
-                  let _endpos = _endpos_attrs2_ in
-                  let _symbolstartpos = _startpos__1_ in
-                  let _sloc = (_symbolstartpos, _endpos) in
-                  
-# 1584 "parsing/parser.mly"
+# 1608 "parsing/parser.mly"
   (
     let loc = make_loc _sloc in
     let attrs = attrs1 @ attrs2 in
@@ -54181,42 +55568,43 @@ module Tables = struct
     ext,
     Mb.mk name body ~attrs ~loc ~docs
   )
-# 54185 "parsing/parser.ml"
+# 55572 "parsing/parser.ml"
+                    
+                  in
+                  
+# 1236 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 55578 "parsing/parser.ml"
                   
                 in
                 
-# 1212 "parsing/parser.mly"
-    ( let (x, b) = a in x, b :: bs )
-# 54191 "parsing/parser.ml"
+# 1596 "parsing/parser.mly"
+    ( _1 )
+# 55584 "parsing/parser.ml"
                 
               in
               
-# 1572 "parsing/parser.mly"
-    ( _1 )
-# 54197 "parsing/parser.ml"
+# 1549 "parsing/parser.mly"
+        ( pstr_recmodule _1 )
+# 55590 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos_bs_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1525 "parsing/parser.mly"
-        ( pstr_recmodule _1 )
-# 54203 "parsing/parser.ml"
+# 1040 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 55600 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_bs_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
-    ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 54213 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 54219 "parsing/parser.ml"
-         in
+# 55606 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54237,26 +55625,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.structure_item) = let _1 =
-          let _1 = 
-# 1527 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1551 "parsing/parser.mly"
         ( let (body, ext) = _1 in (Pstr_modtype body, ext) )
-# 54245 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
+# 55634 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1040 "parsing/parser.mly"
     ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 54253 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+# 55642 "parsing/parser.ml"
+            
+          in
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 54259 "parsing/parser.ml"
-         in
+# 55648 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54277,26 +55667,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.structure_item) = let _1 =
-          let _1 = 
-# 1529 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1553 "parsing/parser.mly"
         ( let (body, ext) = _1 in (Pstr_open body, ext) )
-# 54285 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
+# 55676 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1040 "parsing/parser.mly"
     ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 54293 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+# 55684 "parsing/parser.ml"
+            
+          in
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 54299 "parsing/parser.ml"
-         in
+# 55690 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54365,9 +55757,9 @@ module Tables = struct
         let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
         let body : (Parsetree.class_expr) = Obj.magic body in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 54371 "parsing/parser.ml"
+# 55763 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
         let virt : (Asttypes.virtual_flag) = Obj.magic virt in
@@ -54377,44 +55769,45 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_bs_ in
-        let _v : (Parsetree.structure_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
               let _1 =
-                let a =
-                  let attrs2 =
-                    let _1 = _1_inlined3 in
-                    
-# 4058 "parsing/parser.mly"
+                let _1 =
+                  let a =
+                    let attrs2 =
+                      let _1 = _1_inlined3 in
+                      
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 54391 "parsing/parser.ml"
-                    
-                  in
-                  let _endpos_attrs2_ = _endpos__1_inlined3_ in
-                  let id =
-                    let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-                    let _endpos = _endpos__1_ in
-                    let _symbolstartpos = _startpos__1_ in
-                    let _sloc = (_symbolstartpos, _endpos) in
-                    
-# 960 "parsing/parser.mly"
+# 55784 "parsing/parser.ml"
+                      
+                    in
+                    let _endpos_attrs2_ = _endpos__1_inlined3_ in
+                    let id =
+                      let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+                      let _endpos = _endpos__1_ in
+                      let _symbolstartpos = _startpos__1_ in
+                      let _sloc = (_symbolstartpos, _endpos) in
+                      
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 54403 "parsing/parser.ml"
-                    
-                  in
-                  let attrs1 =
-                    let _1 = _1_inlined1 in
-                    
-# 4062 "parsing/parser.mly"
+# 55796 "parsing/parser.ml"
+                      
+                    in
+                    let attrs1 =
+                      let _1 = _1_inlined1 in
+                      
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 54411 "parsing/parser.ml"
+# 55804 "parsing/parser.ml"
+                      
+                    in
+                    let _endpos = _endpos_attrs2_ in
+                    let _symbolstartpos = _startpos__1_ in
+                    let _sloc = (_symbolstartpos, _endpos) in
                     
-                  in
-                  let _endpos = _endpos_attrs2_ in
-                  let _symbolstartpos = _startpos__1_ in
-                  let _sloc = (_symbolstartpos, _endpos) in
-                  
-# 1928 "parsing/parser.mly"
+# 1950 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
@@ -54422,42 +55815,43 @@ module Tables = struct
     ext,
     Ci.mk id body ~virt ~params ~attrs ~loc ~docs
   )
-# 54426 "parsing/parser.ml"
+# 55819 "parsing/parser.ml"
+                    
+                  in
+                  
+# 1236 "parsing/parser.mly"
+    ( let (x, b) = a in x, b :: bs )
+# 55825 "parsing/parser.ml"
                   
                 in
                 
-# 1212 "parsing/parser.mly"
-    ( let (x, b) = a in x, b :: bs )
-# 54432 "parsing/parser.ml"
+# 1939 "parsing/parser.mly"
+    ( _1 )
+# 55831 "parsing/parser.ml"
                 
               in
               
-# 1917 "parsing/parser.mly"
-    ( _1 )
-# 54438 "parsing/parser.ml"
+# 1555 "parsing/parser.mly"
+        ( let (ext, l) = _1 in (Pstr_class l, ext) )
+# 55837 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos_bs_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1531 "parsing/parser.mly"
-        ( let (ext, l) = _1 in (Pstr_class l, ext) )
-# 54444 "parsing/parser.ml"
+# 1040 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 55847 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos_bs_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
-    ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 54454 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 54460 "parsing/parser.ml"
-         in
+# 55853 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54478,26 +55872,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.structure_item) = let _1 =
-          let _1 = 
-# 1533 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 1557 "parsing/parser.mly"
         ( let (ext, l) = _1 in (Pstr_class_type l, ext) )
-# 54486 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
+# 55881 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1040 "parsing/parser.mly"
     ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 54494 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+# 55889 "parsing/parser.ml"
+            
+          in
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 54500 "parsing/parser.ml"
-         in
+# 55895 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54546,61 +55942,63 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.structure_item) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let attrs2 =
-                let _1 = _1_inlined2 in
-                
-# 4058 "parsing/parser.mly"
+              let _1 =
+                let attrs2 =
+                  let _1 = _1_inlined2 in
+                  
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 54558 "parsing/parser.ml"
-                
-              in
-              let _endpos_attrs2_ = _endpos__1_inlined2_ in
-              let attrs1 =
-                let _1 = _1_inlined1 in
-                
-# 4062 "parsing/parser.mly"
+# 55955 "parsing/parser.ml"
+                  
+                in
+                let _endpos_attrs2_ = _endpos__1_inlined2_ in
+                let attrs1 =
+                  let _1 = _1_inlined1 in
+                  
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 54567 "parsing/parser.ml"
+# 55964 "parsing/parser.ml"
+                  
+                in
+                let _endpos = _endpos_attrs2_ in
+                let _symbolstartpos = _startpos__1_ in
+                let _sloc = (_symbolstartpos, _endpos) in
                 
-              in
-              let _endpos = _endpos_attrs2_ in
-              let _symbolstartpos = _startpos__1_ in
-              let _sloc = (_symbolstartpos, _endpos) in
-              
-# 1621 "parsing/parser.mly"
+# 1645 "parsing/parser.mly"
   (
     let attrs = attrs1 @ attrs2 in
     let loc = make_loc _sloc in
     let docs = symbol_docs _sloc in
     Incl.mk thing ~attrs ~loc ~docs, ext
   )
-# 54581 "parsing/parser.ml"
+# 55978 "parsing/parser.ml"
+                
+              in
+              
+# 1559 "parsing/parser.mly"
+        ( pstr_include _1 )
+# 55984 "parsing/parser.ml"
               
             in
+            let _endpos__1_ = _endpos__1_inlined2_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 1535 "parsing/parser.mly"
-        ( pstr_include _1 )
-# 54587 "parsing/parser.ml"
+# 1040 "parsing/parser.mly"
+    ( wrap_mkstr_ext ~loc:_sloc _1 )
+# 55994 "parsing/parser.ml"
             
           in
-          let _endpos__1_ = _endpos__1_inlined2_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 1016 "parsing/parser.mly"
-    ( wrap_mkstr_ext ~loc:_sloc _1 )
-# 54597 "parsing/parser.ml"
-          
-        in
-        
-# 1537 "parsing/parser.mly"
+          (
+# 1561 "parsing/parser.mly"
     ( _1 )
-# 54603 "parsing/parser.ml"
-         in
+# 56000 "parsing/parser.ml"
+           : (Parsetree.structure_item))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54622,9 +56020,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3968 "parsing/parser.mly"
+# 4020 "parsing/parser.mly"
                                                 ( "-" )
-# 54628 "parsing/parser.ml"
+# 56026 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -54647,9 +56045,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (string) = 
-# 3969 "parsing/parser.mly"
+# 4021 "parsing/parser.mly"
                                                 ( "-." )
-# 54653 "parsing/parser.ml"
+# 56051 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -54699,54 +56097,56 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.row_field) = let _5 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _5 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 54708 "parsing/parser.ml"
-          
-        in
-        let _endpos__5_ = _endpos__1_inlined1_ in
-        let _4 =
-          let _1 =
-            let xs = 
-# 253 "<standard.mly>"
-    ( List.rev xs )
-# 54717 "parsing/parser.ml"
-             in
+# 56107 "parsing/parser.ml"
             
-# 1115 "parsing/parser.mly"
+          in
+          let _endpos__5_ = _endpos__1_inlined1_ in
+          let _4 =
+            let _1 =
+              let xs = 
+# 264 "<standard.mly>"
+    ( List.rev xs )
+# 56116 "parsing/parser.ml"
+               in
+              
+# 1139 "parsing/parser.mly"
     ( xs )
-# 54722 "parsing/parser.ml"
+# 56121 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3676 "parsing/parser.mly"
+# 3721 "parsing/parser.mly"
     ( _1 )
-# 54728 "parsing/parser.ml"
-          
-        in
-        let _1 =
-          let _endpos = _endpos__1_ in
+# 56127 "parsing/parser.ml"
+            
+          in
+          let _1 =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 56137 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 54738 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3662 "parsing/parser.mly"
+          (
+# 3707 "parsing/parser.mly"
       ( let info = symbol_info _endpos in
         let attrs = add_info_attrs info _5 in
         Rf.tag ~loc:(make_loc _sloc) ~attrs _1 _3 _4 )
-# 54749 "parsing/parser.ml"
-         in
+# 56148 "parsing/parser.ml"
+           : (Parsetree.row_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54774,35 +56174,37 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.row_field) = let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+        let _v =
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 54783 "parsing/parser.ml"
-          
-        in
-        let _endpos__2_ = _endpos__1_inlined1_ in
-        let _1 =
-          let _endpos = _endpos__1_ in
+# 56184 "parsing/parser.ml"
+            
+          in
+          let _endpos__2_ = _endpos__1_inlined1_ in
+          let _1 =
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 56195 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__2_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 54794 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3666 "parsing/parser.mly"
+          (
+# 3711 "parsing/parser.mly"
       ( let info = symbol_info _endpos in
         let attrs = add_info_attrs info _2 in
         Rf.tag ~loc:(make_loc _sloc) ~attrs _1 true [] )
-# 54805 "parsing/parser.ml"
-         in
+# 56206 "parsing/parser.ml"
+           : (Parsetree.row_field))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54830,31 +56232,33 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined1_ in
-        let _v : (Parsetree.toplevel_phrase) = let arg = 
-# 124 "<standard.mly>"
+        let _v =
+          let arg = 
+# 123 "<standard.mly>"
     ( None )
-# 54837 "parsing/parser.ml"
-         in
-        let _endpos_arg_ = _endpos__1_inlined1_ in
-        let dir =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+# 56240 "parsing/parser.ml"
+           in
+          let _endpos_arg_ = _endpos__1_inlined1_ in
+          let dir =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 56251 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_arg_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 54848 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_arg_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3866 "parsing/parser.mly"
+          (
+# 3918 "parsing/parser.mly"
     ( mk_directive ~loc:_sloc dir arg )
-# 54857 "parsing/parser.ml"
-         in
+# 56260 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54884,58 +56288,60 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _1_inlined2 : (
-# 816 "parsing/parser.mly"
+# 835 "parsing/parser.mly"
        (string * Location.t * string option)
-# 54890 "parsing/parser.ml"
+# 56294 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.toplevel_phrase) = let arg =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let x =
-            let _1 = 
-# 3870 "parsing/parser.mly"
+        let _v =
+          let arg =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let x =
+              let _1 = 
+# 3922 "parsing/parser.mly"
                   ( let (s, _, _) = _1 in Pdir_string s )
-# 54903 "parsing/parser.ml"
-             in
+# 56308 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1045 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 56316 "parsing/parser.ml"
+              
+            in
+            
+# 126 "<standard.mly>"
+    ( Some x )
+# 56322 "parsing/parser.ml"
+            
+          in
+          let _endpos_arg_ = _endpos__1_inlined2_ in
+          let dir =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
             let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 1021 "parsing/parser.mly"
-    ( mk_directive_arg ~loc:_sloc _1 )
-# 54911 "parsing/parser.ml"
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 56334 "parsing/parser.ml"
             
           in
-          
-# 126 "<standard.mly>"
-    ( Some x )
-# 54917 "parsing/parser.ml"
-          
-        in
-        let _endpos_arg_ = _endpos__1_inlined2_ in
-        let dir =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+          let _endpos = _endpos_arg_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 54929 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_arg_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3866 "parsing/parser.mly"
+          (
+# 3918 "parsing/parser.mly"
     ( mk_directive ~loc:_sloc dir arg )
-# 54938 "parsing/parser.ml"
-         in
+# 56343 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -54965,58 +56371,60 @@ module Tables = struct
           };
         } = _menhir_stack in
         let _1_inlined2 : (
-# 764 "parsing/parser.mly"
+# 783 "parsing/parser.mly"
        (string * char option)
-# 54971 "parsing/parser.ml"
+# 56377 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in
         let _1 : unit = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.toplevel_phrase) = let arg =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let x =
-            let _1 = 
-# 3871 "parsing/parser.mly"
+        let _v =
+          let arg =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let x =
+              let _1 = 
+# 3923 "parsing/parser.mly"
                   ( let (n, m) = _1 in Pdir_int (n ,m) )
-# 54984 "parsing/parser.ml"
-             in
+# 56391 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1045 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 56399 "parsing/parser.ml"
+              
+            in
+            
+# 126 "<standard.mly>"
+    ( Some x )
+# 56405 "parsing/parser.ml"
+            
+          in
+          let _endpos_arg_ = _endpos__1_inlined2_ in
+          let dir =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
             let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 1021 "parsing/parser.mly"
-    ( mk_directive_arg ~loc:_sloc _1 )
-# 54992 "parsing/parser.ml"
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 56417 "parsing/parser.ml"
             
           in
-          
-# 126 "<standard.mly>"
-    ( Some x )
-# 54998 "parsing/parser.ml"
-          
-        in
-        let _endpos_arg_ = _endpos__1_inlined2_ in
-        let dir =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+          let _endpos = _endpos_arg_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 55010 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_arg_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3866 "parsing/parser.mly"
+          (
+# 3918 "parsing/parser.mly"
     ( mk_directive ~loc:_sloc dir arg )
-# 55019 "parsing/parser.ml"
-         in
+# 56426 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -55051,49 +56459,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.toplevel_phrase) = let arg =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let x =
-            let _1 = 
-# 3872 "parsing/parser.mly"
+        let _v =
+          let arg =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let x =
+              let _1 = 
+# 3924 "parsing/parser.mly"
                   ( Pdir_ident _1 )
-# 55061 "parsing/parser.ml"
-             in
+# 56470 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1045 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 56478 "parsing/parser.ml"
+              
+            in
+            
+# 126 "<standard.mly>"
+    ( Some x )
+# 56484 "parsing/parser.ml"
+            
+          in
+          let _endpos_arg_ = _endpos__1_inlined2_ in
+          let dir =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
             let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 1021 "parsing/parser.mly"
-    ( mk_directive_arg ~loc:_sloc _1 )
-# 55069 "parsing/parser.ml"
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 56496 "parsing/parser.ml"
             
           in
-          
-# 126 "<standard.mly>"
-    ( Some x )
-# 55075 "parsing/parser.ml"
-          
-        in
-        let _endpos_arg_ = _endpos__1_inlined2_ in
-        let dir =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+          let _endpos = _endpos_arg_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 55087 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_arg_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3866 "parsing/parser.mly"
+          (
+# 3918 "parsing/parser.mly"
     ( mk_directive ~loc:_sloc dir arg )
-# 55096 "parsing/parser.ml"
-         in
+# 56505 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -55128,49 +56538,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.toplevel_phrase) = let arg =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let x =
-            let _1 = 
-# 3873 "parsing/parser.mly"
+        let _v =
+          let arg =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let x =
+              let _1 = 
+# 3925 "parsing/parser.mly"
                   ( Pdir_ident _1 )
-# 55138 "parsing/parser.ml"
-             in
+# 56549 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1045 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 56557 "parsing/parser.ml"
+              
+            in
+            
+# 126 "<standard.mly>"
+    ( Some x )
+# 56563 "parsing/parser.ml"
+            
+          in
+          let _endpos_arg_ = _endpos__1_inlined2_ in
+          let dir =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
             let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 1021 "parsing/parser.mly"
-    ( mk_directive_arg ~loc:_sloc _1 )
-# 55146 "parsing/parser.ml"
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 56575 "parsing/parser.ml"
             
           in
-          
-# 126 "<standard.mly>"
-    ( Some x )
-# 55152 "parsing/parser.ml"
-          
-        in
-        let _endpos_arg_ = _endpos__1_inlined2_ in
-        let dir =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+          let _endpos = _endpos_arg_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 55164 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_arg_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3866 "parsing/parser.mly"
+          (
+# 3918 "parsing/parser.mly"
     ( mk_directive ~loc:_sloc dir arg )
-# 55173 "parsing/parser.ml"
-         in
+# 56584 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -55205,49 +56617,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.toplevel_phrase) = let arg =
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
-          let x =
-            let _1 = 
-# 3874 "parsing/parser.mly"
+        let _v =
+          let arg =
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
+            let x =
+              let _1 = 
+# 3926 "parsing/parser.mly"
                   ( Pdir_bool false )
-# 55215 "parsing/parser.ml"
-             in
+# 56628 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1045 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 56636 "parsing/parser.ml"
+              
+            in
+            
+# 126 "<standard.mly>"
+    ( Some x )
+# 56642 "parsing/parser.ml"
+            
+          in
+          let _endpos_arg_ = _endpos__1_inlined2_ in
+          let dir =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
             let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 1021 "parsing/parser.mly"
-    ( mk_directive_arg ~loc:_sloc _1 )
-# 55223 "parsing/parser.ml"
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 56654 "parsing/parser.ml"
             
           in
-          
-# 126 "<standard.mly>"
-    ( Some x )
-# 55229 "parsing/parser.ml"
-          
-        in
-        let _endpos_arg_ = _endpos__1_inlined2_ in
-        let dir =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+          let _endpos = _endpos_arg_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 55241 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_arg_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3866 "parsing/parser.mly"
+          (
+# 3918 "parsing/parser.mly"
     ( mk_directive ~loc:_sloc dir arg )
-# 55250 "parsing/parser.ml"
-         in
+# 56663 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -55282,49 +56696,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.toplevel_phrase) = let arg =
-          let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
-          let x =
-            let _1 = 
-# 3875 "parsing/parser.mly"
+        let _v =
+          let arg =
+            let (_endpos__1_, _startpos__1_) = (_endpos__1_inlined2_, _startpos__1_inlined2_) in
+            let x =
+              let _1 = 
+# 3927 "parsing/parser.mly"
                   ( Pdir_bool true )
-# 55292 "parsing/parser.ml"
-             in
+# 56707 "parsing/parser.ml"
+               in
+              let _endpos = _endpos__1_ in
+              let _symbolstartpos = _startpos__1_ in
+              let _sloc = (_symbolstartpos, _endpos) in
+              
+# 1045 "parsing/parser.mly"
+    ( mk_directive_arg ~loc:_sloc _1 )
+# 56715 "parsing/parser.ml"
+              
+            in
+            
+# 126 "<standard.mly>"
+    ( Some x )
+# 56721 "parsing/parser.ml"
+            
+          in
+          let _endpos_arg_ = _endpos__1_inlined2_ in
+          let dir =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
             let _endpos = _endpos__1_ in
             let _symbolstartpos = _startpos__1_ in
             let _sloc = (_symbolstartpos, _endpos) in
             
-# 1021 "parsing/parser.mly"
-    ( mk_directive_arg ~loc:_sloc _1 )
-# 55300 "parsing/parser.ml"
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 56733 "parsing/parser.ml"
             
           in
-          
-# 126 "<standard.mly>"
-    ( Some x )
-# 55306 "parsing/parser.ml"
-          
-        in
-        let _endpos_arg_ = _endpos__1_inlined2_ in
-        let dir =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+          let _endpos = _endpos_arg_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 55318 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_arg_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3866 "parsing/parser.mly"
+          (
+# 3918 "parsing/parser.mly"
     ( mk_directive ~loc:_sloc dir arg )
-# 55327 "parsing/parser.ml"
-         in
+# 56742 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -55359,42 +56775,44 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.toplevel_phrase) = let _1 =
+        let _v =
           let _1 =
             let _1 =
-              let attrs = 
-# 4058 "parsing/parser.mly"
+              let _1 =
+                let attrs = 
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 55369 "parsing/parser.ml"
-               in
-              
-# 1488 "parsing/parser.mly"
+# 56786 "parsing/parser.ml"
+                 in
+                
+# 1512 "parsing/parser.mly"
     ( mkstrexp e attrs )
-# 55374 "parsing/parser.ml"
+# 56791 "parsing/parser.ml"
+                
+              in
+              let _startpos__1_ = _startpos_e_ in
+              let _startpos = _startpos__1_ in
+              
+# 988 "parsing/parser.mly"
+  ( text_str _startpos @ [_1] )
+# 56799 "parsing/parser.ml"
               
             in
             let _startpos__1_ = _startpos_e_ in
+            let _endpos = _endpos__1_ in
             let _startpos = _startpos__1_ in
             
-# 964 "parsing/parser.mly"
-  ( text_str _startpos @ [_1] )
-# 55382 "parsing/parser.ml"
+# 976 "parsing/parser.mly"
+                              ( extra_str _startpos _endpos _1 )
+# 56808 "parsing/parser.ml"
             
           in
-          let _startpos__1_ = _startpos_e_ in
-          let _endpos = _endpos__1_ in
-          let _startpos = _startpos__1_ in
-          
-# 952 "parsing/parser.mly"
-                              ( extra_str _startpos _endpos _1 )
-# 55391 "parsing/parser.ml"
-          
-        in
-        
-# 1252 "parsing/parser.mly"
+          (
+# 1276 "parsing/parser.mly"
     ( Ptop_def _1 )
-# 55397 "parsing/parser.ml"
-         in
+# 56814 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -55422,26 +56840,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xss_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.toplevel_phrase) = let _1 =
-          let _1 = 
-# 260 "<standard.mly>"
+        let _v =
+          let _1 =
+            let _1 = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 55430 "parsing/parser.ml"
-           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
-          let _endpos = _endpos__1_ in
-          let _startpos = _startpos__1_ in
-          
-# 952 "parsing/parser.mly"
+# 56849 "parsing/parser.ml"
+             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+            let _endpos = _endpos__1_ in
+            let _startpos = _startpos__1_ in
+            
+# 976 "parsing/parser.mly"
                               ( extra_str _startpos _endpos _1 )
-# 55438 "parsing/parser.ml"
-          
-        in
-        
-# 1256 "parsing/parser.mly"
+# 56857 "parsing/parser.ml"
+            
+          in
+          (
+# 1280 "parsing/parser.mly"
     ( Ptop_def _1 )
-# 55444 "parsing/parser.ml"
-         in
+# 56863 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -55470,9 +56890,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.toplevel_phrase) = 
-# 1260 "parsing/parser.mly"
+# 1284 "parsing/parser.mly"
     ( _1 )
-# 55476 "parsing/parser.ml"
+# 56896 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55495,9 +56915,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Parsetree.toplevel_phrase) = 
-# 1263 "parsing/parser.mly"
+# 1287 "parsing/parser.mly"
     ( raise End_of_file )
-# 55501 "parsing/parser.ml"
+# 56921 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55520,9 +56940,9 @@ module Tables = struct
         let _startpos = _startpos_ty_ in
         let _endpos = _endpos_ty_ in
         let _v : (Parsetree.core_type) = 
-# 3512 "parsing/parser.mly"
+# 3557 "parsing/parser.mly"
       ( ty )
-# 55526 "parsing/parser.ml"
+# 56946 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55544,41 +56964,43 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xs_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.core_type) = let _1 =
+        let _v =
           let _1 =
-            let tys =
-              let xs = 
-# 253 "<standard.mly>"
+            let _1 =
+              let tys =
+                let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 55554 "parsing/parser.ml"
-               in
-              
-# 1143 "parsing/parser.mly"
+# 56975 "parsing/parser.ml"
+                 in
+                
+# 1167 "parsing/parser.mly"
     ( xs )
-# 55559 "parsing/parser.ml"
+# 56980 "parsing/parser.ml"
+                
+              in
+              
+# 3560 "parsing/parser.mly"
+        ( Ptyp_tuple tys )
+# 56986 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
             
-# 3515 "parsing/parser.mly"
-        ( Ptyp_tuple tys )
-# 55565 "parsing/parser.ml"
+# 1021 "parsing/parser.mly"
+    ( mktyp ~loc:_sloc _1 )
+# 56996 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
-    ( mktyp ~loc:_sloc _1 )
-# 55575 "parsing/parser.ml"
-          
-        in
-        
-# 3517 "parsing/parser.mly"
+          (
+# 3562 "parsing/parser.mly"
     ( _1 )
-# 55581 "parsing/parser.ml"
-         in
+# 57002 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -55607,9 +57029,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.type_constraint) = 
-# 2834 "parsing/parser.mly"
+# 2876 "parsing/parser.mly"
                                                 ( Pconstraint _2 )
-# 55613 "parsing/parser.ml"
+# 57035 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55653,9 +57075,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__4_ in
         let _v : (Parsetree.type_constraint) = 
-# 2835 "parsing/parser.mly"
+# 2877 "parsing/parser.mly"
                                                 ( Pcoerce (Some _2, _4) )
-# 55659 "parsing/parser.ml"
+# 57081 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55685,9 +57107,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.type_constraint) = 
-# 2836 "parsing/parser.mly"
+# 2878 "parsing/parser.mly"
                                                 ( Pcoerce (None, _2) )
-# 55691 "parsing/parser.ml"
+# 57113 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55717,9 +57139,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.type_constraint) = 
-# 2837 "parsing/parser.mly"
+# 2879 "parsing/parser.mly"
                                                 ( syntax_error() )
-# 55723 "parsing/parser.ml"
+# 57145 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55749,9 +57171,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.type_constraint) = 
-# 2838 "parsing/parser.mly"
+# 2880 "parsing/parser.mly"
                                                 ( syntax_error() )
-# 55755 "parsing/parser.ml"
+# 57177 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55767,9 +57189,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = 
-# 3167 "parsing/parser.mly"
+# 3212 "parsing/parser.mly"
       ( (Ptype_abstract, Public, None) )
-# 55773 "parsing/parser.ml"
+# 57195 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55799,9 +57221,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = 
-# 3169 "parsing/parser.mly"
+# 3214 "parsing/parser.mly"
       ( _2 )
-# 55805 "parsing/parser.ml"
+# 57227 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55824,9 +57246,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3827 "parsing/parser.mly"
+# 3879 "parsing/parser.mly"
                                              ( _1 )
-# 55830 "parsing/parser.ml"
+# 57252 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55856,9 +57278,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) = 
-# 3184 "parsing/parser.mly"
+# 3229 "parsing/parser.mly"
                                        ( _2, _1 )
-# 55862 "parsing/parser.ml"
+# 57284 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55874,9 +57296,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = 
-# 3177 "parsing/parser.mly"
+# 3222 "parsing/parser.mly"
       ( [] )
-# 55880 "parsing/parser.ml"
+# 57302 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55899,9 +57321,9 @@ module Tables = struct
         let _startpos = _startpos_p_ in
         let _endpos = _endpos_p_ in
         let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = 
-# 3179 "parsing/parser.mly"
+# 3224 "parsing/parser.mly"
       ( [p] )
-# 55905 "parsing/parser.ml"
+# 57327 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -55937,23 +57359,25 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let ps =
-          let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let ps =
+            let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 55945 "parsing/parser.ml"
-           in
-          
-# 1115 "parsing/parser.mly"
+# 57368 "parsing/parser.ml"
+             in
+            
+# 1139 "parsing/parser.mly"
     ( xs )
-# 55950 "parsing/parser.ml"
-          
-        in
-        
-# 3181 "parsing/parser.mly"
+# 57373 "parsing/parser.ml"
+            
+          in
+          (
+# 3226 "parsing/parser.mly"
       ( ps )
-# 55956 "parsing/parser.ml"
-         in
+# 57379 "parsing/parser.ml"
+           : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -55981,27 +57405,29 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_tyvar_ in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 = 
-# 3189 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3234 "parsing/parser.mly"
       ( Ptyp_var tyvar )
-# 55989 "parsing/parser.ml"
-           in
-          let _endpos__1_ = _endpos_tyvar_ in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 57414 "parsing/parser.ml"
+             in
+            let _endpos__1_ = _endpos_tyvar_ in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 55998 "parsing/parser.ml"
-          
-        in
-        
-# 3192 "parsing/parser.mly"
+# 57423 "parsing/parser.ml"
+            
+          in
+          (
+# 3237 "parsing/parser.mly"
     ( _1 )
-# 56004 "parsing/parser.ml"
-         in
+# 57429 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56022,26 +57448,28 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Parsetree.core_type) = let _1 =
-          let _1 = 
-# 3191 "parsing/parser.mly"
+        let _v =
+          let _1 =
+            let _1 = 
+# 3236 "parsing/parser.mly"
       ( Ptyp_any )
-# 56030 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 997 "parsing/parser.mly"
+# 57457 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 1021 "parsing/parser.mly"
     ( mktyp ~loc:_sloc _1 )
-# 56038 "parsing/parser.ml"
-          
-        in
-        
-# 3192 "parsing/parser.mly"
+# 57465 "parsing/parser.ml"
+            
+          in
+          (
+# 3237 "parsing/parser.mly"
     ( _1 )
-# 56044 "parsing/parser.ml"
-         in
+# 57471 "parsing/parser.ml"
+           : (Parsetree.core_type))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56056,9 +57484,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Asttypes.variance * Asttypes.injectivity) = 
-# 3196 "parsing/parser.mly"
+# 3241 "parsing/parser.mly"
                                             ( NoVariance, NoInjectivity )
-# 56062 "parsing/parser.ml"
+# 57490 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56081,9 +57509,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.variance * Asttypes.injectivity) = 
-# 3197 "parsing/parser.mly"
+# 3242 "parsing/parser.mly"
                                             ( Covariant, NoInjectivity )
-# 56087 "parsing/parser.ml"
+# 57515 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56106,9 +57534,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.variance * Asttypes.injectivity) = 
-# 3198 "parsing/parser.mly"
+# 3243 "parsing/parser.mly"
                                             ( Contravariant, NoInjectivity )
-# 56112 "parsing/parser.ml"
+# 57540 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56131,9 +57559,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.variance * Asttypes.injectivity) = 
-# 3199 "parsing/parser.mly"
+# 3244 "parsing/parser.mly"
                                             ( NoVariance, Injective )
-# 56137 "parsing/parser.ml"
+# 57565 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56163,9 +57591,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.variance * Asttypes.injectivity) = 
-# 3200 "parsing/parser.mly"
+# 3245 "parsing/parser.mly"
                                             ( Covariant, Injective )
-# 56169 "parsing/parser.ml"
+# 57597 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56195,9 +57623,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.variance * Asttypes.injectivity) = 
-# 3200 "parsing/parser.mly"
+# 3245 "parsing/parser.mly"
                                             ( Covariant, Injective )
-# 56201 "parsing/parser.ml"
+# 57629 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56227,9 +57655,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.variance * Asttypes.injectivity) = 
-# 3201 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
                                             ( Contravariant, Injective )
-# 56233 "parsing/parser.ml"
+# 57661 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56259,9 +57687,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.variance * Asttypes.injectivity) = 
-# 3201 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
                                             ( Contravariant, Injective )
-# 56265 "parsing/parser.ml"
+# 57693 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56280,21 +57708,23 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 756 "parsing/parser.mly"
+# 775 "parsing/parser.mly"
        (string)
-# 56286 "parsing/parser.ml"
+# 57714 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 3203 "parsing/parser.mly"
+        let _v =
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 3248 "parsing/parser.mly"
       ( if _1 = "+!" then Covariant, Injective else
         if _1 = "-!" then Contravariant, Injective else
         expecting _loc__1_ "type_variance" )
-# 56297 "parsing/parser.ml"
-         in
+# 57726 "parsing/parser.ml"
+           : (Asttypes.variance * Asttypes.injectivity))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56312,21 +57742,23 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 802 "parsing/parser.mly"
+# 821 "parsing/parser.mly"
        (string)
-# 56318 "parsing/parser.ml"
+# 57748 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
-        let _v : (Asttypes.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 3207 "parsing/parser.mly"
+        let _v =
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 3252 "parsing/parser.mly"
       ( if _1 = "!+" then Covariant, Injective else
         if _1 = "!-" then Contravariant, Injective else
         expecting _loc__1_ "type_variance" )
-# 56329 "parsing/parser.ml"
-         in
+# 57760 "parsing/parser.ml"
+           : (Asttypes.variance * Asttypes.injectivity))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56354,45 +57786,47 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_xss_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.toplevel_phrase list) = let _1 =
+        let _v =
           let _1 =
-            let ys = 
-# 260 "<standard.mly>"
+            let _1 =
+              let ys = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 56363 "parsing/parser.ml"
-             in
-            let xs =
-              let _1 = 
-# 1030 "parsing/parser.mly"
-    ( [] )
-# 56369 "parsing/parser.ml"
+# 57796 "parsing/parser.ml"
                in
-              
-# 1283 "parsing/parser.mly"
+              let xs =
+                let _1 = 
+# 1054 "parsing/parser.mly"
+    ( [] )
+# 57802 "parsing/parser.ml"
+                 in
+                
+# 1307 "parsing/parser.mly"
     ( _1 )
-# 56374 "parsing/parser.ml"
+# 57807 "parsing/parser.ml"
+                
+              in
+              
+# 278 "<standard.mly>"
+    ( xs @ ys )
+# 57813 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
+            let _endpos = _endpos__1_ in
+            let _startpos = _startpos__1_ in
             
-# 267 "<standard.mly>"
-    ( xs @ ys )
-# 56380 "parsing/parser.ml"
+# 980 "parsing/parser.mly"
+                              ( extra_def _startpos _endpos _1 )
+# 57822 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
-          let _endpos = _endpos__1_ in
-          let _startpos = _startpos__1_ in
-          
-# 956 "parsing/parser.mly"
-                              ( extra_def _startpos _endpos _1 )
-# 56389 "parsing/parser.ml"
-          
-        in
-        
-# 1276 "parsing/parser.mly"
+          (
+# 1300 "parsing/parser.mly"
     ( _1 )
-# 56395 "parsing/parser.ml"
-         in
+# 57828 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56434,75 +57868,77 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos_e_ in
         let _endpos = _endpos__2_ in
-        let _v : (Parsetree.toplevel_phrase list) = let _1 =
+        let _v =
           let _1 =
-            let ys = 
-# 260 "<standard.mly>"
+            let _1 =
+              let ys = 
+# 271 "<standard.mly>"
     ( List.flatten xss )
-# 56443 "parsing/parser.ml"
-             in
-            let xs =
-              let _1 =
-                let x =
-                  let _1 =
+# 57878 "parsing/parser.ml"
+               in
+              let xs =
+                let _1 =
+                  let x =
                     let _1 =
-                      let attrs = 
-# 4058 "parsing/parser.mly"
-    ( _1 )
-# 56453 "parsing/parser.ml"
-                       in
-                      
-# 1488 "parsing/parser.mly"
+                      let _1 =
+                        let attrs = 
+# 4110 "parsing/parser.mly"
+    ( _1 )
+# 57888 "parsing/parser.ml"
+                         in
+                        
+# 1512 "parsing/parser.mly"
     ( mkstrexp e attrs )
-# 56458 "parsing/parser.ml"
+# 57893 "parsing/parser.ml"
+                        
+                      in
+                      
+# 998 "parsing/parser.mly"
+  ( Ptop_def [_1] )
+# 57899 "parsing/parser.ml"
                       
                     in
+                    let _startpos__1_ = _startpos_e_ in
+                    let _startpos = _startpos__1_ in
                     
-# 974 "parsing/parser.mly"
-  ( Ptop_def [_1] )
-# 56464 "parsing/parser.ml"
+# 996 "parsing/parser.mly"
+  ( text_def _startpos @ [_1] )
+# 57907 "parsing/parser.ml"
                     
                   in
-                  let _startpos__1_ = _startpos_e_ in
-                  let _startpos = _startpos__1_ in
                   
-# 972 "parsing/parser.mly"
-  ( text_def _startpos @ [_1] )
-# 56472 "parsing/parser.ml"
+# 1056 "parsing/parser.mly"
+    ( x )
+# 57913 "parsing/parser.ml"
                   
                 in
                 
-# 1032 "parsing/parser.mly"
-    ( x )
-# 56478 "parsing/parser.ml"
+# 1307 "parsing/parser.mly"
+    ( _1 )
+# 57919 "parsing/parser.ml"
                 
               in
               
-# 1283 "parsing/parser.mly"
-    ( _1 )
-# 56484 "parsing/parser.ml"
+# 278 "<standard.mly>"
+    ( xs @ ys )
+# 57925 "parsing/parser.ml"
               
             in
+            let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
+            let _endpos = _endpos__1_ in
+            let _startpos = _startpos__1_ in
             
-# 267 "<standard.mly>"
-    ( xs @ ys )
-# 56490 "parsing/parser.ml"
+# 980 "parsing/parser.mly"
+                              ( extra_def _startpos _endpos _1 )
+# 57934 "parsing/parser.ml"
             
           in
-          let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
-          let _endpos = _endpos__1_ in
-          let _startpos = _startpos__1_ in
-          
-# 956 "parsing/parser.mly"
-                              ( extra_def _startpos _endpos _1 )
-# 56499 "parsing/parser.ml"
-          
-        in
-        
-# 1276 "parsing/parser.mly"
+          (
+# 1300 "parsing/parser.mly"
     ( _1 )
-# 56505 "parsing/parser.ml"
-         in
+# 57940 "parsing/parser.ml"
+           : (Parsetree.toplevel_phrase list))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56538,9 +57974,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
         let _v : (Asttypes.label) = 
-# 3746 "parsing/parser.mly"
+# 3798 "parsing/parser.mly"
                               ( _2 )
-# 56544 "parsing/parser.ml"
+# 57980 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56576,13 +58012,15 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Asttypes.label) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        let _loc__1_ = (_startpos__1_, _endpos__1_) in
-        
-# 3747 "parsing/parser.mly"
+        let _v =
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          let _loc__1_ = (_startpos__1_, _endpos__1_) in
+          (
+# 3799 "parsing/parser.mly"
                               ( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 56585 "parsing/parser.ml"
-         in
+# 58022 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56610,12 +58048,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
-        let _v : (Asttypes.label) = let _loc__2_ = (_startpos__2_, _endpos__2_) in
-        
-# 3748 "parsing/parser.mly"
+        let _v =
+          let _loc__2_ = (_startpos__2_, _endpos__2_) in
+          (
+# 3800 "parsing/parser.mly"
                               ( expecting _loc__2_ "operator" )
-# 56618 "parsing/parser.ml"
-         in
+# 58057 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56650,12 +58090,14 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__3_ in
-        let _v : (Asttypes.label) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-        
-# 3749 "parsing/parser.mly"
+        let _v =
+          let _loc__3_ = (_startpos__3_, _endpos__3_) in
+          (
+# 3801 "parsing/parser.mly"
                               ( expecting _loc__3_ "module-expr" )
-# 56658 "parsing/parser.ml"
-         in
+# 58099 "parsing/parser.ml"
+           : (Asttypes.label))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56673,17 +58115,17 @@ module Tables = struct
           MenhirLib.EngineTypes.next = _menhir_stack;
         } = _menhir_stack in
         let _1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 56679 "parsing/parser.ml"
+# 58121 "parsing/parser.ml"
         ) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3752 "parsing/parser.mly"
+# 3804 "parsing/parser.mly"
                               ( _1 )
-# 56687 "parsing/parser.ml"
+# 58129 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56706,9 +58148,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.label) = 
-# 3753 "parsing/parser.mly"
+# 3805 "parsing/parser.mly"
                               ( _1 )
-# 56712 "parsing/parser.ml"
+# 58154 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56731,9 +58173,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Longident.t) = 
-# 3821 "parsing/parser.mly"
+# 3873 "parsing/parser.mly"
                                            ( _1 )
-# 56737 "parsing/parser.ml"
+# 58179 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -56778,48 +58220,50 @@ module Tables = struct
         let ty : (Parsetree.core_type) = Obj.magic ty in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 56784 "parsing/parser.ml"
+# 58226 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let mutable_ : (Asttypes.mutable_flag) = Obj.magic mutable_ in
         let _1 : (Parsetree.attributes) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_ty_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let label =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+        let _v =
+          let label =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 56798 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 58239 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 56806 "parsing/parser.ml"
-          
-        in
-        let attrs = 
-# 4062 "parsing/parser.mly"
+# 58247 "parsing/parser.ml"
+            
+          in
+          let attrs = 
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 56812 "parsing/parser.ml"
-         in
-        let _1 = 
-# 3961 "parsing/parser.mly"
+# 58253 "parsing/parser.ml"
+           in
+          let _1 = 
+# 4013 "parsing/parser.mly"
                                                 ( Fresh )
-# 56817 "parsing/parser.ml"
-         in
-        
-# 2068 "parsing/parser.mly"
+# 58258 "parsing/parser.ml"
+           in
+          (
+# 2090 "parsing/parser.mly"
       ( (label, mutable_, Cfk_virtual ty), attrs )
-# 56822 "parsing/parser.ml"
-         in
+# 58263 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56863,48 +58307,50 @@ module Tables = struct
         let _6 : (Parsetree.expression) = Obj.magic _6 in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 56869 "parsing/parser.ml"
+# 58313 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
         let _1 : (Parsetree.attributes) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 56883 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 58326 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 56891 "parsing/parser.ml"
-          
-        in
-        let _2 = 
-# 4062 "parsing/parser.mly"
+# 58334 "parsing/parser.ml"
+            
+          in
+          let _2 = 
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 56897 "parsing/parser.ml"
-         in
-        let _1 = 
-# 3964 "parsing/parser.mly"
+# 58340 "parsing/parser.ml"
+           in
+          let _1 = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 56902 "parsing/parser.ml"
-         in
-        
-# 2070 "parsing/parser.mly"
+# 58345 "parsing/parser.ml"
+           in
+          (
+# 2092 "parsing/parser.mly"
       ( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 56907 "parsing/parser.ml"
-         in
+# 58350 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -56954,9 +58400,9 @@ module Tables = struct
         let _6 : (Parsetree.expression) = Obj.magic _6 in
         let _5 : unit = Obj.magic _5 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 56960 "parsing/parser.ml"
+# 58406 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -56964,42 +58410,44 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__6_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 56975 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 58420 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 56983 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 58428 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 56991 "parsing/parser.ml"
-          
-        in
-        let _1 = 
-# 3965 "parsing/parser.mly"
+# 58436 "parsing/parser.ml"
+            
+          in
+          let _1 = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 56997 "parsing/parser.ml"
-         in
-        
-# 2070 "parsing/parser.mly"
+# 58442 "parsing/parser.ml"
+           in
+          (
+# 2092 "parsing/parser.mly"
       ( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 57002 "parsing/parser.ml"
-         in
+# 58447 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -57050,65 +58498,67 @@ module Tables = struct
         let _6 : unit = Obj.magic _6 in
         let _5 : (Parsetree.type_constraint) = Obj.magic _5 in
         let _1_inlined1 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 57056 "parsing/parser.ml"
+# 58504 "parsing/parser.ml"
         ) = Obj.magic _1_inlined1 in
         let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
         let _1 : (Parsetree.attributes) = Obj.magic _1 in
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 57070 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 58517 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 57078 "parsing/parser.ml"
-          
-        in
-        let _startpos__4_ = _startpos__1_inlined1_ in
-        let _2 = 
-# 4062 "parsing/parser.mly"
+# 58525 "parsing/parser.ml"
+            
+          in
+          let _startpos__4_ = _startpos__1_inlined1_ in
+          let _2 = 
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 57085 "parsing/parser.ml"
-         in
-        let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
-        let _1 = 
-# 3964 "parsing/parser.mly"
+# 58532 "parsing/parser.ml"
+           in
+          let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
+          let _1 = 
+# 4016 "parsing/parser.mly"
                                                 ( Fresh )
-# 57091 "parsing/parser.ml"
-         in
-        let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
-        let _endpos = _endpos__7_ in
-        let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
-          _startpos__1_
-        else
-          if _startpos__2_ != _endpos__2_ then
-            _startpos__2_
+# 58538 "parsing/parser.ml"
+           in
+          let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
+            _startpos__1_
           else
-            if _startpos__3_ != _endpos__3_ then
-              _startpos__3_
+            if _startpos__2_ != _endpos__2_ then
+              _startpos__2_
             else
-              _startpos__4_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2073 "parsing/parser.mly"
+              if _startpos__3_ != _endpos__3_ then
+                _startpos__3_
+              else
+                _startpos__4_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2095 "parsing/parser.mly"
       ( let e = mkexp_constraint ~loc:_sloc _7 _5 in
         (_4, _3, Cfk_concrete (_1, e)), _2
       )
-# 57111 "parsing/parser.ml"
-         in
+# 58558 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -57165,9 +58615,9 @@ module Tables = struct
         let _6 : unit = Obj.magic _6 in
         let _5 : (Parsetree.type_constraint) = Obj.magic _5 in
         let _1_inlined2 : (
-# 778 "parsing/parser.mly"
+# 797 "parsing/parser.mly"
        (string)
-# 57171 "parsing/parser.ml"
+# 58621 "parsing/parser.ml"
         ) = Obj.magic _1_inlined2 in
         let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
         let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
@@ -57175,58 +58625,60 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__7_ in
-        let _v : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
-   Parsetree.class_field_kind) *
-  Parsetree.attributes) = let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _1 = 
-# 3720 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _1 = 
+# 3765 "parsing/parser.mly"
                                                 ( _1 )
-# 57186 "parsing/parser.ml"
-           in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 58635 "parsing/parser.ml"
+             in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 57194 "parsing/parser.ml"
-          
-        in
-        let _startpos__4_ = _startpos__1_inlined2_ in
-        let _2 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 58643 "parsing/parser.ml"
+            
+          in
+          let _startpos__4_ = _startpos__1_inlined2_ in
+          let _2 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 57203 "parsing/parser.ml"
-          
-        in
-        let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
-        let _1 = 
-# 3965 "parsing/parser.mly"
+# 58652 "parsing/parser.ml"
+            
+          in
+          let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
+          let _1 = 
+# 4017 "parsing/parser.mly"
                                                 ( Override )
-# 57210 "parsing/parser.ml"
-         in
-        let _endpos = _endpos__7_ in
-        let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
-          _startpos__1_
-        else
-          if _startpos__2_ != _endpos__2_ then
-            _startpos__2_
+# 58659 "parsing/parser.ml"
+           in
+          let _endpos = _endpos__7_ in
+          let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
+            _startpos__1_
           else
-            if _startpos__3_ != _endpos__3_ then
-              _startpos__3_
+            if _startpos__2_ != _endpos__2_ then
+              _startpos__2_
             else
-              _startpos__4_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 2073 "parsing/parser.mly"
+              if _startpos__3_ != _endpos__3_ then
+                _startpos__3_
+              else
+                _startpos__4_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 2095 "parsing/parser.mly"
       ( let e = mkexp_constraint ~loc:_sloc _7 _5 in
         (_4, _3, Cfk_concrete (_1, e)), _2
       )
-# 57229 "parsing/parser.ml"
-         in
+# 58678 "parsing/parser.ml"
+           : ((Asttypes.label Asttypes.loc * Asttypes.mutable_flag *
+   Parsetree.class_field_kind) *
+  Parsetree.attributes))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -57289,46 +58741,48 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined3_ in
-        let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 =
-          let _1 = _1_inlined3 in
-          
-# 4058 "parsing/parser.mly"
+        let _v =
+          let attrs2 =
+            let _1 = _1_inlined3 in
+            
+# 4110 "parsing/parser.mly"
     ( _1 )
-# 57298 "parsing/parser.ml"
-          
-        in
-        let _endpos_attrs2_ = _endpos__1_inlined3_ in
-        let id =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 58751 "parsing/parser.ml"
+            
+          in
+          let _endpos_attrs2_ = _endpos__1_inlined3_ in
+          let id =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 57310 "parsing/parser.ml"
-          
-        in
-        let attrs1 =
-          let _1 = _1_inlined1 in
-          
-# 4062 "parsing/parser.mly"
+# 58763 "parsing/parser.ml"
+            
+          in
+          let attrs1 =
+            let _1 = _1_inlined1 in
+            
+# 4114 "parsing/parser.mly"
     ( _1 )
-# 57318 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos_attrs2_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3038 "parsing/parser.mly"
+# 58771 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos_attrs2_ in
+          let _symbolstartpos = _startpos__1_ in
+          let _sloc = (_symbolstartpos, _endpos) in
+          (
+# 3083 "parsing/parser.mly"
     ( let attrs = attrs1 @ attrs2 in
       let loc = make_loc _sloc in
       let docs = symbol_docs _sloc in
       Val.mk id ty ~attrs ~loc ~docs,
       ext )
-# 57331 "parsing/parser.ml"
-         in
+# 58784 "parsing/parser.ml"
+           : (Parsetree.value_description * string Asttypes.loc option))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -57343,9 +58797,9 @@ module Tables = struct
         let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _endpos = _startpos in
         let _v : (Asttypes.virtual_flag) = 
-# 3925 "parsing/parser.mly"
+# 3977 "parsing/parser.mly"
                                                 ( Concrete )
-# 57349 "parsing/parser.ml"
+# 58803 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -57368,9 +58822,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.virtual_flag) = 
-# 3926 "parsing/parser.mly"
+# 3978 "parsing/parser.mly"
                                                 ( Virtual )
-# 57374 "parsing/parser.ml"
+# 58828 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -57393,9 +58847,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.mutable_flag) = 
-# 3949 "parsing/parser.mly"
+# 4001 "parsing/parser.mly"
             ( Immutable )
-# 57399 "parsing/parser.ml"
+# 58853 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -57425,9 +58879,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.mutable_flag) = 
-# 3950 "parsing/parser.mly"
+# 4002 "parsing/parser.mly"
                     ( Mutable )
-# 57431 "parsing/parser.ml"
+# 58885 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -57457,9 +58911,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.mutable_flag) = 
-# 3951 "parsing/parser.mly"
+# 4003 "parsing/parser.mly"
                     ( Mutable )
-# 57463 "parsing/parser.ml"
+# 58917 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -57482,9 +58936,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.private_flag) = 
-# 3956 "parsing/parser.mly"
+# 4008 "parsing/parser.mly"
             ( Public )
-# 57488 "parsing/parser.ml"
+# 58942 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -57514,9 +58968,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.private_flag) = 
-# 3957 "parsing/parser.mly"
+# 4009 "parsing/parser.mly"
                     ( Private )
-# 57520 "parsing/parser.ml"
+# 58974 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -57546,9 +59000,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.private_flag) = 
-# 3958 "parsing/parser.mly"
+# 4010 "parsing/parser.mly"
                     ( Private )
-# 57552 "parsing/parser.ml"
+# 59006 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -57605,50 +59059,51 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_xs_ in
-        let _v : (Parsetree.with_constraint) = let _6 =
-          let _1 =
-            let xs = 
-# 253 "<standard.mly>"
+        let _v =
+          let _6 =
+            let _1 =
+              let xs = 
+# 264 "<standard.mly>"
     ( List.rev xs )
-# 57614 "parsing/parser.ml"
-             in
-            
-# 1044 "parsing/parser.mly"
+# 59069 "parsing/parser.ml"
+               in
+              
+# 1068 "parsing/parser.mly"
     ( xs )
-# 57619 "parsing/parser.ml"
+# 59074 "parsing/parser.ml"
+              
+            in
             
-          in
-          
-# 3138 "parsing/parser.mly"
+# 3183 "parsing/parser.mly"
     ( _1 )
-# 57625 "parsing/parser.ml"
-          
-        in
-        let _endpos__6_ = _endpos_xs_ in
-        let _5 =
-          let _1 = _1_inlined2 in
-          
-# 3460 "parsing/parser.mly"
+# 59080 "parsing/parser.ml"
+            
+          in
+          let _endpos__6_ = _endpos_xs_ in
+          let _5 =
+            let _1 = _1_inlined2 in
+            
+# 3505 "parsing/parser.mly"
     ( _1 )
-# 57634 "parsing/parser.ml"
-          
-        in
-        let _3 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+# 59089 "parsing/parser.ml"
+            
+          in
+          let _3 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 59100 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__6_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 57645 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__6_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3379 "parsing/parser.mly"
+          (
+# 3424 "parsing/parser.mly"
       ( let lident = loc_last _3 in
         Pwith_type
           (_3,
@@ -57658,8 +59113,9 @@ module Tables = struct
               ~manifest:_5
               ~priv:_4
               ~loc:(make_loc _sloc))) )
-# 57662 "parsing/parser.ml"
-         in
+# 59117 "parsing/parser.ml"
+           : (Parsetree.with_constraint))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -57708,31 +59164,32 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.with_constraint) = let _5 =
-          let _1 = _1_inlined2 in
-          
-# 3460 "parsing/parser.mly"
+        let _v =
+          let _5 =
+            let _1 = _1_inlined2 in
+            
+# 3505 "parsing/parser.mly"
     ( _1 )
-# 57717 "parsing/parser.ml"
-          
-        in
-        let _endpos__5_ = _endpos__1_inlined2_ in
-        let _3 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
+# 59174 "parsing/parser.ml"
+            
+          in
+          let _endpos__5_ = _endpos__1_inlined2_ in
+          let _3 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
+    ( mkrhs _1 _sloc )
+# 59186 "parsing/parser.ml"
+            
+          in
+          let _endpos = _endpos__5_ in
           let _symbolstartpos = _startpos__1_ in
           let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
-    ( mkrhs _1 _sloc )
-# 57729 "parsing/parser.ml"
-          
-        in
-        let _endpos = _endpos__5_ in
-        let _symbolstartpos = _startpos__1_ in
-        let _sloc = (_symbolstartpos, _endpos) in
-        
-# 3392 "parsing/parser.mly"
+          (
+# 3437 "parsing/parser.mly"
       ( let lident = loc_last _3 in
         Pwith_typesubst
          (_3,
@@ -57740,8 +59197,9 @@ module Tables = struct
               ~params:_2
               ~manifest:_5
               ~loc:(make_loc _sloc))) )
-# 57744 "parsing/parser.ml"
-         in
+# 59201 "parsing/parser.ml"
+           : (Parsetree.with_constraint))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -57783,33 +59241,35 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.with_constraint) = let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 57795 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 59254 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 57806 "parsing/parser.ml"
-          
-        in
-        
-# 3400 "parsing/parser.mly"
+# 59265 "parsing/parser.ml"
+            
+          in
+          (
+# 3445 "parsing/parser.mly"
       ( Pwith_module (_2, _4) )
-# 57812 "parsing/parser.ml"
-         in
+# 59271 "parsing/parser.ml"
+           : (Parsetree.with_constraint))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -57851,33 +59311,35 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_inlined2_ in
-        let _v : (Parsetree.with_constraint) = let _4 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let _4 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 57863 "parsing/parser.ml"
-          
-        in
-        let _2 =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+# 59324 "parsing/parser.ml"
+            
+          in
+          let _2 =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 57874 "parsing/parser.ml"
-          
-        in
-        
-# 3402 "parsing/parser.mly"
+# 59335 "parsing/parser.ml"
+            
+          in
+          (
+# 3447 "parsing/parser.mly"
       ( Pwith_modsubst (_2, _4) )
-# 57880 "parsing/parser.ml"
-         in
+# 59341 "parsing/parser.ml"
+           : (Parsetree.with_constraint))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -57926,22 +59388,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_rhs_ in
-        let _v : (Parsetree.with_constraint) = let l =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let l =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 57938 "parsing/parser.ml"
-          
-        in
-        
-# 3404 "parsing/parser.mly"
+# 59401 "parsing/parser.ml"
+            
+          in
+          (
+# 3449 "parsing/parser.mly"
       ( Pwith_modtype (l, rhs) )
-# 57944 "parsing/parser.ml"
-         in
+# 59407 "parsing/parser.ml"
+           : (Parsetree.with_constraint))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -57990,22 +59454,24 @@ module Tables = struct
         let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
         let _startpos = _startpos__1_ in
         let _endpos = _endpos_rhs_ in
-        let _v : (Parsetree.with_constraint) = let l =
-          let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
-          let _endpos = _endpos__1_ in
-          let _symbolstartpos = _startpos__1_ in
-          let _sloc = (_symbolstartpos, _endpos) in
-          
-# 960 "parsing/parser.mly"
+        let _v =
+          let l =
+            let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+            let _endpos = _endpos__1_ in
+            let _symbolstartpos = _startpos__1_ in
+            let _sloc = (_symbolstartpos, _endpos) in
+            
+# 984 "parsing/parser.mly"
     ( mkrhs _1 _sloc )
-# 58002 "parsing/parser.ml"
-          
-        in
-        
-# 3406 "parsing/parser.mly"
+# 59467 "parsing/parser.ml"
+            
+          in
+          (
+# 3451 "parsing/parser.mly"
       ( Pwith_modtypesubst (l, rhs) )
-# 58008 "parsing/parser.ml"
-         in
+# 59473 "parsing/parser.ml"
+           : (Parsetree.with_constraint))
+        in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
           MenhirLib.EngineTypes.semv = Obj.repr _v;
@@ -58027,9 +59493,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__1_ in
         let _v : (Asttypes.private_flag) = 
-# 3409 "parsing/parser.mly"
+# 3454 "parsing/parser.mly"
                    ( Public )
-# 58033 "parsing/parser.ml"
+# 59499 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -58059,9 +59525,9 @@ module Tables = struct
         let _startpos = _startpos__1_ in
         let _endpos = _endpos__2_ in
         let _v : (Asttypes.private_flag) = 
-# 3410 "parsing/parser.mly"
+# 3455 "parsing/parser.mly"
                    ( Private )
-# 58065 "parsing/parser.ml"
+# 59531 "parsing/parser.ml"
          in
         {
           MenhirLib.EngineTypes.state = _menhir_s;
@@ -58088,135 +59554,130 @@ module MenhirInterpreter = struct
 end
 
 let use_file =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 2052 lexer lexbuf) : (Parsetree.toplevel_phrase list))
+  fun lexer lexbuf : (Parsetree.toplevel_phrase list) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2062 lexer lexbuf)
 
 and toplevel_phrase =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 2032 lexer lexbuf) : (Parsetree.toplevel_phrase))
+  fun lexer lexbuf : (Parsetree.toplevel_phrase) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2042 lexer lexbuf)
 
 and parse_val_longident =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 2026 lexer lexbuf) : (Longident.t))
+  fun lexer lexbuf : (Longident.t) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2036 lexer lexbuf)
 
 and parse_pattern =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 2022 lexer lexbuf) : (Parsetree.pattern))
+  fun lexer lexbuf : (Parsetree.pattern) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2032 lexer lexbuf)
 
 and parse_mty_longident =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 2018 lexer lexbuf) : (Longident.t))
+  fun lexer lexbuf : (Longident.t) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2028 lexer lexbuf)
 
 and parse_module_type =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 2014 lexer lexbuf) : (Parsetree.module_type))
+  fun lexer lexbuf : (Parsetree.module_type) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2024 lexer lexbuf)
 
 and parse_module_expr =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 2010 lexer lexbuf) : (Parsetree.module_expr))
+  fun lexer lexbuf : (Parsetree.module_expr) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2020 lexer lexbuf)
 
 and parse_mod_longident =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 2006 lexer lexbuf) : (Longident.t))
+  fun lexer lexbuf : (Longident.t) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2016 lexer lexbuf)
 
 and parse_mod_ext_longident =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 2002 lexer lexbuf) : (Longident.t))
+  fun lexer lexbuf : (Longident.t) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2012 lexer lexbuf)
 
 and parse_expression =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 1998 lexer lexbuf) : (Parsetree.expression))
+  fun lexer lexbuf : (Parsetree.expression) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2008 lexer lexbuf)
 
 and parse_core_type =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 1994 lexer lexbuf) : (Parsetree.core_type))
+  fun lexer lexbuf : (Parsetree.core_type) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2004 lexer lexbuf)
 
 and parse_constr_longident =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 1990 lexer lexbuf) : (Longident.t))
+  fun lexer lexbuf : (Longident.t) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 2000 lexer lexbuf)
 
 and parse_any_longident =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 1972 lexer lexbuf) : (Longident.t))
+  fun lexer lexbuf : (Longident.t) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 1982 lexer lexbuf)
 
 and interface =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 1968 lexer lexbuf) : (Parsetree.signature))
+  fun lexer lexbuf : (Parsetree.signature) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 1978 lexer lexbuf)
 
 and implementation =
-  fun lexer lexbuf ->
-    (Obj.magic (MenhirInterpreter.entry `Simplified 0 lexer lexbuf) : (Parsetree.structure))
+  fun lexer lexbuf : (Parsetree.structure) ->
+    Obj.magic (MenhirInterpreter.entry `Simplified 0 lexer lexbuf)
 
 module Incremental = struct
   
   let use_file =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 2052 initial_position) : (Parsetree.toplevel_phrase list) MenhirInterpreter.checkpoint)
+    fun initial_position : (Parsetree.toplevel_phrase list) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2062 initial_position)
   
   and toplevel_phrase =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 2032 initial_position) : (Parsetree.toplevel_phrase) MenhirInterpreter.checkpoint)
+    fun initial_position : (Parsetree.toplevel_phrase) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2042 initial_position)
   
   and parse_val_longident =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 2026 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+    fun initial_position : (Longident.t) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2036 initial_position)
   
   and parse_pattern =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 2022 initial_position) : (Parsetree.pattern) MenhirInterpreter.checkpoint)
+    fun initial_position : (Parsetree.pattern) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2032 initial_position)
   
   and parse_mty_longident =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 2018 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+    fun initial_position : (Longident.t) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2028 initial_position)
   
   and parse_module_type =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 2014 initial_position) : (Parsetree.module_type) MenhirInterpreter.checkpoint)
+    fun initial_position : (Parsetree.module_type) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2024 initial_position)
   
   and parse_module_expr =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 2010 initial_position) : (Parsetree.module_expr) MenhirInterpreter.checkpoint)
+    fun initial_position : (Parsetree.module_expr) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2020 initial_position)
   
   and parse_mod_longident =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 2006 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+    fun initial_position : (Longident.t) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2016 initial_position)
   
   and parse_mod_ext_longident =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 2002 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+    fun initial_position : (Longident.t) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2012 initial_position)
   
   and parse_expression =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 1998 initial_position) : (Parsetree.expression) MenhirInterpreter.checkpoint)
+    fun initial_position : (Parsetree.expression) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2008 initial_position)
   
   and parse_core_type =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 1994 initial_position) : (Parsetree.core_type) MenhirInterpreter.checkpoint)
+    fun initial_position : (Parsetree.core_type) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2004 initial_position)
   
   and parse_constr_longident =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 1990 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+    fun initial_position : (Longident.t) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 2000 initial_position)
   
   and parse_any_longident =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 1972 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
+    fun initial_position : (Longident.t) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 1982 initial_position)
   
   and interface =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 1968 initial_position) : (Parsetree.signature) MenhirInterpreter.checkpoint)
+    fun initial_position : (Parsetree.signature) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 1978 initial_position)
   
   and implementation =
-    fun initial_position ->
-      (Obj.magic (MenhirInterpreter.start 0 initial_position) : (Parsetree.structure) MenhirInterpreter.checkpoint)
+    fun initial_position : (Parsetree.structure) MenhirInterpreter.checkpoint ->
+      Obj.magic (MenhirInterpreter.start 0 initial_position)
   
 end
 
-# 4100 "parsing/parser.mly"
-  
-
-# 58218 "parsing/parser.ml"
-
-# 269 "<standard.mly>"
+# 4152 "parsing/parser.mly"
   
 
-# 58223 "parsing/parser.ml"
+# 59684 "parsing/parser.ml"

diff --git a/boot/menhir/parser.mli b/boot/menhir/parser.mli
index a4cd7acf224992fd9a00aee8e95345a7dcbcb526..693495baeae759b1328229343407ce1c53e0e3c3 100644 (file)
--- a/boot/menhir/parser.mli
+++ b/boot/menhir/parser.mli
@@ -48,6 +48,9 @@ type token =
   | MINUSDOT
   | MINUS
   | METHOD
+  | METAOCAML_ESCAPE
+  | METAOCAML_BRACKET_OPEN
+  | METAOCAML_BRACKET_CLOSE
   | MATCH
   | LPAREN
   | LIDENT of (string)
@@ -97,6 +100,7 @@ type token =
   | EOF
   | END
   | ELSE
+  | EFFECT
   | DOWNTO
   | DOTOP of (string)
   | DOTDOT

diff --git a/boot/ocamlc b/boot/ocamlc
index b83f73ccd4c84703e06653ce2456332841b55147..852a0ec901686d8fb07b5da30307c4a7bc5454d7 100755 (executable)
Binary files a/boot/ocamlc and b/boot/ocamlc differ

diff --git a/boot/ocamllex b/boot/ocamllex
index 68e0649fa50a6433990bef0324f39e4364c80581..1c1de472dd66b9b3f5e4287354dc241522a4bdf7 100755 (executable)
Binary files a/boot/ocamllex and b/boot/ocamllex differ

diff --git a/build-aux/ax_check_compile_flag.m4 b/build-aux/ax_check_compile_flag.m4
index bd753b34d7dc57063b0b65f1441dde0889e1cd26..68fd43d5ddb09d32e92444e43927471c2598e2f0 100644 (file)
--- a/build-aux/ax_check_compile_flag.m4
+++ b/build-aux/ax_check_compile_flag.m4
@@ -34,12 +34,12 @@
 #   and this notice are preserved.  This file is offered as-is, without any
 #   warranty.
 
-#serial 6
+#serial 7
 
 AC_DEFUN([AX_CHECK_COMPILE_FLAG],
 [AC_PREREQ(2.64)dnl for _AC_LANG_PREFIX and AS_VAR_IF
 AS_VAR_PUSHDEF([CACHEVAR],[ax_cv_check_[]_AC_LANG_ABBREV[]flags_$4_$1])dnl
-AC_CACHE_CHECK([whether _AC_LANG compiler accepts $1], CACHEVAR, [
+AC_CACHE_CHECK([whether the _AC_LANG compiler accepts $1], CACHEVAR, [
   ax_check_save_flags=$[]_AC_LANG_PREFIX[]FLAGS
   _AC_LANG_PREFIX[]FLAGS="$[]_AC_LANG_PREFIX[]FLAGS $4 $1"
   AC_COMPILE_IFELSE([m4_default([$5],[AC_LANG_PROGRAM()])],

diff --git a/build-aux/ocaml_version.m4 b/build-aux/ocaml_version.m4
index e16f474e52791ba5e134eac649c92595f138dd07..c2b65b552f1d98f5819d66d4a1f2b9d963b83f66 100644 (file)
--- a/build-aux/ocaml_version.m4
+++ b/build-aux/ocaml_version.m4
@@ -32,8 +32,8 @@ m4_define([OCAML__DEVELOPMENT_VERSION], [false])
 # including the patchlevel, are mandatory.
 
 m4_define([OCAML__VERSION_MAJOR], [5])
-m4_define([OCAML__VERSION_MINOR], [2])
-m4_define([OCAML__VERSION_PATCHLEVEL], [1])
+m4_define([OCAML__VERSION_MINOR], [3])
+m4_define([OCAML__VERSION_PATCHLEVEL], [0])
 # Note that the OCAML__VERSION_EXTRA string defined below is always empty
 # for officially-released versions of OCaml.
 m4_define([OCAML__VERSION_EXTRA], [])
@@ -97,7 +97,7 @@ m4_define([OCAML__RELEASE_EXTRA],
 # - A 3-bytes version number
 
 m4_define([MAGIC_NUMBER__PREFIX], [Caml1999])
-m4_define([MAGIC_NUMBER__VERSION], [034])
+m4_define([MAGIC_NUMBER__VERSION], [035])
 
 # The following macro is used to define all our magic numbers
 # Its first argument is the name of the file type described by that

diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index 434f5ca27a60f13998bfd6eca331393f9281ce5e..4665ac84bcacbdd5ab5733372c5378c443d63a9b 100644 (file)
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -142,7 +142,7 @@ let rec is_tailcall = function
 
 let preserve_tailcall_for_prim = function
   | Popaque | Psequor | Psequand
-  | Prunstack | Pperform | Presume | Preperform ->
+  | Prunstack | Pperform | Presume | Preperform | Ppoll ->
       true
   | Pbytes_to_string | Pbytes_of_string | Pignore | Pgetglobal _ | Psetglobal _
   | Pmakeblock _ | Pfield _ | Pfield_computed | Psetfield _
@@ -493,6 +493,7 @@ let comp_primitive stack_info p sz args =
   | Patomic_cas -> Kccall("caml_atomic_cas", 3)
   | Patomic_fetch_add -> Kccall("caml_atomic_fetch_add", 2)
   | Pdls_get -> Kccall("caml_domain_dls_get", 1)
+  | Ppoll -> Kccall("caml_process_pending_actions_with_root", 1)
   (* The cases below are handled in [comp_expr] before the [comp_primitive] call
      (in the order in which they appear below),
      so they should never be reached in this function. *)
@@ -694,7 +695,7 @@ let rec comp_expr stack_info env exp sz cont =
           then Kmakeblock(0, 0) :: cont
           else comp_args stack_info env args sz
                  (Kmakeblock(List.length args, 0) ::
-                  Kccall("caml_make_array", 1) :: cont)
+                  Kccall("caml_array_of_uniform_array", 1) :: cont)
       end
   | Lprim(Presume, args, _) ->
       let nargs = List.length args - 1 in

diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml
index 001af5fa09f36b784949f4642cc56de88e6fdb83..4ff25d2f4c488763dd204d05af5baa881e199de0 100644 (file)
--- a/bytecomp/bytelibrarian.ml
+++ b/bytecomp/bytelibrarian.ml
@@ -22,6 +22,7 @@ open Cmo_format
 type error =
     File_not_found of string
   | Not_an_object_file of string
+  | Link_error of Linkdeps.error
 
 exception Error of error
 
@@ -71,7 +72,7 @@ let copy_object_file oc name =
       Bytelink.check_consistency file_name compunit;
       copy_compunit ic oc compunit;
       close_in ic;
-      [compunit]
+      [name,compunit]
     end else
     if buffer = cma_magic_number then begin
       let toc_pos = input_binary_int ic in
@@ -81,7 +82,7 @@ let copy_object_file oc name =
       add_ccobjs toc;
       List.iter (copy_compunit ic oc) toc.lib_units;
       close_in ic;
-      toc.lib_units
+      List.map (fun u -> name, u) toc.lib_units
     end else
       raise(Error(Not_an_object_file file_name))
   with
@@ -99,8 +100,15 @@ let create_archive file_list lib_name =
        output_binary_int outchan 0;
        let units =
          List.flatten(List.map (copy_object_file outchan) file_list) in
+       let ldeps = Linkdeps.create ~complete:false in
+       List.iter
+         (fun (filename,u) -> Bytelink.linkdeps_unit ldeps ~filename u)
+         (List.rev units);
+       (match Linkdeps.check ldeps with
+        | None -> ()
+        | Some e -> raise (Error (Link_error e)));
        let toc =
-         { lib_units = units;
+         { lib_units = (List.map snd units);
            lib_custom = !Clflags.custom_runtime;
            lib_ccobjs = !Clflags.ccobjs @ !lib_ccobjs;
            lib_ccopts = !Clflags.all_ccopts @ !lib_ccopts;
@@ -113,23 +121,27 @@ let create_archive file_list lib_name =
        output_binary_int outchan pos_toc;
     )
 
-open Format
+open Format_doc
 module Style = Misc.Style
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | File_not_found name ->
       fprintf ppf "Cannot find file %a" Style.inline_code name
   | Not_an_object_file name ->
       fprintf ppf "The file %a is not a bytecode object file"
-        (Style.as_inline_code Location.print_filename) name
+        Location.Doc.quoted_filename name
+  | Link_error e ->
+      Linkdeps.report_error_doc ~print_filename:Location.Doc.filename ppf e
 
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
 
+let report_error = Format_doc.compat report_error_doc
+
 let reset () =
   lib_ccobjs := [];
   lib_ccopts := [];

diff --git a/bytecomp/bytelibrarian.mli b/bytecomp/bytelibrarian.mli
index 3670730d692e1bfbccd71e2c6de2058f78dac01f..b4914611fd9e3dfe585c4739d4594888ca30846c 100644 (file)
--- a/bytecomp/bytelibrarian.mli
+++ b/bytecomp/bytelibrarian.mli
@@ -27,11 +27,10 @@ val create_archive: string list -> string -> unit
 type error =
     File_not_found of string
   | Not_an_object_file of string
+  | Link_error of Linkdeps.error
 
 exception Error of error
 
-open Format
-
-val report_error: formatter -> error -> unit
-
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
 val reset: unit -> unit

diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
index 7b72b7cbcf019bc92ab8124cb45ecba1d1a0feb3..db4fa18e76ce55538e32da6ab09fe252a95106cf 100644 (file)
--- a/bytecomp/bytelink.ml
+++ b/bytecomp/bytelink.ml
@@ -37,10 +37,8 @@ type error =
   | Custom_runtime
   | File_exists of filepath
   | Cannot_open_dll of filepath
-  | Required_compunit_unavailable of (compunit * compunit)
   | Camlheader of string * filepath
-  | Wrong_link_order of DepSet.t
-  | Multiple_definition of compunit * filepath * filepath
+  | Link_error of Linkdeps.error
 
 exception Error of error
 
@@ -97,37 +95,25 @@ let add_ccobjs origin l =
 
 (* First pass: determine which units are needed *)
 
-let missing_compunits = ref Compunit.Map.empty
-let provided_compunits = ref Compunit.Set.empty
-let badly_ordered_dependencies : DepSet.t ref = ref DepSet.empty
+let required compunit =
+  (Symtable.required_compunits compunit.cu_reloc
+   @ compunit.cu_required_compunits)
+  |> List.map (fun (Compunit i) -> i)
 
-let record_badly_ordered_dependency dep =
-  badly_ordered_dependencies := DepSet.add dep !badly_ordered_dependencies
-
-let is_required (rel, _pos) =
+let provided compunit =
+  List.filter_map (fun (rel, _pos) ->
   match rel with
-    | Reloc_setcompunit cu ->
-      Compunit.Map.mem cu !missing_compunits
-    | _ -> false
-
-let add_required compunit =
-  let add cu =
-    if Compunit.Set.mem cu !provided_compunits then
-      record_badly_ordered_dependency (cu, compunit.cu_name);
-    missing_compunits :=
-      Compunit.Map.add cu compunit.cu_name !missing_compunits
-  in
-  List.iter add (Symtable.required_compunits compunit.cu_reloc);
-  List.iter add compunit.cu_required_compunits
+    | Reloc_setcompunit (Compunit id) -> Some id
+    | _ -> None) compunit.cu_reloc
 
-let remove_required (rel, _pos) =
-  match rel with
-    Reloc_setcompunit cu ->
-      missing_compunits := Compunit.Map.remove cu !missing_compunits;
-      provided_compunits := Compunit.Set.add cu !provided_compunits;
-  | _ -> ()
+let linkdeps_unit ldeps ~filename compunit =
+  let requires = required compunit in
+  (* [requires] contains pack submodules *)
+  let provides = provided compunit in
+  let Compunit compunit = compunit.cu_name in
+  Linkdeps.add ldeps ~filename ~compunit ~requires ~provides
 
-let scan_file obj_name tolink =
+let scan_file ldeps obj_name tolink =
   let file_name =
     try
       Load_path.find obj_name
@@ -144,8 +130,7 @@ let scan_file obj_name tolink =
       seek_in ic compunit_pos;
       let compunit = (input_value ic : compilation_unit) in
       close_in ic;
-      add_required compunit;
-      List.iter remove_required compunit.cu_reloc;
+      linkdeps_unit ldeps ~filename:obj_name compunit;
       Link_object(file_name, compunit) :: tolink
     end
     else if buffer = cma_magic_number then begin
@@ -159,12 +144,12 @@ let scan_file obj_name tolink =
       let required =
         List.fold_right
           (fun compunit reqd ->
+             let Compunit name = compunit.cu_name in
             if compunit.cu_force_link
             || !Clflags.link_everything
-            || List.exists is_required compunit.cu_reloc
+            || Linkdeps.required ldeps name
             then begin
-              add_required compunit;
-              List.iter remove_required compunit.cu_reloc;
+              linkdeps_unit ldeps ~filename:obj_name compunit;
               compunit :: reqd
             end else
               reqd)
@@ -184,15 +169,9 @@ module Consistbl = Consistbl.Make (Misc.Stdlib.String)
 
 let crc_interfaces = Consistbl.create ()
 let interfaces = ref ([] : string list)
-let implementations_defined = ref ([] : (compunit * string) list)
 
 let check_consistency file_name cu =
-  begin try
-    let source = List.assoc cu.cu_name !implementations_defined in
-    raise (Error (Multiple_definition(cu.cu_name, file_name, source)));
-  with Not_found -> ()
-  end;
-  begin try
+  try
     List.iter
       (fun (name, crco) ->
         interfaces := name :: !interfaces;
@@ -206,9 +185,6 @@ let check_consistency file_name cu =
       original_source = auth;
     } ->
     raise(Error(Inconsistent_import(name, user, auth)))
-  end;
-  implementations_defined :=
-    (cu.cu_name, file_name) :: !implementations_defined
 
 let extract_crc_interfaces () =
   Consistbl.extract !interfaces crc_interfaces
@@ -615,13 +591,6 @@ let output_cds_file outfile =
 
 (* Output a bytecode executable as a C file *)
 
-(* Primitives declared in the included headers but re-declared in the
-   primitives table need to be guarded and not declared twice. *)
-let guarded_primitives = [
-    "caml_get_public_method", "caml__get_public_method";
-    "caml_set_oo_id", "caml__set_oo_id";
-  ]
-
 let link_bytecode_as_c tolink outfile with_main =
   let outchan = open_out outfile in
   Misc.try_finally
@@ -629,23 +598,22 @@ let link_bytecode_as_c tolink outfile with_main =
     ~exceptionally:(fun () -> remove_file outfile)
     (fun () ->
        (* The bytecode *)
-       output_string outchan "\
-#define CAML_INTERNALS\n\
-#define CAMLDLLIMPORT\
-\n\
-\n#ifdef __cplusplus\
-\nextern \"C\" {\
-\n#endif";
-       List.iter (fun (f, f') -> Printf.fprintf outchan "\n#define %s %s" f f')
-         guarded_primitives;
-       output_string outchan "\
-\n#include <caml/mlvalues.h>\
-\n#include <caml/startup.h>\
-\n#include <caml/sys.h>\
-\n#include <caml/misc.h>\n";
-       List.iter (fun (f, _) -> Printf.fprintf outchan "\n#undef %s" f)
-         guarded_primitives;
-       output_string outchan "\nstatic int caml_code[] = {\n";
+       output_string outchan
+{|#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define CAML_INTERNALS
+#define CAMLDLLIMPORT
+#define CAML_INTERNALS_NO_PRIM_DECLARATIONS
+
+#include <caml/mlvalues.h>
+#include <caml/startup.h>
+#include <caml/sys.h>
+#include <caml/misc.h>
+
+static int caml_code[] = {
+|};
        Symtable.init();
        clear_crc_interfaces ();
        let currpos = ref 0 in
@@ -655,12 +623,16 @@ let link_bytecode_as_c tolink outfile with_main =
        and currpos_fun () = !currpos in
        List.iter (link_file output_fun currpos_fun) tolink;
        (* The final STOP instruction *)
-       Printf.fprintf outchan "\n0x%x};\n\n" Opcodes.opSTOP;
+       Printf.fprintf outchan "\n0x%x};\n" Opcodes.opSTOP;
        (* The table of global data *)
-       output_string outchan "static char caml_data[] = {\n";
+       output_string outchan {|
+static char caml_data[] = {
+|};
        output_data_string outchan
          (Marshal.to_string (Symtable.initial_global_table()) []);
-       output_string outchan "\n};\n\n";
+       output_string outchan {|
+};
+|};
        (* The sections *)
        let sections : (string * Obj.t) array =
          [| Bytesections.Name.to_string SYMB,
@@ -668,68 +640,76 @@ let link_bytecode_as_c tolink outfile with_main =
             Bytesections.Name.to_string CRCS,
             Obj.repr(extract_crc_interfaces()) |]
        in
-       output_string outchan "static char caml_sections[] = {\n";
+       output_string outchan {|
+static char caml_sections[] = {
+|};
        output_data_string outchan
          (Marshal.to_string sections []);
-       output_string outchan "\n};\n\n";
+       output_string outchan {|
+};
+
+|};
        (* The table of primitives *)
        Symtable.output_primitive_table outchan;
        (* The entry point *)
        if with_main then begin
-         output_string outchan "\
-\nint main_os(int argc, char_os **argv)\
-\n{\
-\n  caml_byte_program_mode = COMPLETE_EXE;\
-\n  caml_startup_code(caml_code, sizeof(caml_code),\
-\n                    caml_data, sizeof(caml_data),\
-\n                    caml_sections, sizeof(caml_sections),\
-\n                    /* pooling */ 0,\
-\n                    argv);\
-\n  caml_do_exit(0);\
-\n  return 0; /* not reached */\
-\n}\n"
+         output_string outchan {|
+int main_os(int argc, char_os **argv)
+{
+  caml_byte_program_mode = COMPLETE_EXE;
+  caml_startup_code(caml_code, sizeof(caml_code),
+                    caml_data, sizeof(caml_data),
+                    caml_sections, sizeof(caml_sections),
+                    /* pooling */ 0,
+                    argv);
+  caml_do_exit(0);
+  return 0; /* not reached */
+}
+|}
        end else begin
-         output_string outchan "\
-\nvoid caml_startup(char_os ** argv)\
-\n{\
-\n  caml_startup_code(caml_code, sizeof(caml_code),\
-\n                    caml_data, sizeof(caml_data),\
-\n                    caml_sections, sizeof(caml_sections),\
-\n                    /* pooling */ 0,\
-\n                    argv);\
-\n}\
-\n\
-\nvalue caml_startup_exn(char_os ** argv)\
-\n{\
-\n  return caml_startup_code_exn(caml_code, sizeof(caml_code),\
-\n                               caml_data, sizeof(caml_data),\
-\n                               caml_sections, sizeof(caml_sections),\
-\n                               /* pooling */ 0,\
-\n                               argv);\
-\n}\
-\n\
-\nvoid caml_startup_pooled(char_os ** argv)\
-\n{\
-\n  caml_startup_code(caml_code, sizeof(caml_code),\
-\n                    caml_data, sizeof(caml_data),\
-\n                    caml_sections, sizeof(caml_sections),\
-\n                    /* pooling */ 1,\
-\n                    argv);\
-\n}\
-\n\
-\nvalue caml_startup_pooled_exn(char_os ** argv)\
-\n{\
-\n  return caml_startup_code_exn(caml_code, sizeof(caml_code),\
-\n                               caml_data, sizeof(caml_data),\
-\n                               caml_sections, sizeof(caml_sections),\
-\n                               /* pooling */ 1,\
-\n                               argv);\
-\n}\n"
+         output_string outchan {|
+void caml_startup(char_os ** argv)
+{
+  caml_startup_code(caml_code, sizeof(caml_code),
+                    caml_data, sizeof(caml_data),
+                    caml_sections, sizeof(caml_sections),
+                    /* pooling */ 0,
+                    argv);
+}
+
+value caml_startup_exn(char_os ** argv)
+{
+  return caml_startup_code_exn(caml_code, sizeof(caml_code),
+                               caml_data, sizeof(caml_data),
+                               caml_sections, sizeof(caml_sections),
+                               /* pooling */ 0,
+                               argv);
+}
+
+void caml_startup_pooled(char_os ** argv)
+{
+  caml_startup_code(caml_code, sizeof(caml_code),
+                    caml_data, sizeof(caml_data),
+                    caml_sections, sizeof(caml_sections),
+                    /* pooling */ 1,
+                    argv);
+}
+
+value caml_startup_pooled_exn(char_os ** argv)
+{
+  return caml_startup_code_exn(caml_code, sizeof(caml_code),
+                               caml_data, sizeof(caml_data),
+                               caml_sections, sizeof(caml_sections),
+                               /* pooling */ 1,
+                               argv);
+}
+|}
        end;
-       output_string outchan "\
-\n#ifdef __cplusplus\
-\n}\
-\n#endif\n";
+       output_string outchan {|
+#ifdef __cplusplus
+}
+#endif
+|};
     );
   if not with_main && !Clflags.debug then
     output_cds_file ((Filename.chop_extension outfile) ^ ".cds")
@@ -741,23 +721,21 @@ let build_custom_runtime prim_name exec_name =
     if not !Clflags.with_runtime
     then ""
     else "-lcamlrun" ^ !Clflags.runtime_variant in
-  let debug_prefix_map =
-    if Config.c_has_debug_prefix_map && not !Clflags.keep_camlprimc_file then
-      let flag =
-        [Printf.sprintf "-fdebug-prefix-map=%s=camlprim.c" prim_name]
-      in
-        if Ccomp.linker_is_flexlink then
-          "-link" :: flag
-        else
-          flag
+  let stable_name =
+    if not !Clflags.keep_camlprimc_file then
+      Some "camlprim.c"
     else
-      [] in
-  let exitcode =
-    (Clflags.std_include_flag "-I" ^ " " ^ Config.bytecomp_c_libraries)
+      None
   in
-  Ccomp.call_linker Ccomp.Exe exec_name
-    (debug_prefix_map @ [prim_name] @ List.rev !Clflags.ccobjs @ [runtime_lib])
-    exitcode = 0
+  let prims_obj = Filename.temp_file "camlprim" Config.ext_obj in
+  let result =
+    Ccomp.compile_file ~output:prims_obj ?stable_name prim_name = 0
+    && Ccomp.call_linker Ccomp.Exe exec_name
+        ([prims_obj] @ List.rev !Clflags.ccobjs @ [runtime_lib])
+        (Clflags.std_include_flag "-I" ^ " " ^ Config.bytecomp_c_libraries) = 0
+  in
+  remove_file prims_obj;
+  result
 
 let append_bytecode bytecode_name exec_name =
   let oc = open_out_gen [Open_wronly; Open_append; Open_binary] 0 exec_name in
@@ -788,17 +766,11 @@ let link objfiles output_name =
     | false, true, false -> "stdlib.cma" :: objfiles
     | _                  -> "stdlib.cma" :: objfiles @ ["std_exit.cmo"]
   in
-  let tolink = List.fold_right scan_file objfiles [] in
-  begin
-    match Compunit.Map.bindings !missing_compunits with
-    | [] -> ()
-    | missing_dependency :: _ ->
-        if DepSet.is_empty !badly_ordered_dependencies
-        then
-            raise (Error (Required_compunit_unavailable missing_dependency))
-        else
-            raise (Error (Wrong_link_order !badly_ordered_dependencies))
-  end;
+  let ldeps = Linkdeps.create ~complete:true in
+  let tolink = List.fold_right (scan_file ldeps) objfiles [] in
+  (match Linkdeps.check ldeps with
+   | None -> ()
+   | Some e -> raise (Error (Link_error e)));
   Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; (* put user's libs last *)
   Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
                                                    (* put user's opts first *)
@@ -821,24 +793,21 @@ let link objfiles output_name =
          let poc = open_out prim_name in
          (* note: builds will not be reproducible if the C code contains macros
             such as __FILE__. *)
-         output_string poc "\
-         #ifdef __cplusplus\n\
-         extern \"C\" {\n\
-         #endif\n\
-         #ifdef _WIN64\n\
-         #ifdef __MINGW32__\n\
-         typedef long long value;\n\
-         #else\n\
-         typedef __int64 value;\n\
-         #endif\n\
-         #else\n\
-         typedef long value;\n\
-         #endif\n";
+         output_string poc
+{|#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define CAML_INTERNALS_NO_PRIM_DECLARATIONS
+#include <caml/mlvalues.h>
+
+|};
          Symtable.output_primitive_table poc;
-         output_string poc "\
-         #ifdef __cplusplus\n\
-         }\n\
-         #endif\n";
+         output_string poc {|
+#ifdef __cplusplus
+}
+#endif
+|};
          close_out poc;
          let exec_name = fix_exec_name output_name in
          if not (build_custom_runtime prim_name exec_name)
@@ -900,78 +869,59 @@ let link objfiles output_name =
 
 (* Error report *)
 
-open Format
+open Format_doc
 module Style = Misc.Style
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | File_not_found name ->
       fprintf ppf "Cannot find file %a"
-        (Style.as_inline_code Location.print_filename) name
+        Location.Doc.quoted_filename name
   | Not_an_object_file name ->
       fprintf ppf "The file %a is not a bytecode object file"
-        (Style.as_inline_code Location.print_filename) name
+        Location.Doc.quoted_filename name
   | Wrong_object_name name ->
       fprintf ppf "The output file %a has the wrong name. The extension implies\
                   \ an object file but the link step was requested"
         Style.inline_code name
   | Symbol_error(name, err) ->
       fprintf ppf "Error while linking %a:@ %a"
-        (Style.as_inline_code Location.print_filename) name
-        Symtable.report_error err
+        Location.Doc.quoted_filename name
+        Symtable.report_error_doc err
   | Inconsistent_import(intf, file1, file2) ->
       fprintf ppf
         "@[<hov>Files %a@ and %a@ \
                  make inconsistent assumptions over interface %a@]"
-        (Style.as_inline_code Location.print_filename) file1
-        (Style.as_inline_code Location.print_filename) file2
+        Location.Doc.quoted_filename file1
+        Location.Doc.quoted_filename file2
         Style.inline_code intf
   | Custom_runtime ->
       fprintf ppf "Error while building custom runtime system"
   | File_exists file ->
       fprintf ppf "Cannot overwrite existing file %a"
-        (Style.as_inline_code Location.print_filename) file
+        Location.Doc.quoted_filename file
   | Cannot_open_dll file ->
       fprintf ppf "Error on dynamically loaded library: %a"
-        Location.print_filename file
-  | Required_compunit_unavailable
-    (Compunit unavailable, Compunit required_by) ->
-      fprintf ppf "Module %a is unavailable (required by %a)"
-        Style.inline_code unavailable
-        Style.inline_code required_by
+        Location.Doc.filename file
   | Camlheader (msg, header) ->
       fprintf ppf "System error while copying file %a: %a"
         Style.inline_code header
         Style.inline_code msg
-  | Wrong_link_order depset ->
-      let l = DepSet.elements depset in
-      let depends_on ppf (dep, depending) =
-        fprintf ppf "%a depends on %a"
-        Style.inline_code (Compunit.name depending)
-        Style.inline_code (Compunit.name dep)
-      in
-      fprintf ppf "@[<hov 2>Wrong link order: %a@]"
-        (pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ",@ ") depends_on) l
-  | Multiple_definition(compunit, file1, file2) ->
-      fprintf ppf
-        "@[<hov>Files %a@ and %a@ both define a module named %a@]"
-        (Style.as_inline_code Location.print_filename) file1
-        (Style.as_inline_code Location.print_filename) file2
-        Style.inline_code (Compunit.name compunit)
-
+  | Link_error e ->
+      Linkdeps.report_error_doc ~print_filename:Location.Doc.filename ppf e
 
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
 
+let report_error = Format_doc.compat report_error_doc
+
 let reset () =
   lib_ccobjs := [];
   lib_ccopts := [];
   lib_dllibs := [];
-  missing_compunits := Compunit.Map.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 f061d9ddb6d4941fda563c2f12d9cbb78dcf623d..61dffee8779cfdacb420571af69be368bd2662de 100644 (file)
--- a/bytecomp/bytelink.mli
+++ b/bytecomp/bytelink.mli
@@ -25,6 +25,8 @@ val link : filepath list -> filepath -> unit
 val reset : unit -> unit
 
 val check_consistency: filepath -> Cmo_format.compilation_unit -> unit
+val linkdeps_unit :
+  Linkdeps.t -> filename:string -> Cmo_format.compilation_unit -> unit
 
 val extract_crc_interfaces: unit -> crcs
 
@@ -37,13 +39,10 @@ type error =
   | Custom_runtime
   | File_exists of filepath
   | Cannot_open_dll of filepath
-  | Required_compunit_unavailable of (Cmo_format.compunit * Cmo_format.compunit)
   | Camlheader of string * filepath
-  | Wrong_link_order of DepSet.t
-  | Multiple_definition of Cmo_format.compunit * filepath * filepath
+  | Link_error of Linkdeps.error
 
 exception Error of error
 
-open Format
-
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
index 9351f9e5e3fb0469b2157bb944acf118d61c5bd9..6ec0434f7397c409df13bf5634389087f4ed9f34 100644 (file)
--- a/bytecomp/bytepackager.ml
+++ b/bytecomp/bytepackager.ml
@@ -344,25 +344,25 @@ let package_files ~ppf_dump initial_env files targetfile =
 
 (* Error report *)
 
-open Format
+open Format_doc
 module Style = Misc.Style
 
-let report_error ppf = function
+let report_error_doc ppf = function
     Forward_reference(file, compunit) ->
       fprintf ppf "Forward reference to %a in file %a"
         Style.inline_code (Compunit.name compunit)
-        (Style.as_inline_code Location.print_filename) file
+        Location.Doc.quoted_filename file
   | Multiple_definition(file, compunit) ->
       fprintf ppf "File %a redefines %a"
-        (Style.as_inline_code Location.print_filename) file
+        Location.Doc.quoted_filename file
         Style.inline_code (Compunit.name compunit)
   | Not_an_object_file file ->
       fprintf ppf "%a is not a bytecode object file"
-        (Style.as_inline_code Location.print_filename) file
+        Location.Doc.quoted_filename file
   | Illegal_renaming(name, file, id) ->
       fprintf ppf "Wrong file naming: %a@ contains the code for\
                    @ %a when %a was expected"
-        (Style.as_inline_code Location.print_filename) file
+        Location.Doc.quoted_filename file
         Style.inline_code (Compunit.name name)
         Style.inline_code (Compunit.name id)
   | File_not_found file ->
@@ -372,6 +372,8 @@ let report_error ppf = function
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/bytecomp/bytepackager.mli b/bytecomp/bytepackager.mli
index a518fb90eccb2ba7a0bfc2505b9a27f259d8c9a6..c8e3995a67535376c71bbae8eb858072d6433a2c 100644 (file)
--- a/bytecomp/bytepackager.mli
+++ b/bytecomp/bytepackager.mli
@@ -28,4 +28,5 @@ type error =
 
 exception Error of error
 
-val report_error: Format.formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml
index c587f6107a891148e0a3421ca2ba9d873cd75093..73d1dae716aadf5e7e75fb8003e56d008083ee20 100644 (file)
--- a/bytecomp/emitcode.ml
+++ b/bytecomp/emitcode.ml
@@ -38,7 +38,7 @@ let marshal_to_channel_with_possibly_32bit_compat ~filename ~kind outchan obj =
 
 
 let report_error ppf (file, kind) =
-  Format.fprintf ppf "Generated %s %S cannot be used on a 32-bit platform"
+  Format_doc.fprintf ppf "Generated %s %S cannot be used on a 32-bit platform"
                      kind file
 let () =
   Location.register_error_of_exn

diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml
index 21f87ee41979ee8b0657354c8d535bdae2cd6f12..40d4db0374945aecb79256bf28eedee5def97bcb 100644 (file)
--- a/bytecomp/symtable.ml
+++ b/bytecomp/symtable.ml
@@ -50,11 +50,14 @@ module Global = struct
 
   let quote s = "`" ^ s ^ "'"
 
-  let description ppf = function
+  let description ppf g =
+    let open Format_doc in
+    match g with
     | Glob_compunit (Compunit cu) ->
-        Format.fprintf ppf "compilation unit %a" Style.inline_code (quote cu)
+        fprintf ppf "compilation unit %a"
+          Style.inline_code (quote cu)
     | Glob_predef (Predef_exn exn) ->
-        Format.fprintf ppf "predefined exception %a"
+        fprintf ppf "predefined exception %a"
           Style.inline_code (quote exn)
 
   let of_ident id =
@@ -175,19 +178,25 @@ let output_primitive_table outchan =
   for i = 0 to Array.length prim - 1 do
     fprintf outchan "extern value %s(void);\n" prim.(i)
   done;
-  fprintf outchan "typedef value (*c_primitive)(void);\n";
-  fprintf outchan "#if defined __cplusplus\n";
-  fprintf outchan "extern\n";
-  fprintf outchan "#endif\n";
-  fprintf outchan "const c_primitive caml_builtin_cprim[] = {\n";
+  fprintf outchan {|
+typedef value (*c_primitive)(void);
+
+#if defined __cplusplus
+extern
+#endif
+const c_primitive caml_builtin_cprim[] = {
+|};
   for i = 0 to Array.length prim - 1 do
     fprintf outchan "  %s,\n" prim.(i)
   done;
-  fprintf outchan "  0 };\n";
-  fprintf outchan "#if defined __cplusplus\n";
-  fprintf outchan "extern\n";
-  fprintf outchan "#endif\n";
-  fprintf outchan "const char * const caml_names_of_builtin_cprim[] = {\n";
+  fprintf outchan
+{|  0 };
+
+#if defined __cplusplus
+extern
+#endif
+const char * const caml_names_of_builtin_cprim[] = {
+|};
   for i = 0 to Array.length prim - 1 do
     fprintf outchan "  \"%s\",\n" prim.(i)
   done;
@@ -429,9 +438,9 @@ let empty_global_map = GlobalMap.empty
 
 (* Error report *)
 
-open Format
+open Format_doc
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Undefined_global global ->
       fprintf ppf "Reference to undefined %a" Global.description global
   | Unavailable_primitive s ->
@@ -447,10 +456,12 @@ let report_error ppf = function
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
 
+let report_error = Format_doc.compat report_error_doc
+
 let reset () =
   global_table := GlobalMap.empty;
   literal_table := [];

diff --git a/bytecomp/symtable.mli b/bytecomp/symtable.mli
index cb3336aff66921c87e8dc725a838824035786f3a..803997ce110661d0408281ddd1ff763bccfa5f0f 100644 (file)
--- a/bytecomp/symtable.mli
+++ b/bytecomp/symtable.mli
@@ -37,7 +37,7 @@ module Global : sig
     | Glob_compunit of compunit
     | Glob_predef of predef
   val name: t -> string
-  val description: Format.formatter -> t -> unit
+  val description: t Format_doc.printer
   val of_ident: Ident.t -> t option
   module Set : Set.S with type elt = t
   module Map : Map.S with type key = t
@@ -90,8 +90,7 @@ type error =
 
 exception Error of error
 
-open Format
-
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
 
 val reset: unit -> unit

diff --git a/configure b/configure
index 49d5bff6495b2f38d91d97ec777a4212e3c23677..401b94298e4f34946677a409560ce1832c5bbbbc 100755 (executable)
--- a/configure
+++ b/configure
@@ -56,7 +56,7 @@ if test -e '.git' ; then :
   fi
 fi
 # Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.71 for OCaml 5.2.1.
+# Generated by GNU Autoconf 2.71 for OCaml 5.3.0.
 #
 # Report bugs to <caml-list@inria.fr>.
 #
@@ -677,8 +677,8 @@ MAKEFLAGS=
 # Identity of this package.
 PACKAGE_NAME='OCaml'
 PACKAGE_TARNAME='ocaml'
-PACKAGE_VERSION='5.2.1'
-PACKAGE_STRING='OCaml 5.2.1'
+PACKAGE_VERSION='5.3.0'
+PACKAGE_STRING='OCaml 5.3.0'
 PACKAGE_BUGREPORT='caml-list@inria.fr'
 PACKAGE_URL='http://www.ocaml.org'
 
@@ -767,6 +767,10 @@ WINDOWS_UNICODE_MODE
 LIBUNWIND_LDFLAGS
 LIBUNWIND_CPPFLAGS
 DLLIBS
+COMPILER_NATIVE_CPPFLAGS
+COMPILER_NATIVE_CFLAGS
+COMPILER_BYTECODE_CPPFLAGS
+COMPILER_BYTECODE_CFLAGS
 PARTIALLD
 csc
 target_os
@@ -781,7 +785,6 @@ build_os
 build_vendor
 build_cpu
 build
-target_bindir
 ar_supports_response_files
 QS
 ocaml_libdir
@@ -789,8 +792,6 @@ ocaml_bindir
 compute_deps
 build_libraries_manpages
 PACKLD
-mkexe_ldflags_exp
-mkdll_ldflags_exp
 flexdll_chain
 afl
 oc_native_compflags
@@ -820,6 +821,7 @@ ocamltest_opt_target
 ocamltest_target
 ocamltest
 build_ocamltest
+build_ocamlobjinfo
 documentation_tool_cmd
 documentation_tool
 with_ocamldoc
@@ -843,8 +845,8 @@ lib_systhreads
 lib_str
 lib_runtime_events
 lib_dynlink
+otherlibs
 otherlibraries
-has_monotonic_clock
 instrumented_runtime_libs
 instrumented_runtime
 debug_runtime
@@ -856,26 +858,26 @@ supports_shared_libraries
 mklib
 AR
 shebangscripts
-flexlink_flags
+winpthreads_source_include_dir
+winpthreads_source_dir
 flexdll_dir
 bootstrapping_flexdll
 flexdll_source_dir
-ocamlc_cppflags
-ocamlc_cflags
 zstd_libs
 native_ldflags
 cclibs
-oc_exe_ldflags
 oc_dll_ldflags
 oc_ldflags
 oc_cppflags
+common_cppflags
 tsan_native_runtime_c_sources
 tsan
 oc_cflags
+common_cflags
 toolchain
 ccomptype
+mkexe_via_cc_extra_cmd
 mkexe_via_cc_ldflags
-mkexe_extra_flags
 mkexedebugflag
 mkexe_exp
 mkexe
@@ -888,8 +890,14 @@ ln
 unix_or_win32
 ocamlsrcdir
 systhread_support
+oc_native_cppflags
+oc_native_cflags
+oc_bytecode_cppflags
+oc_bytecode_cflags
 native_cppflags
 native_cflags
+bytecode_cppflags
+bytecode_cflags
 system
 model
 arch64
@@ -917,7 +925,7 @@ CMA_MAGIC_NUMBER
 CMO_MAGIC_NUMBER
 CMI_MAGIC_NUMBER
 EXEC_MAGIC_NUMBER
-MAGIC_NUMBER_LENGTH
+MAGIC_LENGTH
 OCAML_VERSION_SHORT
 OCAML_VERSION_EXTRA
 OCAML_VERSION_PATCHLEVEL
@@ -985,6 +993,7 @@ enable_unix_lib
 enable_bigarray_lib
 enable_ocamldoc
 with_odoc
+enable_ocamlobjinfo
 enable_ocamltest
 enable_native_toplevel
 enable_frame_pointers
@@ -1010,6 +1019,7 @@ enable_function_sections
 enable_mmap_map_stack
 with_afl
 with_flexdll
+with_winpthreads_msvc
 with_zstd
 enable_shared
 enable_static
@@ -1026,6 +1036,10 @@ target_alias
 AS
 ASPP
 PARTIALLD
+COMPILER_BYTECODE_CFLAGS
+COMPILER_BYTECODE_CPPFLAGS
+COMPILER_NATIVE_CFLAGS
+COMPILER_NATIVE_CPPFLAGS
 DLLIBS
 LIBUNWIND_CPPFLAGS
 LIBUNWIND_LDFLAGS
@@ -1586,7 +1600,7 @@ if test "$ac_init_help" = "long"; then
   # Omit some internal or obsolete options to make the list less imposing.
   # This message is too long to be a string in the A/UX 3.1 sh.
   cat <<_ACEOF
-\`configure' configures OCaml 5.2.1 to adapt to many kinds of systems.
+\`configure' configures OCaml 5.3.0 to adapt to many kinds of systems.
 
 Usage: $0 [OPTION]... [VAR=VALUE]...
 
@@ -1653,7 +1667,7 @@ fi
 
 if test -n "$ac_init_help"; then
   case $ac_init_help in
-     short | recursive ) echo "Configuration of OCaml 5.2.1:";;
+     short | recursive ) echo "Configuration of OCaml 5.3.0:";;
    esac
   cat <<\_ACEOF
 
@@ -1674,6 +1688,7 @@ Optional Features:
   --disable-str-lib       do not build the str library
   --disable-unix-lib      do not build the unix library
   --disable-ocamldoc      do not build the ocamldoc documentation system
+  --disable-ocamlobjinfo  do not build ocamlobjinfo
   --disable-ocamltest     do not build ocamltest
   --enable-native-toplevel
                           build the native toplevel
@@ -1719,6 +1734,8 @@ Optional Packages:
   --with-target-sh        location of Posix sh on the target system
   --with-afl              use the AFL fuzzer
   --with-flexdll          bootstrap FlexDLL from the given sources
+  --with-winpthreads-msvc build winpthreads (only for the MSVC port) from the
+                          given sources
   --without-zstd          disable compression of compilation artefacts
   --with-pic[=PKGS]       try to use only PIC/non-PIC objects [default=use
                           both]
@@ -1734,6 +1751,14 @@ Some influential environment variables:
   AS          which assembler to use
   ASPP        which assembler (with preprocessor) to use
   PARTIALLD   how to build partial (relocatable) object files
+  COMPILER_BYTECODE_CFLAGS
+              CFLAGS for compiling C files to be linked with bytecode
+  COMPILER_BYTECODE_CPPFLAGS
+              CPPFLAGS for compiling C files to be linked with bytecode
+  COMPILER_NATIVE_CFLAGS
+              CFLAGS for compiling C files to be linked with native code
+  COMPILER_NATIVE_CPPFLAGS
+              CPPFLAGS for compiling C files to be linked with native code
   DLLIBS      which libraries to use (in addition to -ldl) to load dynamic
               libs
   LIBUNWIND_CPPFLAGS
@@ -1824,7 +1849,7 @@ fi
 test -n "$ac_init_help" && exit $ac_status
 if $ac_init_version; then
   cat <<\_ACEOF
-OCaml configure 5.2.1
+OCaml configure 5.3.0
 generated by GNU Autoconf 2.71
 
 Copyright (C) 2021 Free Software Foundation, Inc.
@@ -2346,58 +2371,6 @@ rm -f conftest.val
 
 } # ac_fn_c_compute_int
 
-# ac_fn_check_decl LINENO SYMBOL VAR INCLUDES EXTRA-OPTIONS FLAG-VAR
-# ------------------------------------------------------------------
-# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
-# accordingly. Pass EXTRA-OPTIONS to the compiler, using FLAG-VAR.
-ac_fn_check_decl ()
-{
-  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
-  as_decl_name=`echo $2|sed 's/ *(.*//'`
-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
-printf %s "checking whether $as_decl_name is declared... " >&6; }
-if eval test \${$3+y}
-then :
-  printf %s "(cached) " >&6
-else $as_nop
-  as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
-  eval ac_save_FLAGS=\$$6
-  as_fn_append $6 " $5"
-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h.  */
-$4
-int
-main (void)
-{
-#ifndef $as_decl_name
-#ifdef __cplusplus
-  (void) $as_decl_use;
-#else
-  (void) $as_decl_name;
-#endif
-#endif
-
-  ;
-  return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"
-then :
-  eval "$3=yes"
-else $as_nop
-  eval "$3=no"
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
-  eval $6=\$ac_save_FLAGS
-
-fi
-eval ac_res=\$$3
-              { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-printf "%s\n" "$ac_res" >&6; }
-  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
-
-} # ac_fn_check_decl
-
 # ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES
 # ----------------------------------------------------
 # Tries to find if the field MEMBER exists in type AGGR, after including
@@ -2457,6 +2430,58 @@ printf "%s\n" "$ac_res" >&6; }
   eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
 
 } # ac_fn_c_check_member
+
+# ac_fn_check_decl LINENO SYMBOL VAR INCLUDES EXTRA-OPTIONS FLAG-VAR
+# ------------------------------------------------------------------
+# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
+# accordingly. Pass EXTRA-OPTIONS to the compiler, using FLAG-VAR.
+ac_fn_check_decl ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  as_decl_name=`echo $2|sed 's/ *(.*//'`
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
+printf %s "checking whether $as_decl_name is declared... " >&6; }
+if eval test \${$3+y}
+then :
+  printf %s "(cached) " >&6
+else $as_nop
+  as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
+  eval ac_save_FLAGS=\$$6
+  as_fn_append $6 " $5"
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main (void)
+{
+#ifndef $as_decl_name
+#ifdef __cplusplus
+  (void) $as_decl_use;
+#else
+  (void) $as_decl_name;
+#endif
+#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"
+then :
+  eval "$3=yes"
+else $as_nop
+  eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
+  eval $6=\$ac_save_FLAGS
+
+fi
+eval ac_res=\$$3
+              { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+printf "%s\n" "$ac_res" >&6; }
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_check_decl
 ac_configure_args_raw=
 for ac_arg
 do
@@ -2481,7 +2506,7 @@ cat >config.log <<_ACEOF
 This file contains any messages produced by compilers while
 running configure, to aid debugging if configure makes a mistake.
 
-It was created by OCaml $as_me 5.2.1, which was
+It was created by OCaml $as_me 5.3.0, which was
 generated by GNU Autoconf 2.71.  Invocation command line was
 
   $ $0$ac_configure_args_raw
@@ -3237,8 +3262,8 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
 
 
 
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 5.2.1" >&5
-printf "%s\n" "$as_me: Configuring OCaml version 5.2.1" >&6;}
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 5.3.0" >&5
+printf "%s\n" "$as_me: Configuring OCaml version 5.3.0" >&6;}
 
 # Configuration variables
 
@@ -3251,7 +3276,6 @@ CONFIGURE_ARGS="$*"
 # rely on $CFLAGS because these cannot be processed by flexlink (and are not
 # passed)
 mkexe_cmd='$(CC)'
-mkexe_cflags='$(OC_CFLAGS) $(CFLAGS)'
 mkexe_extra_flags=''
 mkexe_via_cc_extra_cmd=''
 mkexe_ldflags_prefix=''
@@ -3263,17 +3287,18 @@ common_cflags=""
 common_cppflags=""
 internal_cflags=""
 internal_cppflags=""
-ocamlc_cflags=""
-ocamlc_cppflags=""
+bytecode_cflags=""
+bytecode_cppflags=""
 oc_ldflags=""
 oc_dll_ldflags=""
 oc_exe_ldflags=""
 
 tsan=false
-# Passed to the linker by ocamlopt when tsan is enabled
-oc_tsan_cflags="-fsanitize=thread"
-oc_tsan_cppflags="-DWITH_THREAD_SANITIZER"
+# TSan flags for each compilation stage
+tsan_cppflags="-DWITH_THREAD_SANITIZER"
+tsan_cflags="-fsanitize=thread"
 tsan_distinguish_volatile_cflags=""
+tsan_ldflags="-fsanitize=thread"
 
 # The C# compiler and its flags
 CSC=""
@@ -3312,7 +3337,7 @@ unix_directory=""
 
 
 
-VERSION=5.2.1
+VERSION=5.3.0
 
 OCAML_DEVELOPMENT_VERSION=false
 
@@ -3320,43 +3345,43 @@ OCAML_RELEASE_EXTRA=None
 
 OCAML_VERSION_MAJOR=5
 
-OCAML_VERSION_MINOR=2
+OCAML_VERSION_MINOR=3
 
-OCAML_VERSION_PATCHLEVEL=1
+OCAML_VERSION_PATCHLEVEL=0
 
 OCAML_VERSION_EXTRA=
 
-OCAML_VERSION_SHORT=5.2
+OCAML_VERSION_SHORT=5.3
 
 printf "%s\n" "#define MAGIC_NUMBER_PREFIX \"Caml1999\"" >>confdefs.h
 
-printf "%s\n" "#define MAGIC_NUMBER_VERSION \"034\"" >>confdefs.h
-
-MAGIC_NUMBER_LENGTH=12
+printf "%s\n" "#define MAGIC_NUMBER_VERSION \"035\"" >>confdefs.h
 
 printf "%s\n" "#define EXEC_MAGIC_LENGTH 12" >>confdefs.h
 
+MAGIC_LENGTH=12
+
 printf "%s\n" "#define EXEC_FORMAT \"X\"" >>confdefs.h
 
-EXEC_MAGIC_NUMBER=Caml1999X034
+EXEC_MAGIC_NUMBER=Caml1999X035
 
-CMI_MAGIC_NUMBER=Caml1999I034
+CMI_MAGIC_NUMBER=Caml1999I035
 
-CMO_MAGIC_NUMBER=Caml1999O034
+CMO_MAGIC_NUMBER=Caml1999O035
 
-CMA_MAGIC_NUMBER=Caml1999A034
+CMA_MAGIC_NUMBER=Caml1999A035
 
 
 
-AST_IMPL_MAGIC_NUMBER=Caml1999M034
+AST_IMPL_MAGIC_NUMBER=Caml1999M035
 
-AST_INTF_MAGIC_NUMBER=Caml1999N034
+AST_INTF_MAGIC_NUMBER=Caml1999N035
 
-CMXS_MAGIC_NUMBER=Caml1999D034
+CMXS_MAGIC_NUMBER=Caml1999D035
 
-CMT_MAGIC_NUMBER=Caml1999T034
+CMT_MAGIC_NUMBER=Caml1999T035
 
-LINEAR_MAGIC_NUMBER=Caml1999L034
+LINEAR_MAGIC_NUMBER=Caml1999L035
 
 
 
@@ -3438,7 +3463,6 @@ LINEAR_MAGIC_NUMBER=Caml1999L034
 
 
 
- # TODO: rename this variable
 
 
 
@@ -3447,6 +3471,13 @@ LINEAR_MAGIC_NUMBER=Caml1999L034
 
 
 
+ # TODO: rename this variable
+
+
+
+
+
+
 
 
 
@@ -3501,6 +3532,8 @@ ac_config_files="$ac_config_files manual/src/html_processing/src/common.ml"
 
 ac_config_files="$ac_config_files ocamltest/ocamltest_config.ml"
 
+ac_config_files="$ac_config_files otherlibs/dynlink/dynlink_config.ml"
+
 ac_config_files="$ac_config_files utils/config.common.ml"
 
 ac_config_files="$ac_config_files utils/config.generated.ml"
@@ -3525,17 +3558,17 @@ ac_config_files="$ac_config_files stdlib/META"
 # Definitions related to the version of OCaml
 printf "%s\n" "#define OCAML_VERSION_MAJOR 5" >>confdefs.h
 
-printf "%s\n" "#define OCAML_VERSION_MINOR 2" >>confdefs.h
+printf "%s\n" "#define OCAML_VERSION_MINOR 3" >>confdefs.h
 
-printf "%s\n" "#define OCAML_VERSION_PATCHLEVEL 1" >>confdefs.h
+printf "%s\n" "#define OCAML_VERSION_PATCHLEVEL 0" >>confdefs.h
 
 printf "%s\n" "#define OCAML_VERSION_ADDITIONAL \"\"" >>confdefs.h
 
   printf "%s\n" "#define OCAML_VERSION_EXTRA \"\"" >>confdefs.h
 
-printf "%s\n" "#define OCAML_VERSION 50201" >>confdefs.h
+printf "%s\n" "#define OCAML_VERSION 50300" >>confdefs.h
 
-printf "%s\n" "#define OCAML_VERSION_STRING \"5.2.1\"" >>confdefs.h
+printf "%s\n" "#define OCAML_VERSION_STRING \"5.3.0\"" >>confdefs.h
 
 
 # Works out how many "o"s are needed in quoted strings
@@ -3675,8 +3708,6 @@ esac
 # Systems that are known not to work, even in bytecode only.
 
 case $host in #(
-  *-pc-windows) :
-    as_fn_error 69 "the MSVC compiler is not supported currently" "$LINENO" 5 ;; #(
   i386-*-solaris*) :
     as_fn_error $? "Building for 32 bits target is not supported. \
 If your host is 64 bits, you can try with './configure CC=\"gcc -m64\"' \
@@ -3689,7 +3720,10 @@ esac
 
 case $host in #(
   *-pc-windows) :
-    CC=cl
+    if test -z "$CC"
+then :
+  CC=cl
+fi
     ccomptype=msvc
     S=asm
     SO=dll
@@ -3769,6 +3803,11 @@ fi
 
 
 
+
+
+
+
+
 # Command-line arguments to configure
 
 # Check whether --enable-debug-runtime was given.
@@ -3898,6 +3937,12 @@ then :
 fi
 
 
+# Check whether --enable-ocamlobjinfo was given.
+if test ${enable_ocamlobjinfo+y}
+then :
+  enableval=$enable_ocamlobjinfo;
+fi
+
 
 # Check whether --enable-ocamltest was given.
 if test ${enable_ocamltest+y}
@@ -4119,6 +4164,17 @@ fi
 
 
 
+# Check whether --with-winpthreads-msvc was given.
+if test ${with_winpthreads_msvc+y}
+then :
+  withval=$with_winpthreads_msvc; if test x"$withval" = 'xyes'
+then :
+  with_winpthreads_msvc=winpthreads
+fi
+fi
+
+
+
 # Check whether --with-zstd was given.
 if test ${with_zstd+y}
 then :
@@ -13690,7 +13746,14 @@ then :
 else $as_nop
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
 /* end confdefs.h.  */
-int main (void) {return 0;}
+
+int
+main (void)
+{
+
+  ;
+  return 0;
+}
 _ACEOF
 if ac_fn_c_try_run "$LINENO"
 then :
@@ -13728,7 +13791,7 @@ case $ocaml_cc_vendor in #(
     CPP="$CC -E -Qn" # suppress generation of Sun PRO ident string
     ocamltest_CPP="$CPP" ;; #(
   msvc-*) :
-    CPP="$CC -nologo -EP"
+    CPP="$CC -nologo -EP -TC"
     ocamltest_CPP="$CPP 2> nul" ;; #(
   *) :
     CPP="$CC -E -P"
@@ -13752,7 +13815,7 @@ ocamlsrcdir=${ocamlsrcdir%X}
 
 # Whether ar supports @FILE arguments
 
-case lt_cv_ar_at_file in #(
+case $lt_cv_ar_at_file in #(
   no) :
     ar_supports_response_files=false ;; #(
   *) :
@@ -13783,7 +13846,12 @@ case $host in #(
 esac
 
 otherlibraries="dynlink runtime_events"
+otherlibs="runtime_events"
+optional_libraries="$optional_libraries otherlibs/dynlink/dynlink"
 lib_dynlink=true
+dldir=otherlibs/dynlink
+ac_config_links="$ac_config_links $dldir/dynlink_cmo_format.mli:file_formats/cmo_format.mli $dldir/dynlink_cmxs_format.mli:file_formats/cmxs_format.mli $dldir/dynlink_platform_intf.mli:$dldir/dynlink_platform_intf.ml"
+
 lib_runtime_events=true
 if test x"$enable_unix_lib" != "xno"
 then :
@@ -13791,6 +13859,7 @@ then :
   ac_config_files="$ac_config_files otherlibs/unix/META"
 
   otherlibraries="$otherlibraries unix"
+  otherlibs="$otherlibs unix"
   lib_unix=true
   ac_config_links="$ac_config_links otherlibs/unix/unix.ml:otherlibs/unix/unix_${unix_or_win32}.ml"
 
@@ -13804,6 +13873,7 @@ fi
 if test x"$enable_str_lib" != "xno"
 then :
   otherlibraries="$otherlibraries str"
+  otherlibs="$otherlibs str"
   lib_str=true
   ac_config_files="$ac_config_files otherlibs/str/META"
 
@@ -13897,8 +13967,14 @@ case $ocaml_cc_vendor in #(
     outputobj='-o '; cc_warnings="" ;; #(
   msvc-*) :
     outputobj='-Fo'
-    warn_error_flag='-WX'
-    cc_warnings='' ;; #(
+    case $ocaml_cc_vendor in #(
+  msvc-*-clang-*) :
+    cc_warnings='-W4 -Wno-unused-parameter -Wno-sign-compare -Wundef'
+         warn_error_flag='-WX' ;; #(
+  *) :
+    cc_warnings='-W2'
+       warn_error_flag='-WX -options:strict' ;;
+esac ;; #(
   *) :
     outputobj='-o '
   warn_error_flag='-Werror'
@@ -13908,8 +13984,8 @@ esac
 
 # Use -Wold-style-declaration if supported
 as_CACHEVAR=`printf "%s\n" "ax_cv_check_cflags_$warn_error_flag_-Wold-style-declaration" | $as_tr_sh`
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether C compiler accepts -Wold-style-declaration" >&5
-printf %s "checking whether C compiler accepts -Wold-style-declaration... " >&6; }
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler accepts -Wold-style-declaration" >&5
+printf %s "checking whether the C compiler accepts -Wold-style-declaration... " >&6; }
 if eval test \${$as_CACHEVAR+y}
 then :
   printf %s "(cached) " >&6
@@ -13948,6 +14024,50 @@ else $as_nop
 fi
 
 
+# Use -Wimplicit-fallthrough if supported
+for flag in '-Wimplicit-fallthrough=5' '-Wimplicit-fallthrough'; do
+  as_CACHEVAR=`printf "%s\n" "ax_cv_check_cflags_$warn_error_flag_$flag" | $as_tr_sh`
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler accepts $flag" >&5
+printf %s "checking whether the C compiler accepts $flag... " >&6; }
+if eval test \${$as_CACHEVAR+y}
+then :
+  printf %s "(cached) " >&6
+else $as_nop
+
+  ax_check_save_flags=$CFLAGS
+  CFLAGS="$CFLAGS $warn_error_flag $flag"
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main (void)
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"
+then :
+  eval "$as_CACHEVAR=yes"
+else $as_nop
+  eval "$as_CACHEVAR=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
+  CFLAGS=$ax_check_save_flags
+fi
+eval ac_res=\$$as_CACHEVAR
+              { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+printf "%s\n" "$ac_res" >&6; }
+if eval test \"x\$"$as_CACHEVAR"\" = x"yes"
+then :
+  cc_warnings="$cc_warnings $flag"; break
+else $as_nop
+  :
+fi
+
+done
+
 case $enable_warn_error,false in #(
   yes,*|,true) :
     cc_warnings="$cc_warnings $warn_error_flag" ;; #(
@@ -13955,6 +14075,20 @@ case $enable_warn_error,false in #(
      ;;
 esac
 
+case $host in #(
+  *-*-mingw32*|*-pc-windows) :
+    case $WINDOWS_UNICODE_MODE in #(
+  ansi) :
+    windows_unicode=0 ;; #(
+  compatible|"") :
+    windows_unicode=1 ;; #(
+  *) :
+    as_fn_error $? "unexpected windows unicode mode" "$LINENO" 5 ;;
+esac ;; #(
+  *) :
+    windows_unicode=0 ;;
+esac
+
 # We select high optimization levels, provided we can turn off:
 # - strict type-based aliasing analysis (too risky for the OCaml runtime)
 # - strict no-overflow conditions on signed integer arithmetic
@@ -13979,49 +14113,66 @@ case $ocaml_cc_vendor in #(
     # TODO: see whether the code can be fixed to avoid -Wno-unused
     common_cflags="-O2 -fno-strict-aliasing -fwrapv -mms-bitfields"
     internal_cppflags='-D__USE_MINGW_ANSI_STDIO=0 -DUNICODE -D_UNICODE'
-    internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
-    internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #(
+    internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE=$windows_unicode" ;; #(
   mingw-*) :
     as_fn_error $? "Unsupported C compiler for a MinGW-w64 build" "$LINENO" 5 ;; #(
+  msvc-0*|msvc-1[0-8]*|msvc-19[012]*|msvc-193[0-7]) :
+    # No C11 atomics support
+    as_fn_error 69 "This version of MSVC is too old. Please use Visual Studio version 17.8 or above." "$LINENO" 5 ;; #(
   msvc-*) :
-    common_cflags="-nologo -O2 -Gy- -MD $cc_warnings"
+    common_cflags='-nologo -O2 -Gy- -MD'
     common_cppflags="-D_CRT_SECURE_NO_DEPRECATE"
-    internal_cppflags='-DUNICODE -D_UNICODE'
+    internal_cflags="$cc_warnings"
+    internal_cppflags='-DUNICODE -D_UNICODE -D_CRT_NONSTDC_NO_WARNINGS'
+    as_CACHEVAR=`printf "%s\n" "ax_cv_check_cflags_$warn_error_flag_-volatileMetadata-" | $as_tr_sh`
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler accepts -volatileMetadata-" >&5
+printf %s "checking whether the C compiler accepts -volatileMetadata-... " >&6; }
+if eval test \${$as_CACHEVAR+y}
+then :
+  printf %s "(cached) " >&6
+else $as_nop
 
-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports -d2VolatileMetadata-" >&5
-printf %s "checking whether the C compiler supports -d2VolatileMetadata-... " >&6; }
-  saved_CFLAGS="$CFLAGS"
-  CFLAGS="-d2VolatileMetadata- $CFLAGS"
+  ax_check_save_flags=$CFLAGS
+  CFLAGS="$CFLAGS $warn_error_flag -volatileMetadata-"
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
 /* end confdefs.h.  */
-int main() { return 0; }
+
+int
+main (void)
+{
+
+  ;
+  return 0;
+}
 _ACEOF
 if ac_fn_c_try_compile "$LINENO"
 then :
-  cl_has_volatile_metadata=true
-    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-printf "%s\n" "yes" >&6; }
+  eval "$as_CACHEVAR=yes"
 else $as_nop
-  cl_has_volatile_metadata=false
-    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
-printf "%s\n" "no" >&6; }
+  eval "$as_CACHEVAR=no"
 fi
 rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
-  CFLAGS="$saved_CFLAGS"
-
-    if test "x$cl_has_volatile_metadata" = "xtrue"
+  CFLAGS=$ax_check_save_flags
+fi
+eval ac_res=\$$as_CACHEVAR
+              { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+printf "%s\n" "$ac_res" >&6; }
+if eval test \"x\$"$as_CACHEVAR"\" = x"yes"
 then :
-  internal_cflags='-d2VolatileMetadata-'
+  internal_cflags="$internal_cflags -volatileMetadata-"
+else $as_nop
+  :
 fi
-    internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
-    internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #(
+
+    internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE=$windows_unicode" ;; #(
   xlc-*) :
     common_cflags="-O5 -qtune=balanced -qnoipa -qinline";
     internal_cflags="$cc_warnings" ;; #(
   sunc-*) :
     # Optimization should be >= O4 to inline functions
             # and prevent unresolved externals
-    common_cflags="-O4 -xc99=all -D_XPG6 $CFLAGS";
+    common_cflags="-O4 -xc99=all"
+    common_cppflags="-D_XPG6"
     internal_cflags="$cc_warnings" ;; #(
   *) :
     common_cflags="-O" ;;
@@ -14112,8 +14263,6 @@ then :
   if test -f 'flexdll/flexdll.h'
 then :
   flexdll_source_dir=flexdll
-          iflexdir='$(ROOTDIR)/flexdll'
-          with_flexdll="$iflexdir"
 else $as_nop
   if test x"$with_flexdll" != 'x'
 then :
@@ -14129,7 +14278,6 @@ then :
   mkdir -p flexdll-sources
           cp -r "$with_flexdll"/* flexdll-sources/
           flexdll_source_dir='flexdll-sources'
-          iflexdir='$(ROOTDIR)/flexdll-sources'
           flexmsg=" (from $with_flexdll)"
 else $as_nop
   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: requested but not available" >&5
@@ -14142,12 +14290,10 @@ then :
   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
 printf "%s\n" "no" >&6; }
 else $as_nop
-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $iflexdir$flexmsg" >&5
-printf "%s\n" "$iflexdir$flexmsg" >&6; }
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $flexdll_source_dir$flexmsg" >&5
+printf "%s\n" "$flexdll_source_dir$flexmsg" >&6; }
         bootstrapping_flexdll=true
         flexdll_dir=\"+flexdll\"
-        # The submodule should be searched *before* any other -I paths
-        internal_cppflags="-I $iflexdir $internal_cppflags"
 fi ;; #(
   *) :
     if test x"$with_flexdll" != 'x'
@@ -14245,7 +14391,14 @@ esac
     CFLAGS=""
     cat confdefs.h - <<_ACEOF >conftest.$ac_ext
 /* end confdefs.h.  */
-int main() { return 0; }
+
+int
+main (void)
+{
+
+  ;
+  return 0;
+}
 _ACEOF
 if ac_fn_c_try_link "$LINENO"
 then :
@@ -14277,10 +14430,17 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
 
 
 
-    case $host in #(
-  *-w64-mingw32*|*-pc-windows) :
+    # When building on Cygwin/MSYS2, flexlink may be a shell script which
+    # then cannot be executed by ocamlc/ocamlopt. Having located flexlink,
+    # ensure it can be executed from a native Windows process. The check
+    # is only necessary when cross-compiling.
+    if test x"$build" != x"$host"
+then :
+
+      case $build in #(
+  *-pc-msys|*-pc-cygwin*) :
     flexlink_where="$(cmd /c "$flexlink" -where 2>/dev/null)"
-        if test -z "$flexlink_where"
+          if test -z "$flexlink_where"
 then :
   as_fn_error $? "$flexlink is not executable from a native Win32 process" "$LINENO" 5
 fi ;; #(
@@ -14288,6 +14448,8 @@ fi ;; #(
      ;;
 esac
 
+fi
+
 fi
 
 
@@ -14358,8 +14520,14 @@ printf %s "checking if \"$flexlink -where\" includes flexdll.h... " >&6; }
   flexlink_where="$($flexlink -where | tr -d '\r')"
   CPPFLAGS="$CPPFLAGS -I \"$flexlink_where\""
   cat > conftest.c <<"EOF"
-#include <flexdll.h>
-int main (void) {return 0;}
+  #include <flexdll.h>
+int
+main (void)
+{
+
+  ;
+  return 0;
+}
 EOF
   cat > conftest.Makefile <<EOF
 all:
@@ -14433,7 +14601,6 @@ case $ocaml_cc_vendor,$host in #(
 then :
   mkexe_cmd_exp="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
       mkexe_cmd="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
-      mkexe_cflags=''
       mkexe_ldflags_prefix='-link '
 else $as_nop
   mkexe_extra_flags=''
@@ -14452,7 +14619,6 @@ esac
     toolchain="mingw"
     mkexe_cmd_exp="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
     mkexe_cmd="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
-    mkexe_cflags=''
     mkexe_ldflags_prefix='-link '
     oc_exe_ldflags='-municode'
     mkexe_extra_flags="$mkexe_ldflags_prefix$oc_exe_ldflags"
@@ -14462,7 +14628,6 @@ esac
     ostype="Win32"
     mkexe_cmd_exp="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
     mkexe_cmd="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
-    mkexe_cflags=''
     mkexe_ldflags_prefix='-link '
     mkexe_via_cc_ldflags_prefix='/link '
     oc_exe_ldflags='/ENTRY:wmainCRTStartup'
@@ -14481,14 +14646,112 @@ esac
      ;;
 esac
 
-## Program to use to install files
-
-  # Find a good install program.  We prefer a C program (faster),
-# so one script is as good as another.  But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
+# Winpthreads emulation library for the MSVC port
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for winpthreads sources" >&5
+printf %s "checking for winpthreads sources... " >&6; }
+if test x"$with_winpthreads_msvc" = "xno"
+then :
+  winpthreads_source_dir=''
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: disabled" >&5
+printf "%s\n" "disabled" >&6; }
+else $as_nop
+  winpthreadmsg=''
+  case $target in #(
+  *-pc-windows) :
+                       if test x"$with_winpthreads_msvc" = 'x' || test x"$with_winpthreads_msvc" = x'winpthreads'
+then :
+  if test -f 'winpthreads/src/winpthread_internal.h'
+then :
+  winpthreads_source_dir=winpthreads
+else $as_nop
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: required but not available (uninitialized submodule?)" >&5
+printf "%s\n" "required but not available (uninitialized submodule?)" >&6; }
+        as_fn_error $? "exiting" "$LINENO" 5
+fi
+else $as_nop
+  rm -rf winpthreads-sources
+      if test -f "$with_winpthreads_msvc/src/winpthread_internal.h"
+then :
+  mkdir -p winpthreads-sources/src winpthreads-sources/include
+        cp "$with_winpthreads_msvc"/src/*.c winpthreads-sources/src
+        cp "$with_winpthreads_msvc"/src/*.h winpthreads-sources/src
+        cp "$with_winpthreads_msvc"/include/*.h winpthreads-sources/include
+        winpthreads_source_dir='winpthreads-sources'
+        winpthreadsmsg=" (from $with_winpthreads_msvc)"
+else $as_nop
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: requested but not available" >&5
+printf "%s\n" "requested but not available" >&6; }
+        as_fn_error $? "exiting" "$LINENO" 5
+fi
+fi
+    if test x"$winpthreads_source_dir" = 'x'
+then :
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
+printf "%s\n" "no" >&6; }
+else $as_nop
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $winpthreads_source_dir$winpthreadsmsg" >&5
+printf "%s\n" "$winpthreads_source_dir$winpthreadsmsg" >&6; }
+      winpthreads_source_include_dir="$winpthreads_source_dir/include"
+
+
+  saved_CC="$CC"
+  saved_CFLAGS="$CFLAGS"
+  saved_CPPFLAGS="$CPPFLAGS"
+  saved_LIBS="$LIBS"
+  saved_ac_ext="$ac_ext"
+  saved_ac_compile="$ac_compile"
+  # Move the content of confdefs.h to another file so it does not
+  # get included
+  mv confdefs.h confdefs.h.bak
+  touch confdefs.h
+
+
+  if test -n "$winpthreads_source_include_dir"
+then :
+  CPPFLAGS="-I $winpthreads_source_include_dir $CPPFLAGS"
+fi
+  ac_fn_c_check_header_compile "$LINENO" "pthread.h" "ac_cv_header_pthread_h" "$ac_includes_default"
+if test "x$ac_cv_header_pthread_h" = xyes
+then :
+
+else $as_nop
+  as_fn_error $? "cannot find or use pthread.h from winpthreads" "$LINENO" 5
+fi
+
+
+
+  # Restore the content of confdefs.h
+  mv confdefs.h.bak confdefs.h
+  ac_compile="$saved_ac_compile"
+  ac_ext="$saved_ac_ext"
+  CPPFLAGS="$saved_CPPFLAGS"
+  CFLAGS="$saved_CFLAGS"
+  CC="$saved_CC"
+  LIBS="$saved_LIBS"
+
+
+fi ;; #(
+  *) :
+    if test x"$with_winpthreads_msvc" != 'x'
+then :
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: requested but not supported" >&5
+printf "%s\n" "requested but not supported" >&6; }
+      as_fn_error $? "exiting" "$LINENO" 5
+else $as_nop
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: skipping on that platform" >&5
+printf "%s\n" "skipping on that platform" >&6; }
+fi ;;
+esac
+fi
+
+## Program to use to install files
+
+  # Find a good install program.  We prefer a C program (faster),
+# so one script is as good as another.  But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
 # AIX /bin/install
 # AmigaOS /C/install, which installs bootblocks on floppy discs
 # AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
@@ -14678,13 +14941,6 @@ then :
 
 fi
 
-ac_fn_c_check_header_compile "$LINENO" "stdint.h" "ac_cv_header_stdint_h" "$ac_includes_default"
-if test "x$ac_cv_header_stdint_h" = xyes
-then :
-  printf "%s\n" "#define HAS_STDINT_H 1" >>confdefs.h
-
-fi
-
 ac_fn_c_check_header_compile "$LINENO" "pthread_np.h" "ac_cv_header_pthread_np_h" "$ac_includes_default"
 if test "x$ac_cv_header_pthread_np_h" = xyes
 then :
@@ -14710,21 +14966,26 @@ then :
 fi
 
 
-ac_fn_c_check_header_compile "$LINENO" "stdatomic.h" "ac_cv_header_stdatomic_h" "$ac_includes_default"
-if test "x$ac_cv_header_stdatomic_h" = xyes
+ac_fn_c_check_header_compile "$LINENO" "sys/mman.h" "ac_cv_header_sys_mman_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_mman_h" = xyes
 then :
-  printf "%s\n" "#define HAS_STDATOMIC_H 1" >>confdefs.h
+  printf "%s\n" "#define HAS_SYS_MMAN_H 1" >>confdefs.h
 
 fi
 
 
-ac_fn_c_check_header_compile "$LINENO" "sys/mman.h" "ac_cv_header_sys_mman_h" "$ac_includes_default"
-if test "x$ac_cv_header_sys_mman_h" = xyes
+case $host in #(
+  *-*-linux*) :
+    ac_fn_c_check_header_compile "$LINENO" "linux/futex.h" "ac_cv_header_linux_futex_h" "$ac_includes_default"
+if test "x$ac_cv_header_linux_futex_h" = xyes
 then :
-  printf "%s\n" "#define HAS_SYS_MMAN_H 1" >>confdefs.h
+  printf "%s\n" "#define HAS_LINUX_FUTEX_H 1" >>confdefs.h
 
 fi
-
+ ;; #(
+  *) :
+     ;;
+esac
 
 # Checks for types
 
@@ -15305,6 +15566,17 @@ fi
 esac
 fi
 
+ac_fn_c_check_type "$LINENO" "max_align_t" "ac_cv_type_max_align_t" "#include <stddef.h>
+"
+if test "x$ac_cv_type_max_align_t" = xyes
+then :
+
+printf "%s\n" "#define HAVE_MAX_ALIGN_T 1" >>confdefs.h
+
+
+fi
+
+
 # Atomics library
 
 if ! $arch64
@@ -15320,25 +15592,202 @@ fi
 # Support for C11 atomic types
 
 
-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports _Atomic types" >&5
-printf %s "checking whether the C compiler supports _Atomic types... " >&6; }
+
+  saved_CC="$CC"
+  saved_CFLAGS="$CFLAGS"
+  saved_CPPFLAGS="$CPPFLAGS"
   saved_LIBS="$LIBS"
-  LIBS="$LIBS $cclibs"
+  saved_ac_ext="$ac_ext"
+  saved_ac_compile="$ac_compile"
+  # Move the content of confdefs.h to another file so it does not
+  # get included
+  mv confdefs.h confdefs.h.bak
+  touch confdefs.h
+
+
+  opts=""
+  if test -n ""
+then :
+  CFLAGS="$CFLAGS "; opts=""
+fi
+  if test -n "$cclibs"
+then :
+  LIBS="$LIBS $cclibs"; opts="${opts:+$opts }$cclibs"
+fi
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if $CC supports _Atomic types with ${opts:-no additional options}" >&5
+printf %s "checking if $CC supports _Atomic types with ${opts:-no additional options}... " >&6; }
+
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
 /* end confdefs.h.  */
 
-    #include <stdint.h>
-    #include <stdatomic.h>
-    int main(void)
-    {
-      _Atomic int64_t n;
-      int m;
-      int * _Atomic p = &m;
-      atomic_store_explicit(&n, 123, memory_order_release);
-      * atomic_exchange(&p, 0) = 45;
-      return atomic_load_explicit(&n, memory_order_acquire);
-    }
+#include <stdint.h>
+#include <stdatomic.h>
+
+int
+main (void)
+{
+
+  _Atomic int64_t n;
+  int m;
+  int * _Atomic p = &m;
+  atomic_store_explicit(&n, 123, memory_order_release);
+  * atomic_exchange(&p, 0) = 45;
+  if (atomic_load_explicit(&n, memory_order_acquire))
+    return 1;
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"
+then :
+  cc_supports_atomic=true
+   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+printf "%s\n" "yes" >&6; }
+else $as_nop
+  cc_supports_atomic=false
+   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
+printf "%s\n" "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam \
+    conftest$ac_exeext conftest.$ac_ext
+
+
+  # Restore the content of confdefs.h
+  mv confdefs.h.bak confdefs.h
+  ac_compile="$saved_ac_compile"
+  ac_ext="$saved_ac_ext"
+  CPPFLAGS="$saved_CPPFLAGS"
+  CFLAGS="$saved_CFLAGS"
+  CC="$saved_CC"
+  LIBS="$saved_LIBS"
+
+
+case $cc_supports_atomic,$ocaml_cc_vendor in #(
+  false,msvc-*) :
+
+
+  saved_CC="$CC"
+  saved_CFLAGS="$CFLAGS"
+  saved_CPPFLAGS="$CPPFLAGS"
+  saved_LIBS="$LIBS"
+  saved_ac_ext="$ac_ext"
+  saved_ac_compile="$ac_compile"
+  # Move the content of confdefs.h to another file so it does not
+  # get included
+  mv confdefs.h confdefs.h.bak
+  touch confdefs.h
+
+
+  opts=""
+  if test -n "-std:c11"
+then :
+  CFLAGS="$CFLAGS -std:c11"; opts="-std:c11"
+fi
+  if test -n ""
+then :
+  LIBS="$LIBS "; opts="${opts:+$opts }"
+fi
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if $CC supports _Atomic types with ${opts:-no additional options}" >&5
+printf %s "checking if $CC supports _Atomic types with ${opts:-no additional options}... " >&6; }
+
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+#include <stdint.h>
+#include <stdatomic.h>
+
+int
+main (void)
+{
+
+  _Atomic int64_t n;
+  int m;
+  int * _Atomic p = &m;
+  atomic_store_explicit(&n, 123, memory_order_release);
+  * atomic_exchange(&p, 0) = 45;
+  if (atomic_load_explicit(&n, memory_order_acquire))
+    return 1;
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"
+then :
+  cc_supports_atomic=true
+   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+printf "%s\n" "yes" >&6; }
+else $as_nop
+  cc_supports_atomic=false
+   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
+printf "%s\n" "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam \
+    conftest$ac_exeext conftest.$ac_ext
+
+
+  # Restore the content of confdefs.h
+  mv confdefs.h.bak confdefs.h
+  ac_compile="$saved_ac_compile"
+  ac_ext="$saved_ac_ext"
+  CPPFLAGS="$saved_CPPFLAGS"
+  CFLAGS="$saved_CFLAGS"
+  CC="$saved_CC"
+  LIBS="$saved_LIBS"
+
+
+     if $cc_supports_atomic
+then :
+  common_cflags="$common_cflags -std:c11"
+else $as_nop
+
+
+  saved_CC="$CC"
+  saved_CFLAGS="$CFLAGS"
+  saved_CPPFLAGS="$CPPFLAGS"
+  saved_LIBS="$LIBS"
+  saved_ac_ext="$ac_ext"
+  saved_ac_compile="$ac_compile"
+  # Move the content of confdefs.h to another file so it does not
+  # get included
+  mv confdefs.h confdefs.h.bak
+  touch confdefs.h
+
+
+  opts=""
+  if test -n "-std:c11 -experimental:c11atomics"
+then :
+  CFLAGS="$CFLAGS -std:c11 -experimental:c11atomics"; opts="-std:c11 -experimental:c11atomics"
+fi
+  if test -n ""
+then :
+  LIBS="$LIBS "; opts="${opts:+$opts }"
+fi
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if $CC supports _Atomic types with ${opts:-no additional options}" >&5
+printf %s "checking if $CC supports _Atomic types with ${opts:-no additional options}... " >&6; }
+
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+#include <stdint.h>
+#include <stdatomic.h>
+
+int
+main (void)
+{
 
+  _Atomic int64_t n;
+  int m;
+  int * _Atomic p = &m;
+  atomic_store_explicit(&n, 123, memory_order_release);
+  * atomic_exchange(&p, 0) = 45;
+  if (atomic_load_explicit(&n, memory_order_acquire))
+    return 1;
+
+  ;
+  return 0;
+}
 _ACEOF
 if ac_fn_c_try_link "$LINENO"
 then :
@@ -15352,8 +15801,27 @@ printf "%s\n" "no" >&6; }
 fi
 rm -f core conftest.err conftest.$ac_objext conftest.beam \
     conftest$ac_exeext conftest.$ac_ext
+
+
+  # Restore the content of confdefs.h
+  mv confdefs.h.bak confdefs.h
+  ac_compile="$saved_ac_compile"
+  ac_ext="$saved_ac_ext"
+  CPPFLAGS="$saved_CPPFLAGS"
+  CFLAGS="$saved_CFLAGS"
+  CC="$saved_CC"
   LIBS="$saved_LIBS"
 
+
+        if $cc_supports_atomic
+then :
+  common_cflags="$common_cflags -std:c11 -experimental:c11atomics"
+fi
+
+fi ;; #(
+  *) :
+     ;;
+esac
 if ! $cc_supports_atomic
 then :
   { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
@@ -15366,7 +15834,7 @@ fi
 # macOS and MinGW-w64 have problems with thread local storage accessed from DLLs
 
 case $host in #(
-  *-apple-darwin*|*-mingw32*) :
+  *-apple-darwin*|*-mingw32*|*-pc-windows) :
      ;; #(
   *) :
     printf "%s\n" "#define HAS_FULL_THREAD_VARIABLES 1" >>confdefs.h
@@ -15562,46 +16030,70 @@ esac
 # Try to work around the Skylake/Kaby Lake processor bug.
 case "$ocaml_cc_vendor,$host" in #(
   *gcc*,x86_64-*|*gcc*,i686-*) :
+    as_CACHEVAR=`printf "%s\n" "ax_cv_check_cflags_$warn_error_flag_-fno-tree-vrp" | $as_tr_sh`
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler accepts -fno-tree-vrp" >&5
+printf %s "checking whether the C compiler accepts -fno-tree-vrp... " >&6; }
+if eval test \${$as_CACHEVAR+y}
+then :
+  printf %s "(cached) " >&6
+else $as_nop
 
-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports -fno-tree-vrp" >&5
-printf %s "checking whether the C compiler supports -fno-tree-vrp... " >&6; }
-  saved_CFLAGS="$CFLAGS"
-  CFLAGS="-Werror -fno-tree-vrp $CFLAGS"
+  ax_check_save_flags=$CFLAGS
+  CFLAGS="$CFLAGS $warn_error_flag -fno-tree-vrp"
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
 /* end confdefs.h.  */
-int main() { return 0; }
+
+int
+main (void)
+{
+
+  ;
+  return 0;
+}
 _ACEOF
 if ac_fn_c_try_compile "$LINENO"
 then :
-  cc_has_fno_tree_vrp=true
-    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-printf "%s\n" "yes" >&6; }
+  eval "$as_CACHEVAR=yes"
 else $as_nop
-  cc_has_fno_tree_vrp=false
-    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
-printf "%s\n" "no" >&6; }
+  eval "$as_CACHEVAR=no"
 fi
 rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
-  CFLAGS="$saved_CFLAGS"
-
-    if $cc_has_fno_tree_vrp
+  CFLAGS=$ax_check_save_flags
+fi
+eval ac_res=\$$as_CACHEVAR
+              { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+printf "%s\n" "$ac_res" >&6; }
+if eval test \"x\$"$as_CACHEVAR"\" = x"yes"
 then :
   internal_cflags="$internal_cflags -fno-tree-vrp"
-fi ;; #(
+else $as_nop
+  :
+fi
+ ;; #(
   *) :
      ;;
 esac
 
+## Check whether __attribute__((optimize("tree-vectorize")))) is supported
 
-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports __attribute__((aligned(n)))" >&5
-printf %s "checking whether the C compiler supports __attribute__((aligned(n)))... " >&6; }
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports __attribute__((optimize(\"tree-vectorize\")))" >&5
+printf %s "checking whether the C compiler supports __attribute__((optimize(\"tree-vectorize\")))... " >&6; }
+  saved_CFLAGS="$CFLAGS"
+  CFLAGS="-Werror $CFLAGS"
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
 /* end confdefs.h.  */
-typedef struct {__attribute__((aligned(8))) int t;} t;
+__attribute__((optimize("tree-vectorize"))) void f(void) {}
+int
+main (void)
+{
+f();
+  ;
+  return 0;
+}
 _ACEOF
 if ac_fn_c_try_compile "$LINENO"
 then :
-  printf "%s\n" "#define SUPPORTS_ALIGNED_ATTRIBUTE 1" >>confdefs.h
+  printf "%s\n" "#define SUPPORTS_TREE_VECTORIZE 1" >>confdefs.h
 
     { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
 printf "%s\n" "yes" >&6; }
@@ -15610,32 +16102,50 @@ else $as_nop
 printf "%s\n" "no" >&6; }
 fi
 rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
+  CFLAGS="$saved_CFLAGS"
 
-## Check whether __attribute__((optimize("tree-vectorize")))) is supported
 
-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports __attribute__((optimize(\"tree-vectorize\")))" >&5
-printf %s "checking whether the C compiler supports __attribute__((optimize(\"tree-vectorize\")))... " >&6; }
-  saved_CFLAGS="$CFLAGS"
-  CFLAGS="-Werror $CFLAGS"
+# Check whether the C compiler supports the labels as values extension.
+
+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC supports the labels as values extension" >&5
+printf %s "checking whether $CC supports the labels as values extension... " >&6; }
+if test ${ocaml_cv_prog_cc_labels_as_values+y}
+then :
+  printf %s "(cached) " >&6
+else $as_nop
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
 /* end confdefs.h.  */
 
-       __attribute__((optimize("tree-vectorize"))) void f(void){}
-       int main() { f(); return 0; }
+int
+main (void)
+{
+
+  void *ptr;
+  ptr = &&foo;
+  goto *ptr;
+  return 1;
+  foo:
 
+  ;
+  return 0;
+}
 _ACEOF
 if ac_fn_c_try_compile "$LINENO"
 then :
-  printf "%s\n" "#define SUPPORTS_TREE_VECTORIZE 1" >>confdefs.h
-
-    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-printf "%s\n" "yes" >&6; }
+  ocaml_cv_prog_cc_labels_as_values=yes
 else $as_nop
-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
-printf "%s\n" "no" >&6; }
+  ocaml_cv_prog_cc_labels_as_values=no
 fi
 rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
-  CFLAGS="$saved_CFLAGS"
+
+fi
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ocaml_cv_prog_cc_labels_as_values" >&5
+printf "%s\n" "$ocaml_cv_prog_cc_labels_as_values" >&6; }
+  if test "x$ocaml_cv_prog_cc_labels_as_values" = xyes; then
+
+printf "%s\n" "#define HAVE_LABELS_AS_VALUES 1" >>confdefs.h
+
+  fi
 
 
 # Configure the native-code compiler
@@ -15668,7 +16178,7 @@ case $host in #(
   i686-pc-windows) :
     arch=i386; system=win32 ;; #(
   x86_64-pc-windows) :
-    arch=amd64; system=win64 ;; #(
+    has_native_backend=yes; arch=amd64; system=win64 ;; #(
   powerpc64le*-*-linux*) :
     has_native_backend=yes; arch=power; model=ppc64le; system=linux ;; #(
   powerpc64*-*-linux-musl*) :
@@ -15762,8 +16272,9 @@ case $arch in #(
 esac
 
 native_cflags=''
-native_cppflags="-DTARGET_${arch} -DMODEL_${model} -DSYS_${system}"
-
+oc_native_cflags=''
+oc_native_cppflags="-DNATIVE_CODE\
+ -DTARGET_${arch} -DMODEL_${model} -DSYS_${system}"
 case $ccomptype in #(
   msvc) :
     runtime_asm_objects=${arch}nt.${OBJEXT} ;; #(
@@ -16187,13 +16698,17 @@ esac
 else $as_nop
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
 /* end confdefs.h.  */
-
 #include <math.h>
-int main (void) {
+int
+main (void)
+{
+
   static volatile double d = 0.49999999999999994449;
-  return (fpclassify(round(d)) != FP_ZERO);
-}
+  if (fpclassify(round(d)) != FP_ZERO) return 1;
 
+  ;
+  return 0;
+}
 _ACEOF
 if ac_fn_c_try_run "$LINENO"
 then :
@@ -16229,8 +16744,8 @@ fi
   cross_compiling="$old_cross_compiling"
 
 
-  # Check whether fma works (regressed in mingw-w64 8.0.0; present, but broken,
-  # in VS2013-2017 and present but unimplemented in Cygwin64)
+  # Check whether fma works (regressed in mingw-w64 8.0.0; and present but
+  # unimplemented in Cygwin64)
 
   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether fma works" >&5
 printf %s "checking whether fma works... " >&6; }
@@ -16255,11 +16770,13 @@ esac
 else $as_nop
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
 /* end confdefs.h.  */
-
 #include <math.h>
-int main (void) {
+int
+main (void)
+{
+
   /* Tests 264-266 from testsuite/tests/fma/fma.ml. These tests trigger the
-     broken implementations of Cygwin64, mingw-w64 (x86_64) and VS2013-2017.
+     broken implementations of Cygwin64 and mingw-w64 (x86_64).
      The static volatile variables aim to thwart GCC's constant folding. */
   static volatile double x, y, z;
   volatile double t264, t265, t266;
@@ -16275,15 +16792,18 @@ int main (void) {
   y = 0x4p-540;
   z = 0x4p-1076;
   t266 = fma(x, y, z);
-  return (!(t264 == 0x1.0989687cp-1044 ||
-            t264 == 0x0.000004277ca1fp-1022 || /* Acceptable emulated values */
-            t264 == 0x0.00000428p-1022)
-       || !(t265 == 0x1.0988p-1060 ||
-            t265 == 0x0.0000000004278p-1022 ||  /* Acceptable emulated values */
-            t265 == 0x0.000000000428p-1022)
-       || !(t266 == 0x8p-1076));
-}
+  if (!(t264 == 0x1.0989687cp-1044 ||
+        t264 == 0x0.000004277ca1fp-1022 || /* Acceptable emulated values */
+        t264 == 0x0.00000428p-1022)
+   || !(t265 == 0x1.0988p-1060 ||
+        t265 == 0x0.0000000004278p-1022 ||  /* Acceptable emulated values */
+        t265 == 0x0.000000000428p-1022)
+   || !(t266 == 0x8p-1076))
+    return 1;
 
+  ;
+  return 0;
+}
 _ACEOF
 if ac_fn_c_try_run "$LINENO"
 then :
@@ -16301,18 +16821,8 @@ printf "%s\n" "no" >&6; }
     hard_error=false ;; #(
   *,x86_64-w64-mingw32*|*,x86_64-*-cygwin*) :
     hard_error=false ;; #(
-  *) :
-    case $ocaml_cc_vendor in #(
-  msvc-*) :
-    if test "${ocaml_cc_vendor#msvc-}" -lt 1920
-then :
-  hard_error=false
-else $as_nop
-  hard_error=true
-fi ;; #(
   *) :
     hard_error=true ;;
-esac ;;
 esac
     if test x"$hard_error" = "xtrue"
 then :
@@ -16331,122 +16841,18 @@ fi
 
 else $as_nop
   if test x"$enable_imprecise_c99_float_ops" != "xyes"
-then :
-  case $enable_imprecise_c99_float_ops,$ocaml_cc_vendor in #(
-  no,*) :
-    hard_error=true ;; #(
-  ,msvc-*) :
-    if test "${ocaml_cc_vendor#msvc-}" -lt 1800
-then :
-  hard_error=false
-else $as_nop
-  hard_error=true
-fi ;; #(
-  *) :
-    hard_error=true ;;
-esac
-     if test x"$hard_error" = 'xtrue'
 then :
   as_fn_error $? "C99 float ops unavailable, enable replacements with --enable-imprecise-c99-float-ops" "$LINENO" 5
-else $as_nop
-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: C99 float ops unavailable, replacements enabled (ancient Visual Studio)" >&5
-printf "%s\n" "$as_me: WARNING: C99 float ops unavailable, replacements enabled (ancient Visual Studio)" >&2;}
-fi
 fi
 fi
 
 ## getentropy
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC options needed to detect all undeclared functions" >&5
-printf %s "checking for $CC options needed to detect all undeclared functions... " >&6; }
-if test ${ac_cv_c_undeclared_builtin_options+y}
-then :
-  printf %s "(cached) " >&6
-else $as_nop
-  ac_save_CFLAGS=$CFLAGS
-   ac_cv_c_undeclared_builtin_options='cannot detect'
-   for ac_arg in '' -fno-builtin; do
-     CFLAGS="$ac_save_CFLAGS $ac_arg"
-     # This test program should *not* compile successfully.
-     cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h.  */
-
-int
-main (void)
-{
-(void) strchr;
-  ;
-  return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"
-then :
-
-else $as_nop
-  # This test program should compile successfully.
-        # No library function is consistently available on
-        # freestanding implementations, so test against a dummy
-        # declaration.  Include always-available headers on the
-        # off chance that they somehow elicit warnings.
-        cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h.  */
-#include <float.h>
-#include <limits.h>
-#include <stdarg.h>
-#include <stddef.h>
-extern void ac_decl (int, char *);
-
-int
-main (void)
-{
-(void) ac_decl (0, (char *) 0);
-  (void) ac_decl;
-
-  ;
-  return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"
-then :
-  if test x"$ac_arg" = x
-then :
-  ac_cv_c_undeclared_builtin_options='none needed'
-else $as_nop
-  ac_cv_c_undeclared_builtin_options=$ac_arg
-fi
-          break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
-    done
-    CFLAGS=$ac_save_CFLAGS
-
-fi
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_undeclared_builtin_options" >&5
-printf "%s\n" "$ac_cv_c_undeclared_builtin_options" >&6; }
-  case $ac_cv_c_undeclared_builtin_options in #(
-  'cannot detect') :
-    { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error $? "cannot make $CC report undeclared builtins
-See \`config.log' for more details" "$LINENO" 5; } ;; #(
-  'none needed') :
-    ac_c_undeclared_builtin_options='' ;; #(
-  *) :
-    ac_c_undeclared_builtin_options=$ac_cv_c_undeclared_builtin_options ;;
-esac
-
-ac_fn_c_check_header_compile "$LINENO" "unistd.h" "ac_cv_header_unistd_h" "$ac_includes_default"
-if test "x$ac_cv_header_unistd_h" = xyes
-then :
-  ac_fn_check_decl "$LINENO" "getentropy" "ac_cv_have_decl_getentropy" "#include <unistd.h>
-" "$ac_c_undeclared_builtin_options" "CFLAGS"
-if test "x$ac_cv_have_decl_getentropy" = xyes
+ac_fn_c_check_func "$LINENO" "getentropy" "ac_cv_func_getentropy"
+if test "x$ac_cv_func_getentropy" = xyes
 then :
   printf "%s\n" "#define HAS_GETENTROPY 1" >>confdefs.h
 
 fi
-fi
 
 
 ## getrusage
@@ -16505,7 +16911,6 @@ fi
 ## are always available.
 ## On Unix platforms, we check for the appropriate POSIX feature-test macros.
 ## On MacOS clock_gettime's CLOCK_MONOTONIC flag is not actually monotonic.
-## mach_timebase_info and mach_absolute_time are used instead.
 
 case $host in #(
   *-*-windows) :
@@ -16535,17 +16940,20 @@ done ;; #(
 
     #include <unistd.h>
     #include <time.h>
-    int main(void)
-    {
-      #if !(defined(_POSIX_TIMERS) && defined(_POSIX_MONOTONIC_CLOCK)   \
-         && _POSIX_MONOTONIC_CLOCK != (-1))
-        #error "no monotonic clock source"
-      #endif
-        return 0;
-     }
+    #if !(defined(_POSIX_TIMERS) && defined(_POSIX_MONOTONIC_CLOCK)   \
+       && _POSIX_MONOTONIC_CLOCK != (-1))
+      #error "no monotonic clock source"
+    #endif
+
+int
+main (void)
+{
 
+  ;
+  return 0;
+}
 _ACEOF
-if ac_fn_c_try_compile "$LINENO"
+if ac_fn_c_try_cpp "$LINENO"
 then :
 
       has_monotonic_clock=true
@@ -16555,7 +16963,7 @@ then :
 else $as_nop
   has_monotonic_clock=false
 fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
+rm -f conftest.err conftest.i conftest.$ac_ext
 
  ;;
 esac
@@ -16793,7 +17201,7 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam \
   gcc-[0123456789]-*|gcc-10-*|clang-*) :
      ;; #(
   *) :
-    oc_tsan_cflags="$oc_tsan_cflags -Wno-tsan" ;;
+    tsan_cflags="$tsan_cflags -Wno-tsan" ;;
 esac
   case $ocaml_cc_vendor in #(
   gcc*) :
@@ -16804,8 +17212,8 @@ esac
      ;;
 esac
   as_CACHEVAR=`printf "%s\n" "ax_cv_check_cflags_$warn_error_flag_-fsanitize=thread $tsan_distinguish_volatile_cflags" | $as_tr_sh`
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether C compiler accepts -fsanitize=thread $tsan_distinguish_volatile_cflags" >&5
-printf %s "checking whether C compiler accepts -fsanitize=thread $tsan_distinguish_volatile_cflags... " >&6; }
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler accepts -fsanitize=thread $tsan_distinguish_volatile_cflags" >&5
+printf %s "checking whether the C compiler accepts -fsanitize=thread $tsan_distinguish_volatile_cflags... " >&6; }
 if eval test \${$as_CACHEVAR+y}
 then :
   printf %s "(cached) " >&6
@@ -16843,10 +17251,11 @@ else $as_nop
   as_fn_error $? "The C compiler does not support the \`$tsan_distinguish_volatile_cflags' flag. Try upgrading to GCC >= 11, or to Clang >= 11." "$LINENO" 5
 fi
 
-  oc_tsan_cflags="$oc_tsan_cflags $tsan_distinguish_volatile_cflags"
-  common_cppflags="$common_cppflags $oc_tsan_cppflags"
-  native_cflags="$native_cflags $oc_tsan_cflags"
-  ocamlc_cflags="$ocamlc_cflags $oc_tsan_cflags"
+  tsan_cflags="$tsan_cflags $tsan_distinguish_volatile_cflags"
+  oc_native_cppflags="$oc_native_cppflags $tsan_cppflags"
+  oc_native_cflags="$oc_native_cflags $tsan_cflags"
+  native_cflags="$native_cflags $tsan_cflags"
+  native_ldflags="$native_ldflags $tsan_ldflags"
   tsan_native_runtime_c_sources="tsan"
 else $as_nop
   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not using thread sanitizer" >&5
@@ -16905,8 +17314,8 @@ then :
   libunwind_ldflags="$LIBUNWIND_LDFLAGS $libunwind_ldflags"
 fi
 
-  native_cppflags="$native_cppflags $libunwind_cppflags"
-  native_ldflags="$native_ldflags -fsanitize=thread $libunwind_ldflags"
+  oc_native_cppflags="$oc_native_cppflags $libunwind_cppflags"
+  native_ldflags="$native_ldflags $libunwind_ldflags"
 
 
   SAVED_CPPFLAGS="$CPPFLAGS"
@@ -17384,51 +17793,29 @@ esac
 
 if $ipv6
 then :
-  ac_fn_c_check_func "$LINENO" "getaddrinfo" "ac_cv_func_getaddrinfo"
-if test "x$ac_cv_func_getaddrinfo" = xyes
-then :
-
-else $as_nop
-  ipv6=false
-fi
-
-fi
-
-if $ipv6
-then :
-  ac_fn_c_check_func "$LINENO" "getnameinfo" "ac_cv_func_getnameinfo"
-if test "x$ac_cv_func_getnameinfo" = xyes
-then :
-
-else $as_nop
-  ipv6=false
-fi
-
-fi
 
-if $ipv6
-then :
-  ac_fn_c_check_func "$LINENO" "inet_pton" "ac_cv_func_inet_pton"
-if test "x$ac_cv_func_inet_pton" = xyes
+  for ac_func in getaddrinfo getnameinfo inet_pton inet_ntop
+do :
+  as_ac_var=`printf "%s\n" "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+if eval test \"x\$"$as_ac_var"\" = x"yes"
 then :
+  cat >>confdefs.h <<_ACEOF
+#define `printf "%s\n" "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
 
 else $as_nop
   ipv6=false
 fi
 
+done
 fi
-
 if $ipv6
-then :
-  ac_fn_c_check_func "$LINENO" "inet_ntop" "ac_cv_func_inet_ntop"
-if test "x$ac_cv_func_inet_ntop" = xyes
 then :
   printf "%s\n" "#define HAS_IPV6 1" >>confdefs.h
 
 fi
 
-fi
-
 ac_fn_c_check_func "$LINENO" "rewinddir" "ac_cv_func_rewinddir"
 if test "x$ac_cv_func_rewinddir" = xyes
 then :
@@ -17461,14 +17848,14 @@ then :
 fi
 
 
-ac_fn_check_decl "$LINENO" "system" "ac_cv_have_decl_system" "#include <stdlib.h>
-" "$ac_c_undeclared_builtin_options" "CFLAGS"
-if test "x$ac_cv_have_decl_system" = xyes
+ac_fn_c_check_func "$LINENO" "system" "ac_cv_func_system"
+if test "x$ac_cv_func_system" = xyes
 then :
   printf "%s\n" "#define HAS_SYSTEM 1" >>confdefs.h
 
 fi
 
+
 ## utime
 ## Note: this was defined in config/s-nt.h but the autoconf macros do not
 # seem to detect it properly on Windows so we hardcode the definition
@@ -17544,9 +17931,6 @@ if test "x$ac_cv_type_fd_set" = xyes
 then :
   printf "%s\n" "#define HAS_SELECT 1" >>confdefs.h
 
-    select=true
-else $as_nop
-  select=false
 fi
 
 fi
@@ -17970,78 +18354,83 @@ case $ocaml_cc_vendor,$host in #(
   sunc*,sparc-sun-*) :
     cc_has_debug_prefix_map=false ;; #(
   *) :
+    as_CACHEVAR=`printf "%s\n" "ax_cv_check_cflags_$warn_error_flag_-fdebug-prefix-map=old=new" | $as_tr_sh`
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler accepts -fdebug-prefix-map=old=new" >&5
+printf %s "checking whether the C compiler accepts -fdebug-prefix-map=old=new... " >&6; }
+if eval test \${$as_CACHEVAR+y}
+then :
+  printf %s "(cached) " >&6
+else $as_nop
 
-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler supports -fdebug-prefix-map" >&5
-printf %s "checking whether the C compiler supports -fdebug-prefix-map... " >&6; }
-  saved_CFLAGS="$CFLAGS"
-  CFLAGS="-fdebug-prefix-map=old=new $CFLAGS"
+  ax_check_save_flags=$CFLAGS
+  CFLAGS="$CFLAGS $warn_error_flag -fdebug-prefix-map=old=new"
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
 /* end confdefs.h.  */
-int main() { return 0; }
+
+int
+main (void)
+{
+
+  ;
+  return 0;
+}
 _ACEOF
 if ac_fn_c_try_compile "$LINENO"
+then :
+  eval "$as_CACHEVAR=yes"
+else $as_nop
+  eval "$as_CACHEVAR=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
+  CFLAGS=$ax_check_save_flags
+fi
+eval ac_res=\$$as_CACHEVAR
+              { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+printf "%s\n" "$ac_res" >&6; }
+if eval test \"x\$"$as_CACHEVAR"\" = x"yes"
 then :
   cc_has_debug_prefix_map=true
-    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-printf "%s\n" "yes" >&6; }
 else $as_nop
   cc_has_debug_prefix_map=false
-    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
-printf "%s\n" "no" >&6; }
 fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
-  CFLAGS="$saved_CFLAGS"
  ;;
 esac
 
 ## Does stat support nanosecond precision
 
 stat_has_ns_precision=false
-
 ac_fn_c_check_member "$LINENO" "struct stat" "st_atim.tv_nsec" "ac_cv_member_struct_stat_st_atim_tv_nsec" "
     $ac_includes_default
     #include <sys/stat.h>
-
 "
 if test "x$ac_cv_member_struct_stat_st_atim_tv_nsec" = xyes
 then :
-  stat_has_ns_precision=true
-  printf "%s\n" "#define HAS_NANOSECOND_STAT 1" >>confdefs.h
-
-fi
-
 
+printf "%s\n" "#define HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC 1" >>confdefs.h
 
-if ! $stat_has_ns_precision
-then :
-  ac_fn_c_check_member "$LINENO" "struct stat" "st_atimespec.tv_nsec" "ac_cv_member_struct_stat_st_atimespec_tv_nsec" "
-      $ac_includes_default
-      #include <sys/stat.h>
-
+stat_has_ns_precision=true
+fi
+ac_fn_c_check_member "$LINENO" "struct stat" "st_atimespec.tv_nsec" "ac_cv_member_struct_stat_st_atimespec_tv_nsec" "
+    $ac_includes_default
+    #include <sys/stat.h>
 "
 if test "x$ac_cv_member_struct_stat_st_atimespec_tv_nsec" = xyes
 then :
-  stat_has_ns_precision=true
-    printf "%s\n" "#define HAS_NANOSECOND_STAT 2" >>confdefs.h
 
-fi
+printf "%s\n" "#define HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC 1" >>confdefs.h
 
+stat_has_ns_precision=true
 fi
-
-if ! $stat_has_ns_precision
-then :
-  ac_fn_c_check_member "$LINENO" "struct stat" "st_atimensec" "ac_cv_member_struct_stat_st_atimensec" "
-      $ac_includes_default
-      #include <sys/stat.h>
-
+ac_fn_c_check_member "$LINENO" "struct stat" "st_atimensec" "ac_cv_member_struct_stat_st_atimensec" "
+    $ac_includes_default
+    #include <sys/stat.h>
 "
 if test "x$ac_cv_member_struct_stat_st_atimensec" = xyes
 then :
-  stat_has_ns_precision=true
-    printf "%s\n" "#define HAS_NANOSECOND_STAT 3" >>confdefs.h
 
-fi
+printf "%s\n" "#define HAVE_STRUCT_STAT_ST_ATIMENSEC 1" >>confdefs.h
 
+stat_has_ns_precision=true
 fi
 
 if $stat_has_ns_precision
@@ -18685,6 +19074,86 @@ fi
 zstd_status=""
 zstd_libs=""
 
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC options needed to detect all undeclared functions" >&5
+printf %s "checking for $CC options needed to detect all undeclared functions... " >&6; }
+if test ${ac_cv_c_undeclared_builtin_options+y}
+then :
+  printf %s "(cached) " >&6
+else $as_nop
+  ac_save_CFLAGS=$CFLAGS
+   ac_cv_c_undeclared_builtin_options='cannot detect'
+   for ac_arg in '' -fno-builtin; do
+     CFLAGS="$ac_save_CFLAGS $ac_arg"
+     # This test program should *not* compile successfully.
+     cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main (void)
+{
+(void) strchr;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"
+then :
+
+else $as_nop
+  # This test program should compile successfully.
+        # No library function is consistently available on
+        # freestanding implementations, so test against a dummy
+        # declaration.  Include always-available headers on the
+        # off chance that they somehow elicit warnings.
+        cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <float.h>
+#include <limits.h>
+#include <stdarg.h>
+#include <stddef.h>
+extern void ac_decl (int, char *);
+
+int
+main (void)
+{
+(void) ac_decl (0, (char *) 0);
+  (void) ac_decl;
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"
+then :
+  if test x"$ac_arg" = x
+then :
+  ac_cv_c_undeclared_builtin_options='none needed'
+else $as_nop
+  ac_cv_c_undeclared_builtin_options=$ac_arg
+fi
+          break
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
+    done
+    CFLAGS=$ac_save_CFLAGS
+
+fi
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_undeclared_builtin_options" >&5
+printf "%s\n" "$ac_cv_c_undeclared_builtin_options" >&6; }
+  case $ac_cv_c_undeclared_builtin_options in #(
+  'cannot detect') :
+    { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot make $CC report undeclared builtins
+See \`config.log' for more details" "$LINENO" 5; } ;; #(
+  'none needed') :
+    ac_c_undeclared_builtin_options='' ;; #(
+  *) :
+    ac_c_undeclared_builtin_options=$ac_cv_c_undeclared_builtin_options ;;
+esac
+
 if test x"$with_zstd" != "xno"
 then :
   # Try pkg-config first, as it gives the most reliable results
@@ -18898,9 +19367,50 @@ esac
 
 case $host in #(
   *-*-mingw32*) :
-    PTHREAD_LIBS="-l:libpthread.a -lgcc_eh" ;; #(
+    link_gcc_eh=''
+     { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for printf in -lgcc_eh" >&5
+printf %s "checking for printf in -lgcc_eh... " >&6; }
+if test ${ac_cv_lib_gcc_eh_printf+y}
+then :
+  printf %s "(cached) " >&6
+else $as_nop
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lgcc_eh  $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+char printf ();
+int
+main (void)
+{
+return printf ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"
+then :
+  ac_cv_lib_gcc_eh_printf=yes
+else $as_nop
+  ac_cv_lib_gcc_eh_printf=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gcc_eh_printf" >&5
+printf "%s\n" "$ac_cv_lib_gcc_eh_printf" >&6; }
+if test "x$ac_cv_lib_gcc_eh_printf" = xyes
+then :
+  link_gcc_eh="-lgcc_eh"
+fi
+
+     PTHREAD_LIBS="-l:libpthread.a $link_gcc_eh" ;; #(
   *-pc-windows) :
-    PTHREAD_LIBS="-l:libpthread.lib" ;; #(
+    PTHREAD_LIBS='' ;; #(
   *) :
 
 
@@ -19650,7 +20160,7 @@ test -n "$PTHREAD_CXX" || PTHREAD_CXX="$CXX"
 
 # Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
 if test "x$ax_pthread_ok" = "xyes"; then
-        common_cflags="$common_cflags $PTHREAD_CFLAGS"
+
     # The two following lines add flags and libraries for pthread to the
     # global CFLAGS and LIBS variables. This means that all the subsequent
     # tests can rely on the assumption that pthread is enabled.
@@ -19754,6 +20264,7 @@ printf "%s\n" "$as_me: the threads library is disabled" >&6;} ;; #(
   ac_config_files="$ac_config_files otherlibs/systhreads/META"
 
   otherlibraries="$otherlibraries systhreads"
+  otherlibs="$otherlibs systhreads"
   lib_systhreads=true
   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: the threads library is supported" >&5
 printf "%s\n" "$as_me: the threads library is supported" >&6;} ;;
@@ -19806,7 +20317,7 @@ then :
     { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
 printf "%s\n" "yes" >&6; }
 else $as_nop
-  ashas_debug_prefix_map=false
+  as_has_debug_prefix_map=false
     { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
 printf "%s\n" "no" >&6; }
 fi
@@ -19937,14 +20448,20 @@ fi
 
 if test x"$enable_frame_pointers" = "xyes"
 then :
-  case "$host,$ocaml_cc_vendor" in #(
-  x86_64-*-linux*,gcc-*|x86_64-*-linux*,clang-*) :
+  case $host in #(
+  x86_64-*-linux*|x86_64-*-darwin*) :
+    case $ocaml_cc_vendor in #(
+  clang-*|gcc-*) :
     common_cflags="$common_cflags -g  -fno-omit-frame-pointer"
-      frame_pointers=true
-      printf "%s\n" "#define WITH_FRAME_POINTERS 1" >>confdefs.h
+         frame_pointers=true
+         printf "%s\n" "#define WITH_FRAME_POINTERS 1" >>confdefs.h
 
-      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: using frame pointers" >&5
+         { printf "%s\n" "$as_me:${as_lineno-$LINENO}: using frame pointers" >&5
 printf "%s\n" "$as_me: using frame pointers" >&6;} ;; #(
+  *) :
+    as_fn_error $? "frame pointers not supported on this platform" "$LINENO" 5
+       ;;
+esac ;; #(
   *) :
     as_fn_error $? "frame pointers not supported on this platform" "$LINENO" 5
    ;;
@@ -19980,7 +20497,10 @@ else $as_nop
    is running.
 */
 
-int main (int argc, char *argv[]){
+int
+main (void)
+{
+
   void *block;
   char *p;
   int i, res;
@@ -20001,9 +20521,10 @@ int main (int argc, char *argv[]){
   for (i = 0; i < huge_page_size; i += 4096){
     p[i] = (char) i;
   }
+
+  ;
   return 0;
 }
-
 _ACEOF
 if ac_fn_c_try_run "$LINENO"
 then :
@@ -20071,7 +20592,12 @@ then :
 
 fi
 
-
+if test x"$enable_ocamlobjinfo" != 'xno'
+then :
+  build_ocamlobjinfo=true
+else $as_nop
+  build_ocamlobjinfo=false
+fi
 
 case $enable_ocamltest,false in #(
   yes,*|,true) :
@@ -20181,11 +20707,11 @@ fi
 
 if $flambda
 then :
-  CMX_MAGIC_NUMBER=Caml1999y034
-  CMXA_MAGIC_NUMBER=Caml1999z034
+  CMX_MAGIC_NUMBER=Caml1999y035
+  CMXA_MAGIC_NUMBER=Caml1999z035
 else $as_nop
-  CMX_MAGIC_NUMBER=Caml1999Y034
-  CMXA_MAGIC_NUMBER=Caml1999Z034
+  CMX_MAGIC_NUMBER=Caml1999Y035
+  CMXA_MAGIC_NUMBER=Caml1999Z035
 fi
 
 if test x"$enable_cmm_invariants" = "xyes"
@@ -20219,16 +20745,20 @@ else $as_nop
 #include <stdio.h>
 #include <stdlib.h>
 
-int main (int argc, char *argv[]){
+int
+main (void)
+{
+
   void *block;
   block = mmap (NULL, 4096, PROT_READ | PROT_WRITE,
                 MAP_ANONYMOUS | MAP_PRIVATE | MAP_STACK,
                 -1, 0);
   if (block == MAP_FAILED)
      return 1;
+
+  ;
   return 0;
 }
-
 _ACEOF
 if ac_fn_c_try_run "$LINENO"
 then :
@@ -20281,7 +20811,7 @@ then :
   function_sections=false
 else $as_nop
   case $arch in #(
-  amd64|arm64) :
+  amd64|arm64|power|riscv|s390x) :
     # not supported on arm32, see issue #9124.
      case $target in #(
   *-cygwin*|*-mingw*|*-windows|*-apple-darwin*) :
@@ -20348,27 +20878,35 @@ fi
 
 oc_cflags="$common_cflags $internal_cflags"
 oc_cppflags="$common_cppflags $internal_cppflags"
-ocamlc_cflags="$ocamlc_cflags $common_cflags $sharedlib_cflags $CFLAGS"
-ocamlc_cppflags="$common_cppflags $CPPFLAGS"
+
+oc_bytecode_cflags="$oc_cflags"
+oc_bytecode_cppflags="$oc_cppflags"
+
+oc_native_cflags="$oc_cflags $oc_native_cflags"
+native_cflags="$common_cflags $native_cflags"
+oc_native_cppflags="$oc_cppflags $oc_native_cppflags"
+
+bytecode_cflags="$common_cflags $sharedlib_cflags\
+ $PTHREAD_CFLAGS $COMPILER_BYTECODE_CFLAGS"
+native_cflags="$native_cflags $PTHREAD_CFLAGS $COMPILER_NATIVE_CFLAGS"
+
+bytecode_cppflags="$common_cppflags $COMPILER_BYTECODE_CPPFLAGS"
+native_cppflags="$common_cppflags $COMPILER_NATIVE_CPPFLAGS"
 
 case $host in #(
   *-*-mingw32*) :
-    cclibs="$cclibs -lole32 -luuid -lversion" ;; #(
+    cclibs="$cclibs -lole32 -luuid -lversion -lshlwapi -lsynchronization" ;; #(
   *-pc-windows) :
-    # For whatever reason, flexlink includes -ladvapi32 for mingw-w64, but
-    # doesn't include advapi32.lib for MSVC
-    cclibs="$cclibs ole32.lib uuid.lib advapi32.lib version.lib" ;; #(
+    # For whatever reason, flexlink includes -ladvapi32 and -lshell32 for
+    # mingw-w64, but doesn't include advapi32.lib and shell32.lib for MSVC
+    cclibs="$cclibs ole32.lib uuid.lib advapi32.lib shell32.lib version.lib \
+shlwapi.lib synchronization.lib" ;; #(
   *) :
      ;;
 esac
 
 
 
-if $tsan
-then :
-  cclibs="$cclibs -fsanitize=thread"
-fi
-
 if test x"$libdir" = x'${exec_prefix}/lib'
 then :
   libdir="$libdir"/ocaml
@@ -20379,20 +20917,6 @@ then :
   mandir='${prefix}/man'
 fi
 
-case $host in #(
-  *-*-mingw32*|*-pc-windows) :
-    case $WINDOWS_UNICODE_MODE in #(
-  ansi) :
-    windows_unicode=0 ;; #(
-  compatible|"") :
-    windows_unicode=1 ;; #(
-  *) :
-    as_fn_error $? "unexpected windows unicode mode" "$LINENO" 5 ;;
-esac ;; #(
-  *) :
-    windows_unicode=0 ;;
-esac
-
 # Define default prefix correctly for the different Windows ports
 if test x"$prefix" = "xNONE"
 then :
@@ -20428,8 +20952,6 @@ case $host in #(
   *-*-mingw32*) :
     printf "%s\n" "#define HAS_BROKEN_PRINTF 1" >>confdefs.h
 
-    printf "%s\n" "#define HAS_STRERROR 1" >>confdefs.h
-
     printf "%s\n" "#define HAS_IPV6 1" >>confdefs.h
 
     printf "%s\n" "#define HAS_NICE 1" >>confdefs.h
@@ -20437,8 +20959,6 @@ case $host in #(
   *-pc-windows) :
     printf "%s\n" "#define HAS_BROKEN_PRINTF 1" >>confdefs.h
 
-    printf "%s\n" "#define HAS_STRERROR 1" >>confdefs.h
-
     printf "%s\n" "#define HAS_IPV6 1" >>confdefs.h
 
     printf "%s\n" "#define HAS_NICE 1" >>confdefs.h
@@ -20628,11 +21148,6 @@ fi
   # Construct $mkexe
   mkexe="$mkexe_cmd"
   mkexe_exp="$mkexe_cmd_exp"
-  if test -n "$mkexe_cflags"
-then :
-  mkexe="$mkexe $mkexe_cflags"
-    mkexe_exp="$mkexe_exp $common_cflags $CFLAGS"
-fi
   if test -n "$mkexe_extra_flags"
 then :
   mkexe="$mkexe $mkexe_extra_flags"
@@ -20698,32 +21213,21 @@ fi
   mkdll_exp="$mkdll_exp $mkdll_ldflags_exp"
   mkmaindll="$mkmaindll $mkdll_ldflags_exp"
   mkmaindll_exp="$mkmaindll_exp $mkdll_ldflags_exp"
-  # Do similarly with $mkexe_via_cc_ldflags_prefix, but this is only needed for
-  # the msvc ports.
-  if test -n "$mkexe_via_cc_ldflags_prefix"
+  mkexe_via_cc_ldflags="${mkexe_via_cc_ldflags_prefix}"
+  if test -n "${oc_exe_ldflags}"
 then :
-
-    mkexe_via_cc_ldflags=\
-"\$(addprefix ${mkexe_via_cc_ldflags_prefix},\$(OC_LDFLAGS) \$(LDFLAGS))"
-
-else $as_nop
-
-    mkexe_via_cc_ldflags='$(OC_LDFLAGS) $(LDFLAGS)'
-
+  mkexe_via_cc_ldflags="${mkexe_via_cc_ldflags}${oc_exe_ldflags} "
 fi
+  mkexe_via_cc_ldflags="${mkexe_via_cc_ldflags}\$(OC_LDFLAGS) \$(LDFLAGS)"
   # cl requires linker flags after the objects.
   if test "$ccomptype" = 'msvc'
 then :
   mkexe_via_cc_ldflags=\
-"\$(OUTPUTEXE)\$(1) \$(2) $mkexe_via_cc_ldflags"
+"/nologo \$(OUTPUTEXE)\$(1) \$(2) $mkexe_via_cc_ldflags"
 else $as_nop
   mkexe_via_cc_ldflags=\
 "$mkexe_via_cc_ldflags \$(OUTPUTEXE)\$(1) \$(2)"
 fi
-  if test -n "$mkexe_via_cc_extra_cmd"
-then :
-  mkexe_via_cc_ldflags="$mkexe_via_cc_ldflags $mkexe_via_cc_extra_cmd"
-fi
 
 
 : "${CONFIG_STATUS=./config.status}"
@@ -21115,7 +21619,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
 # report actual input values of CONFIG_FILES etc. instead of their
 # values after options handling.
 ac_log="
-This file was extended by OCaml $as_me 5.2.1, which was
+This file was extended by OCaml $as_me 5.3.0, which was
 generated by GNU Autoconf 2.71.  Invocation command line was
 
   CONFIG_FILES    = $CONFIG_FILES
@@ -21188,7 +21692,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\
 cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
 ac_cs_config='$ac_cs_config_escaped'
 ac_cs_version="\\
-OCaml config.status 5.2.1
+OCaml config.status 5.3.0
 configured by $0, generated by GNU Autoconf 2.71,
   with options \\"\$ac_cs_config\\"
 
@@ -21611,6 +22115,7 @@ do
     "manual/src/version.tex") CONFIG_FILES="$CONFIG_FILES manual/src/version.tex" ;;
     "manual/src/html_processing/src/common.ml") CONFIG_FILES="$CONFIG_FILES manual/src/html_processing/src/common.ml" ;;
     "ocamltest/ocamltest_config.ml") CONFIG_FILES="$CONFIG_FILES ocamltest/ocamltest_config.ml" ;;
+    "otherlibs/dynlink/dynlink_config.ml") CONFIG_FILES="$CONFIG_FILES otherlibs/dynlink/dynlink_config.ml" ;;
     "utils/config.common.ml") CONFIG_FILES="$CONFIG_FILES utils/config.common.ml" ;;
     "utils/config.generated.ml") CONFIG_FILES="$CONFIG_FILES utils/config.generated.ml" ;;
     "runtime/caml/exec.h") CONFIG_HEADERS="$CONFIG_HEADERS runtime/caml/exec.h" ;;
@@ -21624,6 +22129,9 @@ do
     "native-symlinks") CONFIG_COMMANDS="$CONFIG_COMMANDS native-symlinks" ;;
     "ocamldoc/META") CONFIG_FILES="$CONFIG_FILES ocamldoc/META" ;;
     "libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;;
+    "$dldir/dynlink_cmo_format.mli") CONFIG_LINKS="$CONFIG_LINKS $dldir/dynlink_cmo_format.mli:file_formats/cmo_format.mli" ;;
+    "$dldir/dynlink_cmxs_format.mli") CONFIG_LINKS="$CONFIG_LINKS $dldir/dynlink_cmxs_format.mli:file_formats/cmxs_format.mli" ;;
+    "$dldir/dynlink_platform_intf.mli") CONFIG_LINKS="$CONFIG_LINKS $dldir/dynlink_platform_intf.mli:$dldir/dynlink_platform_intf.ml" ;;
     "otherlibs/unix/META") CONFIG_FILES="$CONFIG_FILES otherlibs/unix/META" ;;
     "otherlibs/unix/unix.ml") CONFIG_LINKS="$CONFIG_LINKS otherlibs/unix/unix.ml:otherlibs/unix/unix_${unix_or_win32}.ml" ;;
     "otherlibs/str/META") CONFIG_FILES="$CONFIG_FILES otherlibs/str/META" ;;

diff --git a/configure.ac b/configure.ac
index dff57a2782dc6eeb683e80066cfc95f17a2facd8..64e6d7e160063c908119db68b1fd053e114a91e8 100644 (file)
--- a/configure.ac
+++ b/configure.ac
@@ -36,7 +36,6 @@ CONFIGURE_ARGS="$*"
 # rely on $CFLAGS because these cannot be processed by flexlink (and are not
 # passed)
 mkexe_cmd='$(CC)'
-mkexe_cflags='$(OC_CFLAGS) $(CFLAGS)'
 mkexe_extra_flags=''
 mkexe_via_cc_extra_cmd=''
 mkexe_ldflags_prefix=''
@@ -48,17 +47,18 @@ common_cflags=""
 common_cppflags=""
 internal_cflags=""
 internal_cppflags=""
-ocamlc_cflags=""
-ocamlc_cppflags=""
+bytecode_cflags=""
+bytecode_cppflags=""
 oc_ldflags=""
 oc_dll_ldflags=""
 oc_exe_ldflags=""
 
 tsan=false
-# Passed to the linker by ocamlopt when tsan is enabled
-oc_tsan_cflags="-fsanitize=thread"
-oc_tsan_cppflags="-DWITH_THREAD_SANITIZER"
+# TSan flags for each compilation stage
+tsan_cppflags="-DWITH_THREAD_SANITIZER"
+tsan_cflags="-fsanitize=thread"
 tsan_distinguish_volatile_cflags=""
+tsan_ldflags="-fsanitize=thread"
 
 # The C# compiler and its flags
 CSC=""
@@ -107,8 +107,8 @@ AC_SUBST([OCAML_VERSION_EXTRA], [OCAML__VERSION_EXTRA])
 AC_SUBST([OCAML_VERSION_SHORT], [OCAML__VERSION_SHORT])
 AC_DEFINE([MAGIC_NUMBER_PREFIX], ["][MAGIC_NUMBER__PREFIX]["])
 AC_DEFINE([MAGIC_NUMBER_VERSION], ["][MAGIC_NUMBER__VERSION]["])
-AC_SUBST([MAGIC_NUMBER_LENGTH], [MAGIC_NUMBER__LENGTH])
 AC_DEFINE([EXEC_MAGIC_LENGTH], [MAGIC_NUMBER__LENGTH])
+AC_SUBST([MAGIC_LENGTH], [MAGIC_NUMBER__LENGTH])
 AC_DEFINE([EXEC_FORMAT], ["][EXEC__FORMAT]["])
 AC_SUBST([EXEC_MAGIC_NUMBER], [EXEC__MAGIC_NUMBER])
 AC_SUBST([CMI_MAGIC_NUMBER], [CMI__MAGIC_NUMBER])
@@ -140,8 +140,14 @@ AC_SUBST([arch_specific_SOURCES])
 AC_SUBST([arch64])
 AC_SUBST([model])
 AC_SUBST([system])
+AC_SUBST([bytecode_cflags])
+AC_SUBST([bytecode_cppflags])
 AC_SUBST([native_cflags])
 AC_SUBST([native_cppflags])
+AC_SUBST([oc_bytecode_cflags])
+AC_SUBST([oc_bytecode_cppflags])
+AC_SUBST([oc_native_cflags])
+AC_SUBST([oc_native_cppflags])
 AC_SUBST([systhread_support])
 AC_SUBST([ocamlsrcdir])
 AC_SUBST([unix_or_win32])
@@ -154,26 +160,28 @@ AC_SUBST([fpic])
 AC_SUBST([mkexe])
 AC_SUBST([mkexe_exp])
 AC_SUBST([mkexedebugflag])
-AC_SUBST([mkexe_extra_flags])
 AC_SUBST([mkexe_via_cc_ldflags])
+AC_SUBST([mkexe_via_cc_extra_cmd])
 AC_SUBST([ccomptype])
 AC_SUBST([toolchain])
+AC_SUBST([common_cflags])
 AC_SUBST([oc_cflags])
 AC_SUBST([tsan])
 AC_SUBST([tsan_native_runtime_c_sources])
+AC_SUBST([common_cppflags])
 AC_SUBST([oc_cppflags])
 AC_SUBST([oc_ldflags])
 AC_SUBST([oc_dll_ldflags])
-AC_SUBST([oc_exe_ldflags])
 AC_SUBST([cclibs])
 AC_SUBST([native_ldflags])
 AC_SUBST([zstd_libs])
-AC_SUBST([ocamlc_cflags])
-AC_SUBST([ocamlc_cppflags])
+AC_SUBST([bytecode_cflags])
+AC_SUBST([bytecode_cppflags])
 AC_SUBST([flexdll_source_dir])
 AC_SUBST([bootstrapping_flexdll])
 AC_SUBST([flexdll_dir])
-AC_SUBST([flexlink_flags])
+AC_SUBST([winpthreads_source_dir])
+AC_SUBST([winpthreads_source_include_dir])
 AC_SUBST([shebangscripts])
 AC_SUBST([AR])
 AC_SUBST([mklib])
@@ -185,8 +193,8 @@ AC_SUBST([cmxs])
 AC_SUBST([debug_runtime])
 AC_SUBST([instrumented_runtime])
 AC_SUBST([instrumented_runtime_libs])
-AC_SUBST([has_monotonic_clock])
 AC_SUBST([otherlibraries])
+AC_SUBST([otherlibs])
 AC_SUBST([lib_dynlink])
 AC_SUBST([lib_runtime_events])
 AC_SUBST([lib_str])
@@ -210,6 +218,7 @@ AC_SUBST([ocamldoc_opt_target])
 AC_SUBST([with_ocamldoc])
 AC_SUBST([documentation_tool])
 AC_SUBST([documentation_tool_cmd])
+AC_SUBST([build_ocamlobjinfo])
 AC_SUBST([build_ocamltest])
 AC_SUBST([ocamltest])
 AC_SUBST([ocamltest_target])
@@ -239,8 +248,6 @@ AC_SUBST([function_sections])
 AC_SUBST([oc_native_compflags])
 AC_SUBST([afl])
 AC_SUBST([flexdll_chain])
-AC_SUBST([mkdll_ldflags_exp])
-AC_SUBST([mkexe_ldflags_exp])
 AC_SUBST([PACKLD])
 AC_SUBST([build_libraries_manpages])
 AC_SUBST([compute_deps])
@@ -248,7 +255,6 @@ AC_SUBST([ocaml_bindir])
 AC_SUBST([ocaml_libdir])
 AC_SUBST([QS])
 AC_SUBST([ar_supports_response_files])
-AC_SUBST([target_bindir])
 
 ## Generated files
 
@@ -258,6 +264,7 @@ AC_CONFIG_FILES([stdlib/sys.ml])
 AC_CONFIG_FILES([manual/src/version.tex])
 AC_CONFIG_FILES([manual/src/html_processing/src/common.ml])
 AC_CONFIG_FILES([ocamltest/ocamltest_config.ml])
+AC_CONFIG_FILES([otherlibs/dynlink/dynlink_config.ml])
 AC_CONFIG_FILES([utils/config.common.ml])
 AC_CONFIG_FILES([utils/config.generated.ml])
 AC_CONFIG_HEADERS([runtime/caml/exec.h])
@@ -301,8 +308,6 @@ AS_CASE([$host],
 # Systems that are known not to work, even in bytecode only.
 
 AS_CASE([$host],
-  [*-pc-windows],
-    [AC_MSG_ERROR([the MSVC compiler is not supported currently], 69)],
   [i386-*-solaris*],
     [AC_MSG_ERROR([Building for 32 bits target is not supported. \
 If your host is 64 bits, you can try with './configure CC="gcc -m64"' \
@@ -312,7 +317,7 @@ If your host is 64 bits, you can try with './configure CC="gcc -m64"' \
 
 AS_CASE([$host],
   [*-pc-windows],
-    [CC=cl
+    [AS_IF([test -z "$CC"], [CC=cl])
     ccomptype=msvc
     S=asm
     SO=dll
@@ -339,6 +344,15 @@ AC_ARG_VAR([AS], [which assembler to use])
 AC_ARG_VAR([ASPP], [which assembler (with preprocessor) to use])
 AC_ARG_VAR([PARTIALLD], [how to build partial (relocatable) object files])
 
+AC_ARG_VAR([COMPILER_BYTECODE_CFLAGS],
+  [CFLAGS for compiling C files to be linked with bytecode])
+AC_ARG_VAR([COMPILER_BYTECODE_CPPFLAGS],
+  [CPPFLAGS for compiling C files to be linked with bytecode])
+AC_ARG_VAR([COMPILER_NATIVE_CFLAGS],
+  [CFLAGS for compiling C files to be linked with native code])
+AC_ARG_VAR([COMPILER_NATIVE_CPPFLAGS],
+  [CPPFLAGS for compiling C files to be linked with native code])
+
 # Command-line arguments to configure
 
 AC_ARG_ENABLE([debug-runtime],
@@ -428,6 +442,9 @@ AC_ARG_WITH([odoc],
   [AS_HELP_STRING([--with-odoc],
     [build documentation with odoc])])
 
+AC_ARG_ENABLE([ocamlobjinfo],
+  [AS_HELP_STRING([--disable-ocamlobjinfo],
+    [do not build ocamlobjinfo])])
 
 AC_ARG_ENABLE([ocamltest],
   [AS_HELP_STRING([--disable-ocamltest],
@@ -555,6 +572,11 @@ AC_ARG_WITH([flexdll],
     [bootstrap FlexDLL from the given sources])],
   [AS_IF([test x"$withval" = 'xyes'],[with_flexdll=flexdll])])
 
+AC_ARG_WITH([winpthreads-msvc],
+  [AS_HELP_STRING([--with-winpthreads-msvc],
+    [build winpthreads (only for the MSVC port) from the given sources])],
+  [AS_IF([test x"$withval" = 'xyes'], [with_winpthreads_msvc=winpthreads])])
+
 AC_ARG_WITH([zstd],
   [AS_HELP_STRING([--without-zstd],
     [disable compression of compilation artefacts])])
@@ -671,7 +693,7 @@ AS_CASE([$ocaml_cc_vendor],
     [CPP="$CC -E -Qn" # suppress generation of Sun PRO ident string
     ocamltest_CPP="$CPP"],
   [msvc-*],
-    [CPP="$CC -nologo -EP"
+    [CPP="$CC -nologo -EP -TC"
     ocamltest_CPP="$CPP 2> nul"],
   [CPP="$CC -E -P"
   ocamltest_CPP="$CPP"])
@@ -693,7 +715,7 @@ ocamlsrcdir=${ocamlsrcdir%X}
 
 # Whether ar supports @FILE arguments
 
-AS_CASE([lt_cv_ar_at_file],
+AS_CASE([$lt_cv_ar_at_file],
   [no], [ar_supports_response_files=false],
   [ar_supports_response_files=true])
 
@@ -717,12 +739,21 @@ AS_CASE([$host],
   [exeext=''])
 
 otherlibraries="dynlink runtime_events"
+otherlibs="runtime_events"
+optional_libraries="$optional_libraries otherlibs/dynlink/dynlink"
 lib_dynlink=true
+dldir=otherlibs/dynlink
+AC_CONFIG_LINKS([
+  $dldir/dynlink_cmo_format.mli:file_formats/cmo_format.mli
+  $dldir/dynlink_cmxs_format.mli:file_formats/cmxs_format.mli
+  $dldir/dynlink_platform_intf.mli:$dldir/dynlink_platform_intf.ml
+])
 lib_runtime_events=true
 AS_IF([test x"$enable_unix_lib" != "xno"],
   [enable_unix_lib=yes
   AC_CONFIG_FILES([otherlibs/unix/META])
   otherlibraries="$otherlibraries unix"
+  otherlibs="$otherlibs unix"
   lib_unix=true
   AC_CONFIG_LINKS([
     otherlibs/unix/unix.ml:otherlibs/unix/unix_${unix_or_win32}.ml
@@ -734,6 +765,7 @@ AS_IF([test x"$enable_unix_lib" != "xno"],
 
 AS_IF([test x"$enable_str_lib" != "xno"],
   [otherlibraries="$otherlibraries str"
+  otherlibs="$otherlibs str"
   lib_str=true
   AC_CONFIG_FILES([otherlibs/str/META])])
 
@@ -806,8 +838,12 @@ AS_CASE([$ocaml_cc_vendor],
     [outputobj='-o '; cc_warnings=""],
   [msvc-*],
     [outputobj='-Fo'
-    warn_error_flag='-WX'
-    cc_warnings=''],
+    AS_CASE([$ocaml_cc_vendor],
+      [msvc-*-clang-*],
+        [cc_warnings='-W4 -Wno-unused-parameter -Wno-sign-compare -Wundef'
+         warn_error_flag='-WX'],
+      [cc_warnings='-W2'
+       warn_error_flag='-WX -options:strict'])],
   [outputobj='-o '
   warn_error_flag='-Werror'
   cc_warnings="-Wall -Wint-conversion -Wstrict-prototypes \
@@ -818,10 +854,26 @@ AX_CHECK_COMPILE_FLAG([-Wold-style-declaration],
   [cc_warnings="$cc_warnings -Wold-style-declaration"], [],
   [$warn_error_flag])
 
+# Use -Wimplicit-fallthrough if supported
+for flag in '-Wimplicit-fallthrough=5' '-Wimplicit-fallthrough'; do
+  AX_CHECK_COMPILE_FLAG([$flag],
+    [cc_warnings="$cc_warnings $flag"; break], [], [$warn_error_flag])
+done
+
 AS_CASE([$enable_warn_error,OCAML__DEVELOPMENT_VERSION],
   [yes,*|,true],
     [cc_warnings="$cc_warnings $warn_error_flag"])
 
+AS_CASE([$host],
+  [*-*-mingw32*|*-pc-windows],
+    [AS_CASE([$WINDOWS_UNICODE_MODE],
+      [ansi],
+        [windows_unicode=0],
+      [compatible|""],
+        [windows_unicode=1],
+      [AC_MSG_ERROR([unexpected windows unicode mode])])],
+  [windows_unicode=0])
+
 # We select high optimization levels, provided we can turn off:
 # - strict type-based aliasing analysis (too risky for the OCaml runtime)
 # - strict no-overflow conditions on signed integer arithmetic
@@ -847,25 +899,29 @@ AS_CASE([$ocaml_cc_vendor],
     # TODO: see whether the code can be fixed to avoid -Wno-unused
     common_cflags="-O2 -fno-strict-aliasing -fwrapv -mms-bitfields"
     internal_cppflags='-D__USE_MINGW_ANSI_STDIO=0 -DUNICODE -D_UNICODE'
-    internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
-    internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"],
+    internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE=$windows_unicode"],
   [mingw-*],
     [AC_MSG_ERROR([Unsupported C compiler for a MinGW-w64 build])],
+  [msvc-0*|msvc-1[[0-8]]*|msvc-19[[012]]*|msvc-193[[0-7]]],
+    # No C11 atomics support
+    [AC_MSG_ERROR(m4_normalize([This version of MSVC is too old.
+    Please use Visual Studio version 17.8 or above.]), 69)],
   [msvc-*],
-    [common_cflags="-nologo -O2 -Gy- -MD $cc_warnings"
+    [common_cflags='-nologo -O2 -Gy- -MD'
     common_cppflags="-D_CRT_SECURE_NO_DEPRECATE"
-    internal_cppflags='-DUNICODE -D_UNICODE'
-    OCAML_CL_HAS_VOLATILE_METADATA
-    AS_IF([test "x$cl_has_volatile_metadata" = "xtrue"],
-          [internal_cflags='-d2VolatileMetadata-'])
-    internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
-    internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"],
+    internal_cflags="$cc_warnings"
+    internal_cppflags='-DUNICODE -D_UNICODE -D_CRT_NONSTDC_NO_WARNINGS'
+    AX_CHECK_COMPILE_FLAG([-volatileMetadata-],
+      [internal_cflags="$internal_cflags -volatileMetadata-"], [],
+      [$warn_error_flag])
+    internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE=$windows_unicode"],
   [xlc-*],
     [common_cflags="-O5 -qtune=balanced -qnoipa -qinline";
     internal_cflags="$cc_warnings"],
   [sunc-*], # Optimization should be >= O4 to inline functions
             # and prevent unresolved externals
-    [common_cflags="-O4 -xc99=all -D_XPG6 $CFLAGS";
+    [common_cflags="-O4 -xc99=all"
+    common_cppflags="-D_XPG6"
     internal_cflags="$cc_warnings"],
   [common_cflags="-O"])
 
@@ -938,9 +994,7 @@ AS_IF([test x"$supports_shared_libraries" != 'xfalse'], [
       AS_IF([m4_normalize([test x"$with_flexdll" = 'x'
                             || test x"$with_flexdll" = 'xflexdll'])],
         [AS_IF([test -f 'flexdll/flexdll.h'],
-          [flexdll_source_dir=flexdll
-          iflexdir='$(ROOTDIR)/flexdll'
-          with_flexdll="$iflexdir"],
+          [flexdll_source_dir=flexdll],
           [AS_IF([test x"$with_flexdll" != 'x'],
             [AC_MSG_RESULT([requested but not available])
             AC_MSG_ERROR([exiting])])])],
@@ -949,17 +1003,14 @@ AS_IF([test x"$supports_shared_libraries" != 'xfalse'], [
           [mkdir -p flexdll-sources
           cp -r "$with_flexdll"/* flexdll-sources/
           flexdll_source_dir='flexdll-sources'
-          iflexdir='$(ROOTDIR)/flexdll-sources'
           flexmsg=" (from $with_flexdll)"],
           [AC_MSG_RESULT([requested but not available])
           AC_MSG_ERROR([exiting])])])
       AS_IF([test x"$flexdll_source_dir" = 'x'],
         [AC_MSG_RESULT([no])],
-        [AC_MSG_RESULT([$iflexdir$flexmsg])
+        [AC_MSG_RESULT([$flexdll_source_dir$flexmsg])
         bootstrapping_flexdll=true
-        flexdll_dir=\"+flexdll\"
-        # The submodule should be searched *before* any other -I paths
-        internal_cppflags="-I $iflexdir $internal_cppflags"])],
+        flexdll_dir=\"+flexdll\"])],
       [AS_IF([test x"$with_flexdll" != 'x'],
         [AC_MSG_RESULT([requested but not supported])
         AC_MSG_ERROR([exiting])])])])
@@ -970,12 +1021,18 @@ AS_IF([test x"$supports_shared_libraries" != 'xfalse'], [
     OCAML_TEST_FLEXLINK([$flexlink], [$flexdll_chain],
                         [$internal_cppflags], [$host])
 
-    AS_CASE([$host],
-      [*-w64-mingw32*|*-pc-windows],
-        [flexlink_where="$(cmd /c "$flexlink" -where 2>/dev/null)"
-        AS_IF([test -z "$flexlink_where"],
-          [AC_MSG_ERROR(m4_normalize([$flexlink is not executable from a native
-            Win32 process]))])])
+    # When building on Cygwin/MSYS2, flexlink may be a shell script which
+    # then cannot be executed by ocamlc/ocamlopt. Having located flexlink,
+    # ensure it can be executed from a native Windows process. The check
+    # is only necessary when cross-compiling.
+    AS_IF([test x"$build" != x"$host"],[
+      AS_CASE([$build],
+        [*-pc-msys|*-pc-cygwin*],
+          [flexlink_where="$(cmd /c "$flexlink" -where 2>/dev/null)"
+          AS_IF([test -z "$flexlink_where"],
+            [AC_MSG_ERROR(m4_normalize([$flexlink is not executable from a
+            native Win32 process]))])])
+    ])
   ])
 
   OCAML_TEST_FLEXDLL_H([$flexdll_source_dir])
@@ -1014,7 +1071,6 @@ AS_CASE([$ocaml_cc_vendor,$host],
     AS_IF([$supports_shared_libraries],
       [mkexe_cmd_exp="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
       mkexe_cmd="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
-      mkexe_cflags=''
       mkexe_ldflags_prefix='-link '],
       [mkexe_extra_flags=''
       oc_ldflags='-Wl,--stack,16777216']
@@ -1027,7 +1083,6 @@ AS_CASE([$ocaml_cc_vendor,$host],
     toolchain="mingw"
     mkexe_cmd_exp="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
     mkexe_cmd="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
-    mkexe_cflags=''
     mkexe_ldflags_prefix='-link '
     oc_exe_ldflags='-municode'
     mkexe_extra_flags="$mkexe_ldflags_prefix$oc_exe_ldflags"
@@ -1037,7 +1092,6 @@ AS_CASE([$ocaml_cc_vendor,$host],
     ostype="Win32"
     mkexe_cmd_exp="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
     mkexe_cmd="flexlink -exe -chain ${flexdll_chain} ${flexlink_flags}"
-    mkexe_cflags=''
     mkexe_ldflags_prefix='-link '
     mkexe_via_cc_ldflags_prefix='/link '
     oc_exe_ldflags='/ENTRY:wmainCRTStartup'
@@ -1051,6 +1105,44 @@ AS_CASE([$ocaml_cc_vendor,$host],
   [gcc-*,powerpc-*-linux*],
     [oc_ldflags="-mbss-plt"])
 
+# Winpthreads emulation library for the MSVC port
+AC_MSG_CHECKING([for winpthreads sources])
+AS_IF([test x"$with_winpthreads_msvc" = "xno"],
+  [winpthreads_source_dir=''
+  AC_MSG_RESULT([disabled])],
+  [winpthreadmsg=''
+  AS_CASE([$target],
+    [*-pc-windows],
+    [dnl When bootstrapping from the git submodule (winpthreads directory),
+     dnl just use that, however if another directory has been specified with
+     dnl --with-winpthreads-msvc=<path> then copy the contents of <path> to
+     dnl winpthreads-sources.
+    AS_IF([m4_normalize([test x"$with_winpthreads_msvc" = 'x'
+                          || test x"$with_winpthreads_msvc" = x'winpthreads'])],
+      [AS_IF([test -f 'winpthreads/src/winpthread_internal.h'],
+        [winpthreads_source_dir=winpthreads],
+        [AC_MSG_RESULT([required but not available (uninitialized submodule?)])
+        AC_MSG_ERROR([exiting])])],
+      [rm -rf winpthreads-sources
+      AS_IF([test -f "$with_winpthreads_msvc/src/winpthread_internal.h"],
+        [mkdir -p winpthreads-sources/src winpthreads-sources/include
+        cp "$with_winpthreads_msvc"/src/*.c winpthreads-sources/src
+        cp "$with_winpthreads_msvc"/src/*.h winpthreads-sources/src
+        cp "$with_winpthreads_msvc"/include/*.h winpthreads-sources/include
+        winpthreads_source_dir='winpthreads-sources'
+        winpthreadsmsg=" (from $with_winpthreads_msvc)"],
+        [AC_MSG_RESULT([requested but not available])
+        AC_MSG_ERROR([exiting])])])
+    AS_IF([test x"$winpthreads_source_dir" = 'x'],
+      [AC_MSG_RESULT([no])],
+      [AC_MSG_RESULT([$winpthreads_source_dir$winpthreadsmsg])
+      winpthreads_source_include_dir="$winpthreads_source_dir/include"
+      OCAML_TEST_WINPTHREADS_PTHREAD_H([$winpthreads_source_include_dir])])],
+    [AS_IF([test x"$with_winpthreads_msvc" != 'x'],
+      [AC_MSG_RESULT([requested but not supported])
+      AC_MSG_ERROR([exiting])],
+      [AC_MSG_RESULT([skipping on that platform])])])])
+
 ## Program to use to install files
 AC_PROG_INSTALL
 
@@ -1068,20 +1160,21 @@ AC_SEARCH_LIBS([cos], [m],
 # Don't check for unistd.h on Windows
 AS_CASE([$host],
   [*-*-mingw32*|*-pc-windows], [],
-  [AC_CHECK_HEADERS([unistd.h],[AC_DEFINE([HAS_UNISTD])])])
+  [AC_CHECK_HEADERS([unistd.h],[AC_DEFINE([HAS_UNISTD], [1])])])
 
 AC_CHECK_HEADER([math.h])
-AC_CHECK_HEADER([stdint.h],[AC_DEFINE([HAS_STDINT_H])])
-AC_CHECK_HEADER([pthread_np.h],[AC_DEFINE([HAS_PTHREAD_NP_H])])
-AC_CHECK_HEADER([dirent.h], [AC_DEFINE([HAS_DIRENT])], [],
+AC_CHECK_HEADER([pthread_np.h],[AC_DEFINE([HAS_PTHREAD_NP_H], [1])])
+AC_CHECK_HEADER([dirent.h], [AC_DEFINE([HAS_DIRENT], [1])], [],
   [#include <sys/types.h>])
 
-AC_CHECK_HEADER([sys/select.h], [AC_DEFINE([HAS_SYS_SELECT_H])], [],
+AC_CHECK_HEADER([sys/select.h], [AC_DEFINE([HAS_SYS_SELECT_H], [1])], [],
   [#include <sys/types.h>])
 
-AC_CHECK_HEADER([stdatomic.h], [AC_DEFINE([HAS_STDATOMIC_H])])
+AC_CHECK_HEADER([sys/mman.h], [AC_DEFINE([HAS_SYS_MMAN_H], [1])])
 
-AC_CHECK_HEADER([sys/mman.h], [AC_DEFINE([HAS_SYS_MMAN_H])])
+AS_CASE([$host],
+  [*-*-linux*],
+    [AC_CHECK_HEADER([linux/futex.h], [AC_DEFINE([HAS_LINUX_FUTEX_H])])])
 
 # Checks for types
 
@@ -1150,6 +1243,8 @@ AS_IF([! $arch64],
       [AC_DEFINE([ARCH_ALIGN_INT64], [1])])])
     ])])
 
+AC_CHECK_TYPES([max_align_t], [], [], [[#include <stddef.h>]])
+
 # Atomics library
 
 AS_IF([! $arch64],
@@ -1158,7 +1253,16 @@ AS_IF([! $arch64],
 
 # Support for C11 atomic types
 
-OCAML_CC_SUPPORTS_ATOMIC([$cclibs])
+OCAML_CC_SUPPORTS_ATOMIC([], [$cclibs])
+AS_CASE([$cc_supports_atomic,$ocaml_cc_vendor],
+  [false,msvc-*],
+    [OCAML_CC_SUPPORTS_ATOMIC([-std:c11])
+     AS_IF([$cc_supports_atomic],
+       [common_cflags="$common_cflags -std:c11"],
+       [OCAML_CC_SUPPORTS_ATOMIC([-std:c11 -experimental:c11atomics])
+        AS_IF([$cc_supports_atomic],
+          [common_cflags="$common_cflags -std:c11 -experimental:c11atomics"])
+])])
 AS_IF([! $cc_supports_atomic],
   [AC_MSG_FAILURE([C11 atomic support is required, use another C compiler])])
 
@@ -1166,8 +1270,8 @@ AS_IF([! $cc_supports_atomic],
 # macOS and MinGW-w64 have problems with thread local storage accessed from DLLs
 
 AS_CASE([$host],
-  [*-apple-darwin*|*-mingw32*], [],
-  [AC_DEFINE([HAS_FULL_THREAD_VARIABLES])]
+  [*-apple-darwin*|*-mingw32*|*-pc-windows], [],
+  [AC_DEFINE([HAS_FULL_THREAD_VARIABLES], [1])]
 )
 
 # Shared library support
@@ -1299,15 +1403,16 @@ AS_CASE([$enable_native_toplevel,$natdynlink],
 # Try to work around the Skylake/Kaby Lake processor bug.
 AS_CASE(["$ocaml_cc_vendor,$host"],
   [*gcc*,x86_64-*|*gcc*,i686-*],
-    [OCAML_CC_HAS_FNO_TREE_VRP
-    AS_IF([$cc_has_fno_tree_vrp],
-      [internal_cflags="$internal_cflags -fno-tree-vrp"])])
-
-OCAML_CC_SUPPORTS_ALIGNED
+    [AX_CHECK_COMPILE_FLAG([-fno-tree-vrp],
+      [internal_cflags="$internal_cflags -fno-tree-vrp"], [],
+      [$warn_error_flag])])
 
 ## Check whether __attribute__((optimize("tree-vectorize")))) is supported
 OCAML_CC_SUPPORTS_TREE_VECTORIZE
 
+# Check whether the C compiler supports the labels as values extension.
+OCAML_CC_SUPPORTS_LABELS_AS_VALUES
+
 # Configure the native-code compiler
 
 arch=none
@@ -1338,7 +1443,7 @@ AS_CASE([$host],
   [i686-pc-windows],
     [arch=i386; system=win32],
   [x86_64-pc-windows],
-    [arch=amd64; system=win64],
+    [has_native_backend=yes; arch=amd64; system=win64],
   [[powerpc64le*-*-linux*]],
     [has_native_backend=yes; arch=power; model=ppc64le; system=linux],
   [[powerpc64*-*-linux-musl*]],
@@ -1424,8 +1529,9 @@ AS_CASE([$arch],
   [arch_specific_SOURCES=''])
 
 native_cflags=''
-native_cppflags="-DTARGET_${arch} -DMODEL_${model} -DSYS_${system}"
-
+oc_native_cflags=''
+oc_native_cppflags="-DNATIVE_CODE\
+ -DTARGET_${arch} -DMODEL_${model} -DSYS_${system}"
 AS_CASE([$ccomptype],
   [msvc],
     [runtime_asm_objects=${arch}nt.${OBJEXT}],
@@ -1542,7 +1648,7 @@ AS_CASE([$as_target,$ocaml_cc_vendor],
 
 AS_IF([test "$with_pic"],
   [fpic=true
-  AC_DEFINE([CAML_WITH_FPIC])
+  AC_DEFINE([CAML_WITH_FPIC], [1])
   internal_cflags="$internal_cflags $sharedlib_cflags"
   default_aspp="$default_aspp $sharedlib_cflags"],
   [fpic=false])
@@ -1570,39 +1676,24 @@ AC_CHECK_FUNCS(m4_normalize([expm1 log1p hypot fma exp2 log2 cbrt acosh asinh
   atanh erf erfc trunc round copysign]), [], [has_c99_float_ops=false])
 
 AS_IF([$has_c99_float_ops],
-  [AC_DEFINE([HAS_C99_FLOAT_OPS])
+  [AC_DEFINE([HAS_C99_FLOAT_OPS], [1])
   # Check whether round works (known bug in mingw-w64)
   OCAML_C99_CHECK_ROUND
-  # Check whether fma works (regressed in mingw-w64 8.0.0; present, but broken,
-  # in VS2013-2017 and present but unimplemented in Cygwin64)
+  # Check whether fma works (regressed in mingw-w64 8.0.0; and present but
+  # unimplemented in Cygwin64)
   OCAML_C99_CHECK_FMA],
   [AS_IF([test x"$enable_imprecise_c99_float_ops" != "xyes" ],
-    [AS_CASE([$enable_imprecise_c99_float_ops,$ocaml_cc_vendor],
-      [no,*], [hard_error=true],
-      [,msvc-*], [AS_IF([test "${ocaml_cc_vendor#msvc-}" -lt 1800 ],
-        [hard_error=false],
-        [hard_error=true])],
-      [hard_error=true])
-     AS_IF([test x"$hard_error" = 'xtrue'],
-       [AC_MSG_ERROR(m4_normalize([
-         C99 float ops unavailable, enable replacements
-         with --enable-imprecise-c99-float-ops]))],
-       [AC_MSG_WARN(m4_normalize([
-         C99 float ops unavailable, replacements enabled
-         (ancient Visual Studio)]))])])])
+    [AC_MSG_ERROR(m4_normalize([C99 float ops unavailable, enable replacements
+    with --enable-imprecise-c99-float-ops]))])])
 
 ## getentropy
-AC_CHECK_HEADER([unistd.h],
-  [AC_CHECK_DECL([getentropy],
-                 [AC_DEFINE([HAS_GETENTROPY])], [],
-                 [[#include <unistd.h>]])],
-  [])
+AC_CHECK_FUNC([getentropy], [AC_DEFINE([HAS_GETENTROPY], [1])])
 
 ## getrusage
-AC_CHECK_FUNC([getrusage], [AC_DEFINE([HAS_GETRUSAGE])])
+AC_CHECK_FUNC([getrusage], [AC_DEFINE([HAS_GETRUSAGE], [1])])
 
 ## times
-AC_CHECK_FUNC([times], [AC_DEFINE([HAS_TIMES])])
+AC_CHECK_FUNC([times], [AC_DEFINE([HAS_TIMES], [1])])
 
 ## secure_getenv and __secure_getenv
 
@@ -1610,21 +1701,20 @@ saved_CPPFLAGS="$CPPFLAGS"
 CPPFLAGS="-D_GNU_SOURCE $CPPFLAGS"
 
 AC_CHECK_FUNC([secure_getenv],
-  [AC_DEFINE([HAS_SECURE_GETENV])],
-  [AC_CHECK_FUNC([__secure_getenv], [AC_DEFINE([HAS___SECURE_GETENV])])])
+  [AC_DEFINE([HAS_SECURE_GETENV], [1])],
+  [AC_CHECK_FUNC([__secure_getenv], [AC_DEFINE([HAS___SECURE_GETENV], [1])])])
 
 CPPFLAGS="$saved_CPPFLAGS"
 
 ## issetugid
 
-AC_CHECK_FUNC([issetugid], [AC_DEFINE([HAS_ISSETUGID])])
+AC_CHECK_FUNC([issetugid], [AC_DEFINE([HAS_ISSETUGID], [1])])
 
 ## Checking for monotonic clock source
 ## On Windows MSVC, QueryPerformanceCounter and QueryPerformanceFrequency
 ## are always available.
 ## On Unix platforms, we check for the appropriate POSIX feature-test macros.
 ## On MacOS clock_gettime's CLOCK_MONOTONIC flag is not actually monotonic.
-## mach_timebase_info and mach_absolute_time are used instead.
 
 AS_CASE([$host],
   [*-*-windows],
@@ -1633,24 +1723,20 @@ AS_CASE([$host],
     AC_CHECK_FUNCS([clock_gettime_nsec_np],
       [
         has_monotonic_clock=true
-        AC_DEFINE([HAS_CLOCK_GETTIME_NSEC_NP])
+        AC_DEFINE([HAS_CLOCK_GETTIME_NSEC_NP], [1])
       ],
       [has_monotonic_clock=false])],
-  [AC_COMPILE_IFELSE([AC_LANG_SOURCE([[
+  [AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
     #include <unistd.h>
     #include <time.h>
-    int main(void)
-    {
-      #if !(defined(_POSIX_TIMERS) && defined(_POSIX_MONOTONIC_CLOCK)   \
-         && _POSIX_MONOTONIC_CLOCK != (-1))
-        #error "no monotonic clock source"
-      #endif
-        return 0;
-     }
+    #if !(defined(_POSIX_TIMERS) && defined(_POSIX_MONOTONIC_CLOCK)   \
+       && _POSIX_MONOTONIC_CLOCK != (-1))
+      #error "no monotonic clock source"
+    #endif
     ]])],
     [
       has_monotonic_clock=true
-      AC_DEFINE([HAS_POSIX_MONOTONIC_CLOCK])
+      AC_DEFINE([HAS_POSIX_MONOTONIC_CLOCK], [1])
     ],
     [has_monotonic_clock=false])
   ]
@@ -1776,7 +1862,7 @@ AS_IF([$tsan],
   AS_CASE([$ocaml_cc_vendor],
     [gcc-[[0123456789]]-*|gcc-10-*|clang-*],
       [],
-    [oc_tsan_cflags="$oc_tsan_cflags -Wno-tsan"])
+    [tsan_cflags="$tsan_cflags -Wno-tsan"])
   AS_CASE([$ocaml_cc_vendor],
     [gcc*],
       [tsan_distinguish_volatile_cflags="--param=tsan-distinguish-volatile=1"],
@@ -1787,10 +1873,11 @@ AS_IF([$tsan],
     [AC_MSG_ERROR(m4_normalize([The C compiler does not support the
       `$tsan_distinguish_volatile_cflags' flag. Try upgrading to GCC >= 11, or
       to Clang >= 11.]))], [$warn_error_flag])
-  oc_tsan_cflags="$oc_tsan_cflags $tsan_distinguish_volatile_cflags"
-  common_cppflags="$common_cppflags $oc_tsan_cppflags"
-  native_cflags="$native_cflags $oc_tsan_cflags"
-  ocamlc_cflags="$ocamlc_cflags $oc_tsan_cflags"
+  tsan_cflags="$tsan_cflags $tsan_distinguish_volatile_cflags"
+  oc_native_cppflags="$oc_native_cppflags $tsan_cppflags"
+  oc_native_cflags="$oc_native_cflags $tsan_cflags"
+  native_cflags="$native_cflags $tsan_cflags"
+  native_ldflags="$native_ldflags $tsan_ldflags"
   tsan_native_runtime_c_sources="tsan"],
   [AC_MSG_NOTICE([not using thread sanitizer])
   tsan_native_runtime_c_sources=""]
@@ -1827,8 +1914,8 @@ AS_IF([$tsan],
   AS_IF([test x"$LIBUNWIND_LDFLAGS" != x],
     [libunwind_ldflags="$LIBUNWIND_LDFLAGS $libunwind_ldflags"])
 
-  native_cppflags="$native_cppflags $libunwind_cppflags"
-  native_ldflags="$native_ldflags -fsanitize=thread $libunwind_ldflags"
+  oc_native_cppflags="$oc_native_cppflags $libunwind_cppflags"
+  native_ldflags="$native_ldflags $libunwind_ldflags"
 
   OCAML_CHECK_LIBUNWIND
 
@@ -1856,11 +1943,11 @@ AS_CASE([$host],
   [*-*-mingw32*],
     [cclibs="$cclibs -lws2_32"
     AC_SEARCH_LIBS([socket], [ws2_32])
-    AC_CHECK_FUNC([socketpair], [AC_DEFINE([HAS_SOCKETPAIR])])],
+    AC_CHECK_FUNC([socketpair], [AC_DEFINE([HAS_SOCKETPAIR], [1])])],
   [*-pc-windows],
     [cclibs="$cclibs ws2_32.lib"
     AC_SEARCH_LIBS([socket], [ws2_32])
-    AC_CHECK_FUNC([socketpair], [AC_DEFINE([HAS_SOCKETPAIR])])],
+    AC_CHECK_FUNC([socketpair], [AC_DEFINE([HAS_SOCKETPAIR], [1])])],
   [*-*-haiku],
     [cclibs="$cclibs -lnetwork"
     AC_SEARCH_LIBS([socket], [network])],
@@ -1876,24 +1963,24 @@ AS_CASE([$host],
   ]
 )
 
-AS_IF([$sockets], [AC_DEFINE([HAS_SOCKETS])])
+AS_IF([$sockets], [AC_DEFINE([HAS_SOCKETS], [1])])
 
 ## socklen_t
 
 AS_CASE([$host],
   [*-*-mingw32*|*-pc-windows],
-    [AC_CHECK_TYPE([socklen_t], [AC_DEFINE([HAS_SOCKLEN_T])], [],
+    [AC_CHECK_TYPE([socklen_t], [AC_DEFINE([HAS_SOCKLEN_T], [1])], [],
       [#include <ws2tcpip.h>])],
-  [AC_CHECK_TYPE([socklen_t], [AC_DEFINE([HAS_SOCKLEN_T])], [],
+  [AC_CHECK_TYPE([socklen_t], [AC_DEFINE([HAS_SOCKLEN_T], [1])], [],
     [#include <sys/socket.h>])])
 
-AC_CHECK_FUNC([inet_aton], [AC_DEFINE([HAS_INET_ATON])])
+AC_CHECK_FUNC([inet_aton], [AC_DEFINE([HAS_INET_ATON], [1])])
 
 ## Unix domain sockets support on Windows
 
 AS_CASE([$host],
   [*-*-mingw32*|*-pc-windows],
-    [AC_CHECK_HEADERS([afunix.h], [AC_DEFINE([HAS_AFUNIX_H])], [],
+    [AC_CHECK_HEADERS([afunix.h], [AC_DEFINE([HAS_AFUNIX_H], [1])], [],
       [#include <winsock2.h>])])
 
 ## IPv6 support
@@ -1915,68 +2002,61 @@ AS_CASE([$host],
 )
 
 AS_IF([$ipv6],
-  [AC_CHECK_FUNC([getaddrinfo], [], [ipv6=false])])
-
-AS_IF([$ipv6],
-  [AC_CHECK_FUNC([getnameinfo], [], [ipv6=false])])
-
-AS_IF([$ipv6],
-  [AC_CHECK_FUNC([inet_pton], [], [ipv6=false])])
-
+  [AC_CHECK_FUNCS([getaddrinfo getnameinfo inet_pton inet_ntop], [],
+    [ipv6=false])])
 AS_IF([$ipv6],
-  [AC_CHECK_FUNC([inet_ntop], [AC_DEFINE([HAS_IPV6])])])
+  [AC_DEFINE([HAS_IPV6], [1])])
 
-AC_CHECK_FUNC([rewinddir], [AC_DEFINE([HAS_REWINDDIR])])
+AC_CHECK_FUNC([rewinddir], [AC_DEFINE([HAS_REWINDDIR], [1])])
 
-AC_CHECK_FUNC([lockf], [AC_DEFINE([HAS_LOCKF])])
+AC_CHECK_FUNC([lockf], [AC_DEFINE([HAS_LOCKF], [1])])
 
-AC_CHECK_FUNC([mkfifo], [AC_DEFINE([HAS_MKFIFO])])
+AC_CHECK_FUNC([mkfifo], [AC_DEFINE([HAS_MKFIFO], [1])])
 
-AC_CHECK_FUNC([getcwd], [AC_DEFINE([HAS_GETCWD])])
+AC_CHECK_FUNC([getcwd], [AC_DEFINE([HAS_GETCWD], [1])])
 
-AC_CHECK_DECL([system], [AC_DEFINE([HAS_SYSTEM])], [], [[#include <stdlib.h>]])
+AC_CHECK_FUNC([system], [AC_DEFINE([HAS_SYSTEM], [1])])
 
 ## utime
 ## Note: this was defined in config/s-nt.h but the autoconf macros do not
 # seem to detect it properly on Windows so we hardcode the definition
 # of HAS_UTIME on Windows but this will probably need to be clarified
 AS_CASE([$host],
-  [*-*-mingw32*|*-pc-windows], [AC_DEFINE([HAS_UTIME])],
+  [*-*-mingw32*|*-pc-windows], [AC_DEFINE([HAS_UTIME], [1])],
   [AC_CHECK_HEADER([sys/types.h],
     [AC_CHECK_HEADER([utime.h],
-      [AC_CHECK_FUNC([utime], [AC_DEFINE([HAS_UTIME])])])])])
+      [AC_CHECK_FUNC([utime], [AC_DEFINE([HAS_UTIME], [1])])])])])
 
-AC_CHECK_FUNC([utimes], [AC_DEFINE([HAS_UTIMES])])
+AC_CHECK_FUNC([utimes], [AC_DEFINE([HAS_UTIMES], [1])])
 
 AC_CHECK_FUNC([fchmod],
-  [AC_CHECK_FUNC([fchown], [AC_DEFINE([HAS_FCHMOD])])])
+  [AC_CHECK_FUNC([fchown], [AC_DEFINE([HAS_FCHMOD], [1])])])
 
 AC_CHECK_FUNC([truncate],
-  [AC_CHECK_FUNC([ftruncate], [AC_DEFINE([HAS_TRUNCATE])])])
+  [AC_CHECK_FUNC([ftruncate], [AC_DEFINE([HAS_TRUNCATE], [1])])])
 
 ## select
 AC_CHECK_FUNC([select],
   [AC_CHECK_TYPE([fd_set],
-    [AC_DEFINE([HAS_SELECT])
-    select=true], [select=false], [
+    [AC_DEFINE([HAS_SELECT], [1])], [], [
 #include <sys/types.h>
 #include <sys/select.h>
   ])])
 
-AC_CHECK_FUNC([nanosleep], [AC_DEFINE([HAS_NANOSLEEP])])
+AC_CHECK_FUNC([nanosleep], [AC_DEFINE([HAS_NANOSLEEP], [1])])
 
 AC_CHECK_FUNC([symlink],
   [AC_CHECK_FUNC([readlink],
-    [AC_CHECK_FUNC([lstat], [AC_DEFINE([HAS_SYMLINK])])])])
+    [AC_CHECK_FUNC([lstat], [AC_DEFINE([HAS_SYMLINK], [1])])])])
 
-AC_CHECK_FUNC([realpath], [AC_DEFINE([HAS_REALPATH])])
+AC_CHECK_FUNC([realpath], [AC_DEFINE([HAS_REALPATH], [1])])
 
 # wait
 AC_CHECK_FUNC(
   [waitpid],
   [
     wait=true
-    AC_DEFINE([HAS_WAITPID])
+    AC_DEFINE([HAS_WAITPID], [1])
   ],
   [wait=false])
 
@@ -1984,17 +2064,17 @@ AC_CHECK_FUNC(
   [wait4],
   [
     has_wait=true
-    AC_DEFINE([HAS_WAIT4])
+    AC_DEFINE([HAS_WAIT4], [1])
   ])
 
 ## getgroups
-AC_CHECK_FUNC([getgroups], [AC_DEFINE([HAS_GETGROUPS])])
+AC_CHECK_FUNC([getgroups], [AC_DEFINE([HAS_GETGROUPS], [1])])
 
 ## setgroups
-AC_CHECK_FUNC([setgroups], [AC_DEFINE([HAS_SETGROUPS])])
+AC_CHECK_FUNC([setgroups], [AC_DEFINE([HAS_SETGROUPS], [1])])
 
 ## initgroups
-AC_CHECK_FUNC([initgroups], [AC_DEFINE([HAS_INITGROUPS])])
+AC_CHECK_FUNC([initgroups], [AC_DEFINE([HAS_INITGROUPS], [1])])
 
 ## termios
 
@@ -2003,14 +2083,14 @@ AC_CHECK_HEADER([termios.h],
     [AC_CHECK_FUNC([tcsetattr],
       [AC_CHECK_FUNC([tcsendbreak],
         [AC_CHECK_FUNC([tcflush],
-          [AC_CHECK_FUNC([tcflow], [AC_DEFINE([HAS_TERMIOS])])])])])])])
+          [AC_CHECK_FUNC([tcflow], [AC_DEFINE([HAS_TERMIOS], [1])])])])])])])
 
 ## setitimer
 
 AC_CHECK_FUNC([setitimer],
   [
     setitimer=true
-    AC_DEFINE([HAS_SETITIMER])
+    AC_DEFINE([HAS_SETITIMER], [1])
   ],
   [setitimer=false])
 
@@ -2018,63 +2098,63 @@ AC_CHECK_FUNC([setitimer],
 # Note: detection fails on Windows so hardcoding the result
 # (should be debugged later)
 AS_CASE([$host],
-  [*-*-mingw32*|*-pc-windows], [AC_DEFINE([HAS_GETHOSTNAME])],
-  [AC_CHECK_FUNC([gethostname], [AC_DEFINE([HAS_GETHOSTNAME])])])
+  [*-*-mingw32*|*-pc-windows], [AC_DEFINE([HAS_GETHOSTNAME], [1])],
+  [AC_CHECK_FUNC([gethostname], [AC_DEFINE([HAS_GETHOSTNAME], [1])])])
 
 ## uname
 
 AC_CHECK_HEADER([sys/utsname.h],
-  [AC_CHECK_FUNC([uname], [AC_DEFINE([HAS_UNAME])])])
+  [AC_CHECK_FUNC([uname], [AC_DEFINE([HAS_UNAME], [1])])])
 
 ## gettimeofday
 
 AC_CHECK_FUNC([gettimeofday],
   [
     gettimeofday=true
-    AC_DEFINE([HAS_GETTIMEOFDAY])
+    AC_DEFINE([HAS_GETTIMEOFDAY], [1])
   ],
   [gettimeofday=false])
 
 ## mktime
 
-AC_CHECK_FUNC([mktime], [AC_DEFINE([HAS_MKTIME])])
+AC_CHECK_FUNC([mktime], [AC_DEFINE([HAS_MKTIME], [1])])
 
 ## setsid
 
 AS_CASE([$host],
   [*-cygwin|*-*-mingw32*|*-pc-windows], [],
-  [AC_CHECK_FUNC([setsid], [AC_DEFINE([HAS_SETSID])])])
+  [AC_CHECK_FUNC([setsid], [AC_DEFINE([HAS_SETSID], [1])])])
 
 ## putenv
 
-AC_CHECK_FUNC([putenv], [AC_DEFINE([HAS_PUTENV])])
+AC_CHECK_FUNC([putenv], [AC_DEFINE([HAS_PUTENV], [1])])
 
 ## setenv and unsetenv
 
 AC_CHECK_FUNC([setenv],
-  [AC_CHECK_FUNC([unsetenv], [AC_DEFINE([HAS_SETENV_UNSETENV])])])
+  [AC_CHECK_FUNC([unsetenv], [AC_DEFINE([HAS_SETENV_UNSETENV], [1])])])
 
 ## newlocale() and <locale.h>
 # Note: the detection fails on msvc so we hardcode the result
 # (should be debugged later)
 AS_CASE([$host],
-  [*-pc-windows], [AC_DEFINE([HAS_LOCALE_H])],
+  [*-pc-windows], [AC_DEFINE([HAS_LOCALE_H], [1])],
   [AC_CHECK_HEADER([locale.h],
     [AC_CHECK_FUNC([newlocale],
       [AC_CHECK_FUNC([freelocale],
-        [AC_CHECK_FUNC([uselocale], [AC_DEFINE([HAS_LOCALE_H])])])])])])
+        [AC_CHECK_FUNC([uselocale], [AC_DEFINE([HAS_LOCALE_H], [1])])])])])])
 
 AC_CHECK_HEADER([xlocale.h],
   [AC_CHECK_FUNC([newlocale],
     [AC_CHECK_FUNC([freelocale],
-      [AC_CHECK_FUNC([uselocale], [AC_DEFINE([HAS_XLOCALE_H])])])])])
+      [AC_CHECK_FUNC([uselocale], [AC_DEFINE([HAS_XLOCALE_H], [1])])])])])
 
 ## strtod_l
 # Note: not detected on MSVC so hardcoding the result
 # (should be debugged later)
 AS_CASE([$host],
-  [*-pc-windows], [AC_DEFINE([HAS_STRTOD_L])],
-  [AC_CHECK_FUNC([strtod_l], [AC_DEFINE([HAS_STRTOD_L])])])
+  [*-pc-windows], [AC_DEFINE([HAS_STRTOD_L], [1])],
+  [AC_CHECK_FUNC([strtod_l], [AC_DEFINE([HAS_STRTOD_L], [1])])])
 
 ## shared library support
 AS_IF([$supports_shared_libraries],
@@ -2090,18 +2170,18 @@ AS_IF([$supports_shared_libraries],
 
 AS_IF([$supports_shared_libraries],
   [AC_MSG_NOTICE([Dynamic loading of shared libraries is supported.])
-  AC_DEFINE([SUPPORT_DYNAMIC_LINKING])],
+  AC_DEFINE([SUPPORT_DYNAMIC_LINKING], [1])],
   [AC_MSG_NOTICE([Dynamic loading of shared libraries is not supported.])])
 
 ## mmap
 
 AC_CHECK_HEADER([sys/mman.h],
   [AC_CHECK_FUNC([mmap],
-    [AC_CHECK_FUNC([munmap], [AC_DEFINE([HAS_MMAP])])])])
+    [AC_CHECK_FUNC([munmap], [AC_DEFINE([HAS_MMAP], [1])])])])
 
 ## pwrite
 
-AC_CHECK_FUNC([pwrite], [AC_DEFINE([HAS_PWRITE])])
+AC_CHECK_FUNC([pwrite], [AC_DEFINE([HAS_PWRITE], [1])])
 
 ## -fdebug-prefix-map support by the C compiler
 AS_CASE([$ocaml_cc_vendor,$host],
@@ -2109,42 +2189,18 @@ AS_CASE([$ocaml_cc_vendor,$host],
   [*,*-pc-windows], [cc_has_debug_prefix_map=false],
   [xlc*,powerpc-ibm-aix*], [cc_has_debug_prefix_map=false],
   [sunc*,sparc-sun-*], [cc_has_debug_prefix_map=false],
-  [OCAML_CC_HAS_DEBUG_PREFIX_MAP])
+  [AX_CHECK_COMPILE_FLAG([-fdebug-prefix-map=old=new],
+    [cc_has_debug_prefix_map=true], [cc_has_debug_prefix_map=false],
+    [$warn_error_flag])])
 
 ## Does stat support nanosecond precision
 
 stat_has_ns_precision=false
-
-AC_CHECK_MEMBER([struct stat.st_atim.tv_nsec],
-  [stat_has_ns_precision=true
-  AC_DEFINE([HAS_NANOSECOND_STAT], [1])],
-  [],
-  [
+AC_CHECK_MEMBERS([struct stat.st_atim.tv_nsec, struct stat.st_atimespec.tv_nsec,
+  struct stat.st_atimensec],
+  [stat_has_ns_precision=true], [], [
     AC_INCLUDES_DEFAULT
-    #include <sys/stat.h>
-  ])
-
-
-AS_IF([! $stat_has_ns_precision],
-  [AC_CHECK_MEMBER([struct stat.st_atimespec.tv_nsec],
-    [stat_has_ns_precision=true
-    AC_DEFINE([HAS_NANOSECOND_STAT], [2])],
-    [],
-    [
-      AC_INCLUDES_DEFAULT
-      #include <sys/stat.h>
-    ])])
-
-AS_IF([! $stat_has_ns_precision],
-  [AC_CHECK_MEMBER([struct stat.st_atimensec],
-    [stat_has_ns_precision=true
-    AC_DEFINE([HAS_NANOSECOND_STAT], [3])],
-    [],
-    [
-      AC_INCLUDES_DEFAULT
-      #include <sys/stat.h>
-    ])])
-
+    #include <sys/stat.h>])
 AS_IF([$stat_has_ns_precision],
   [AC_MSG_NOTICE([stat supports nanosecond precision])],
   [AC_MSG_NOTICE([stat does not support nanosecond precision])])
@@ -2168,44 +2224,44 @@ AS_CASE([$ac_cv_func_which_gethostbyaddr_r],
 
 ## mkstemp
 
-AC_CHECK_FUNC([mkstemp], [AC_DEFINE([HAS_MKSTEMP])])
+AC_CHECK_FUNC([mkstemp], [AC_DEFINE([HAS_MKSTEMP], [1])])
 
 ## nice
 
-AC_CHECK_FUNC([nice], [AC_DEFINE([HAS_NICE])])
+AC_CHECK_FUNC([nice], [AC_DEFINE([HAS_NICE], [1])])
 
 ## dup3
 
-AC_CHECK_FUNC([dup3], [AC_DEFINE([HAS_DUP3])])
+AC_CHECK_FUNC([dup3], [AC_DEFINE([HAS_DUP3], [1])])
 
 ## pipe2
 
-AC_CHECK_FUNC([pipe2], [AC_DEFINE([HAS_PIPE2])])
+AC_CHECK_FUNC([pipe2], [AC_DEFINE([HAS_PIPE2], [1])])
 
 ## accept4
 
-AC_CHECK_FUNC([accept4], [AC_DEFINE([HAS_ACCEPT4])])
+AC_CHECK_FUNC([accept4], [AC_DEFINE([HAS_ACCEPT4], [1])])
 
 ## getauxval
 
-AC_CHECK_FUNC([getauxval], [AC_DEFINE([HAS_GETAUXVAL])])
+AC_CHECK_FUNC([getauxval], [AC_DEFINE([HAS_GETAUXVAL], [1])])
 
 ## shmat
 AC_CHECK_HEADER([sys/shm.h],
   [
-    AC_DEFINE([HAS_SYS_SHM_H])
-    AC_CHECK_FUNC([shmat], [AC_DEFINE([HAS_SHMAT])])
+    AC_DEFINE([HAS_SYS_SHM_H], [1])
+    AC_CHECK_FUNC([shmat], [AC_DEFINE([HAS_SHMAT], [1])])
   ])
 
 ## execvpe
 
-AC_CHECK_FUNC([execvpe], [AC_DEFINE([HAS_EXECVPE])])
+AC_CHECK_FUNC([execvpe], [AC_DEFINE([HAS_EXECVPE], [1])])
 
 ## posix_spawn
 
 AC_CHECK_HEADER([spawn.h],
   [AC_CHECK_FUNC([posix_spawn],
-    [AC_CHECK_FUNC([posix_spawnp], [AC_DEFINE([HAS_POSIX_SPAWN])])])])
+    [AC_CHECK_FUNC([posix_spawnp], [AC_DEFINE([HAS_POSIX_SPAWN], [1])])])])
 
 AC_PATH_TOOL([PKG_CONFIG], [pkg-config], [false])
 
@@ -2216,7 +2272,7 @@ zstd_libs=""
 
 AS_IF([test x"$with_zstd" != "xno"],
   # Try pkg-config first, as it gives the most reliable results
-  AS_IF([${PKG_CONFIG} libzstd 2>/dev/null],
+  [AS_IF([${PKG_CONFIG} libzstd 2>/dev/null],
     # Now check the version
     [AS_IF([${PKG_CONFIG} --atleast-version 1.4 libzstd],
       [zstd_libs=`${PKG_CONFIG} --libs libzstd`
@@ -2232,7 +2288,7 @@ AS_IF([test x"$with_zstd" != "xno"],
          zstd_status="ok"],
         [zstd_status="zstd library too old: version 1.4 or later is needed"],
         [[#include <zstd.h>]])],
-      [zstd_status="zstd library not found"])]))
+      [zstd_status="zstd library not found"])])])
 
 # When building the mingw-w64 port in Cygwin, it is very easy to have the
 # library available, but not have the DLL in PATH. This then causes the build to
@@ -2275,7 +2331,7 @@ int main(void) {
 AS_IF([test x"$zstd_status" = "xok"],
   [AC_MSG_NOTICE([compressed compilation artefacts supported])
    internal_cppflags="$internal_cppflags $zstd_flags"
-   AC_DEFINE([HAS_ZSTD])],
+   AC_DEFINE([HAS_ZSTD], [1])],
   [AS_CASE(["$with_zstd"],
      [no],
        [],
@@ -2310,17 +2366,19 @@ AS_CASE([$enable_debug_runtime],
 
 AS_CASE([$host],
   [*-*-mingw32*],
-    [PTHREAD_LIBS="-l:libpthread.a -lgcc_eh"],
+    [link_gcc_eh=''
+     AC_CHECK_LIB([gcc_eh], [printf], [link_gcc_eh="-lgcc_eh"])
+     PTHREAD_LIBS="-l:libpthread.a $link_gcc_eh"],
   [*-pc-windows],
-    [PTHREAD_LIBS="-l:libpthread.lib"],
+    [PTHREAD_LIBS=''],
   [AX_PTHREAD(
-    [common_cflags="$common_cflags $PTHREAD_CFLAGS"
+    [
     # The two following lines add flags and libraries for pthread to the
     # global CFLAGS and LIBS variables. This means that all the subsequent
     # tests can rely on the assumption that pthread is enabled.
     CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
     LIBS="$LIBS $PTHREAD_LIBS"
-    AC_CHECK_FUNC([sigwait], [AC_DEFINE([HAS_SIGWAIT])])],
+    AC_CHECK_FUNC([sigwait], [AC_DEFINE([HAS_SIGWAIT], [1])])],
     [AC_MSG_ERROR(m4_normalize([POSIX threads are required but not supported on
       this platform]))])])
 
@@ -2339,7 +2397,7 @@ AC_LINK_IFELSE(
       CPU_COUNT(&cs);
       pthread_getaffinity_np(pthread_self(), sizeof(cs), &cs);]])],
   [AC_MSG_RESULT([GNU])
-  AC_DEFINE([HAS_GNU_GETAFFINITY_NP])],
+  AC_DEFINE([HAS_GNU_GETAFFINITY_NP], [1])],
   [AC_LINK_IFELSE(
     [AC_LANG_PROGRAM(
       [[#include <pthread.h>
@@ -2351,7 +2409,7 @@ AC_LINK_IFELSE(
         CPU_COUNT(&cs);
         pthread_getaffinity_np(pthread_self(), sizeof(cs), &cs);]])],
     [AC_MSG_RESULT([BSD])
-    AC_DEFINE([HAS_BSD_GETAFFINITY_NP])],
+    AC_DEFINE([HAS_BSD_GETAFFINITY_NP], [1])],
     [AC_MSG_RESULT([pthread_getaffinity_np not found])])])
 
 ## Activate the systhread library
@@ -2366,6 +2424,7 @@ AS_CASE([$enable_systhreads,$enable_unix_lib],
   [systhread_support=true
   AC_CONFIG_FILES([otherlibs/systhreads/META])
   otherlibraries="$otherlibraries systhreads"
+  otherlibs="$otherlibs systhreads"
   lib_systhreads=true
   AC_MSG_NOTICE([the threads library is supported])])
 
@@ -2381,12 +2440,16 @@ AS_IF([$native_compiler],
 ## Frame pointers
 
 AS_IF([test x"$enable_frame_pointers" = "xyes"],
-  [AS_CASE(["$host,$ocaml_cc_vendor"],
-    [x86_64-*-linux*,gcc-*|x86_64-*-linux*,clang-*],
-      [common_cflags="$common_cflags -g  -fno-omit-frame-pointer"
-      frame_pointers=true
-      AC_DEFINE([WITH_FRAME_POINTERS])
-      AC_MSG_NOTICE([using frame pointers])],
+  [AS_CASE([$host],
+    [x86_64-*-linux*|x86_64-*-darwin*],
+     [AS_CASE([$ocaml_cc_vendor],
+        [clang-*|gcc-*],
+         [common_cflags="$common_cflags -g  -fno-omit-frame-pointer"
+         frame_pointers=true
+         AC_DEFINE([WITH_FRAME_POINTERS], [1])
+         AC_MSG_NOTICE([using frame pointers])],
+         [AC_MSG_ERROR([frame pointers not supported on this platform])]
+      )],
     [AC_MSG_ERROR([frame pointers not supported on this platform])]
   )],
   [AC_MSG_NOTICE([not using frame pointers])
@@ -2420,7 +2483,9 @@ AC_ARG_WITH([odoc],
 AS_IF([test "x$documentation_tool_cmd" = 'x']
  [documentation_tool_cmd="$documentation_tool"])
 
-
+AS_IF([test x"$enable_ocamlobjinfo" != 'xno'],
+  [build_ocamlobjinfo=true],
+  [build_ocamlobjinfo=false])
 
 AS_CASE([$enable_ocamltest,OCAML__DEVELOPMENT_VERSION],
   [yes,*|,true],
@@ -2474,7 +2539,7 @@ AS_IF([test x"$enable_cmm_invariants" = "xyes"],
 
 AS_IF([test x"$enable_flat_float_array" = "xno"],
   [flat_float_array=false],
-  [AC_DEFINE([FLAT_FLOAT_ARRAY])
+  [AC_DEFINE([FLAT_FLOAT_ARRAY], [1])
   flat_float_array=true])
 
 OCAML_MMAP_SUPPORTS_MAP_STACK
@@ -2484,13 +2549,13 @@ AS_IF([test x"$enable_mmap_map_stack" = "xyes"],
        [*-freebsd*],
          [AC_MSG_ERROR([mmap MAP_STACK not supported on FreeBSD])],
        [with_mmap_map_stack=true;
-        AC_DEFINE([USE_MMAP_MAP_STACK])])],
+        AC_DEFINE([USE_MMAP_MAP_STACK], [1])])],
     [AC_MSG_ERROR([mmap MAP_STACK requested but not found on $target])])
   ],
   [AS_CASE([$target],
     [*-openbsd*],
      [with_mmap_map_stack=true;
-      AC_DEFINE([USE_MMAP_MAP_STACK])
+      AC_DEFINE([USE_MMAP_MAP_STACK], [1])
       AC_MSG_NOTICE([using MAP_STACK on OpenBSD due to stack checking])],
     [with_mmap_map_stack=false])
   ])
@@ -2500,7 +2565,7 @@ oc_native_compflags=''
 AS_IF([test x"$enable_function_sections" = "xno"],
   [function_sections=false],
   [AS_CASE([$arch],
-    [amd64|arm64], # not supported on arm32, see issue #9124.
+    [amd64|arm64|power|riscv|s390x], # not supported on arm32, see issue #9124.
      [AS_CASE([$target],
         [*-cygwin*|*-mingw*|*-windows|*-apple-darwin*],
           [function_sections=false;
@@ -2518,7 +2583,7 @@ AS_IF([test x"$enable_function_sections" = "xno"],
             [function_sections=true;
             oc_native_compflags='-function-sections'
             internal_cflags="$internal_cflags -ffunction-sections";
-            AC_DEFINE([FUNCTION_SECTIONS])],
+            AC_DEFINE([FUNCTION_SECTIONS], [1])],
           [function_sections=false;
           AC_MSG_NOTICE([Function sections are not supported by
           $ocaml_cc_vendor.])])])],
@@ -2541,38 +2606,38 @@ AS_IF([test "$ccomptype" != "msvc"],
 
 oc_cflags="$common_cflags $internal_cflags"
 oc_cppflags="$common_cppflags $internal_cppflags"
-ocamlc_cflags="$ocamlc_cflags $common_cflags $sharedlib_cflags $CFLAGS"
-ocamlc_cppflags="$common_cppflags $CPPFLAGS"
+
+oc_bytecode_cflags="$oc_cflags"
+oc_bytecode_cppflags="$oc_cppflags"
+
+oc_native_cflags="$oc_cflags $oc_native_cflags"
+native_cflags="$common_cflags $native_cflags"
+oc_native_cppflags="$oc_cppflags $oc_native_cppflags"
+
+bytecode_cflags="$common_cflags $sharedlib_cflags\
+ $PTHREAD_CFLAGS $COMPILER_BYTECODE_CFLAGS"
+native_cflags="$native_cflags $PTHREAD_CFLAGS $COMPILER_NATIVE_CFLAGS"
+
+bytecode_cppflags="$common_cppflags $COMPILER_BYTECODE_CPPFLAGS"
+native_cppflags="$common_cppflags $COMPILER_NATIVE_CPPFLAGS"
 
 AS_CASE([$host],
   [*-*-mingw32*],
-    [cclibs="$cclibs -lole32 -luuid -lversion"],
+    [cclibs="$cclibs -lole32 -luuid -lversion -lshlwapi -lsynchronization"],
   [*-pc-windows],
-    [# For whatever reason, flexlink includes -ladvapi32 for mingw-w64, but
-    # doesn't include advapi32.lib for MSVC
-    cclibs="$cclibs ole32.lib uuid.lib advapi32.lib version.lib"])
+    [# For whatever reason, flexlink includes -ladvapi32 and -lshell32 for
+    # mingw-w64, but doesn't include advapi32.lib and shell32.lib for MSVC
+    cclibs="$cclibs ole32.lib uuid.lib advapi32.lib shell32.lib version.lib \
+shlwapi.lib synchronization.lib"])
 
 AC_CONFIG_COMMANDS_PRE([cclibs="$cclibs $mathlib $DLLIBS $PTHREAD_LIBS"])
 
-AS_IF([$tsan],
-  [cclibs="$cclibs -fsanitize=thread"])
-
 AS_IF([test x"$libdir" = x'${exec_prefix}/lib'],
   [libdir="$libdir"/ocaml])
 
 AS_IF([test x"$mandir" = x'${datarootdir}/man'],
   [mandir='${prefix}/man'])
 
-AS_CASE([$host],
-  [*-*-mingw32*|*-pc-windows],
-    [AS_CASE([$WINDOWS_UNICODE_MODE],
-      [ansi],
-        [windows_unicode=0],
-      [compatible|""],
-        [windows_unicode=1],
-      [AC_MSG_ERROR([unexpected windows unicode mode])])],
-  [windows_unicode=0])
-
 # Define default prefix correctly for the different Windows ports
 AS_IF([test x"$prefix" = "xNONE"],
   [AS_CASE([$host],
@@ -2590,19 +2655,17 @@ AS_IF([test x"$prefix" = "xNONE"],
 # (all this should be understood and fixed)
 AS_CASE([$host],
   [*-*-mingw32*],
-    [AC_DEFINE([HAS_BROKEN_PRINTF])
-    AC_DEFINE([HAS_STRERROR])
-    AC_DEFINE([HAS_IPV6])
-    AC_DEFINE([HAS_NICE])],
+    [AC_DEFINE([HAS_BROKEN_PRINTF], [1])
+    AC_DEFINE([HAS_IPV6], [1])
+    AC_DEFINE([HAS_NICE], [1])],
   [*-pc-windows],
-    [AC_DEFINE([HAS_BROKEN_PRINTF])
-    AC_DEFINE([HAS_STRERROR])
-    AC_DEFINE([HAS_IPV6])
-    AC_DEFINE([HAS_NICE])],
+    [AC_DEFINE([HAS_BROKEN_PRINTF], [1])
+    AC_DEFINE([HAS_IPV6], [1])
+    AC_DEFINE([HAS_NICE], [1])],
   [*-*-solaris*],
     # This is required as otherwise floats are printed
     # as "Infinity" and "Inf" instead of the expected "inf"
-    [AC_DEFINE([HAS_BROKEN_PRINTF])])
+    [AC_DEFINE([HAS_BROKEN_PRINTF], [1])])
 
 # Do not permanently cache the result of flexdll.h
 unset ac_cv_header_flexdll_h
@@ -2636,9 +2699,6 @@ AC_CONFIG_COMMANDS_PRE([
   # Construct $mkexe
   mkexe="$mkexe_cmd"
   mkexe_exp="$mkexe_cmd_exp"
-  AS_IF([test -n "$mkexe_cflags"],
-    [mkexe="$mkexe $mkexe_cflags"
-    mkexe_exp="$mkexe_exp $common_cflags $CFLAGS"])
   AS_IF([test -n "$mkexe_extra_flags"],
     [mkexe="$mkexe $mkexe_extra_flags"
     mkexe_exp="$mkexe_exp $mkexe_extra_flags"])
@@ -2687,22 +2747,16 @@ ${mkdll_ldflags}"
   mkdll_exp="$mkdll_exp $mkdll_ldflags_exp"
   mkmaindll="$mkmaindll $mkdll_ldflags_exp"
   mkmaindll_exp="$mkmaindll_exp $mkdll_ldflags_exp"
-  # Do similarly with $mkexe_via_cc_ldflags_prefix, but this is only needed for
-  # the msvc ports.
-  AS_IF([test -n "$mkexe_via_cc_ldflags_prefix"],[
-    mkexe_via_cc_ldflags=\
-"\$(addprefix ${mkexe_via_cc_ldflags_prefix},\$(OC_LDFLAGS) \$(LDFLAGS))"
-  ],[
-    mkexe_via_cc_ldflags='$(OC_LDFLAGS) $(LDFLAGS)'
-  ])
+  mkexe_via_cc_ldflags="${mkexe_via_cc_ldflags_prefix}"
+  AS_IF([test -n "${oc_exe_ldflags}"],
+    [mkexe_via_cc_ldflags="${mkexe_via_cc_ldflags}${oc_exe_ldflags} "])
+  mkexe_via_cc_ldflags="${mkexe_via_cc_ldflags}\$(OC_LDFLAGS) \$(LDFLAGS)"
   # cl requires linker flags after the objects.
   AS_IF([test "$ccomptype" = 'msvc'],
     [mkexe_via_cc_ldflags=\
-"\$(OUTPUTEXE)\$(1) \$(2) $mkexe_via_cc_ldflags"],
+"/nologo \$(OUTPUTEXE)\$(1) \$(2) $mkexe_via_cc_ldflags"],
     [mkexe_via_cc_ldflags=\
 "$mkexe_via_cc_ldflags \$(OUTPUTEXE)\$(1) \$(2)"])
-  AS_IF([test -n "$mkexe_via_cc_extra_cmd"],
-    [mkexe_via_cc_ldflags="$mkexe_via_cc_ldflags $mkexe_via_cc_extra_cmd"])
 ])
 
 AC_OUTPUT

diff --git a/debugger/command_line.ml b/debugger/command_line.ml
index 6e4669567dfe0abc59c4068eeb2ba587d2e5f823..a962b9d65bf27d16425612a91bfa1763e18d82bc 100644 (file)
--- a/debugger/command_line.ml
+++ b/debugger/command_line.ml
@@ -1096,14 +1096,14 @@ Argument N means do this N times (or till program stops for another reason)." };
      (* Breakpoints *)
      { instr_name = "break"; instr_prio = false;
        instr_action = instr_break; instr_repeat = false; instr_help =
-"Set breakpoint.\
-\nSyntax: break\
-\n        break function-name\
-\n        break @ [module] linenum\
-\n        break @ [module] linenum columnnum\
-\n        break @ [module] # characternum\
-\n        break frag:pc\
-\n        break pc" };
+{|Set breakpoint.
+Syntax: break
+        break function-name
+        break @ [module] linenum
+        break @ [module] linenum columnnum
+        break @ [module] # characternum
+        break frag:pc
+        break pc|} };
      { instr_name = "delete"; instr_prio = false;
        instr_action = instr_delete; instr_repeat = false; instr_help =
 "delete some breakpoints.\n\

diff --git a/debugger/debugger_lexer.mll b/debugger/debugger_lexer.mll
index a180427225c90dd0c7c21aa8b27fa531d0879161..dc40db981c7270bc8df1f79374866adf498eb51d 100644 (file)
--- a/debugger/debugger_lexer.mll
+++ b/debugger/debugger_lexer.mll
@@ -18,10 +18,30 @@
 
 open Debugger_parser
 
+
+let ident_for_extended raw_name =
+  match Misc.Utf8_lexeme.normalize raw_name with
+  | Error _ -> raise Parsing.Parse_error
+  | Ok name ->
+  match Misc.Utf8_lexeme.validate_identifier name with
+  | Misc.Utf8_lexeme.Valid -> name
+  | Misc.Utf8_lexeme.Invalid_character _
+  | Misc.Utf8_lexeme.Invalid_beginning _ ->
+    raise Parsing.Parse_error
+
 exception Int_overflow
 
 }
 
+let lowercase = ['a'-'z' '_']
+let uppercase = ['A'-'Z']
+let identstart = lowercase | uppercase
+let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
+let utf8 = ['\192'-'\255'] ['\128'-'\191']*
+let identstart_ext = identstart | utf8
+let identchar_ext = identchar | utf8
+let ident_ext = identstart_ext  identchar_ext*
+
 rule line =     (* Read a whole line *)
   parse
     ([ ^ '\n' '\r' ]* as s) ('\n' | '\r' | "\r\n")
@@ -53,14 +73,17 @@ and lexeme =    (* Read a lexeme *)
   parse
     [' ' '\t'] +
       { lexeme lexbuf }
-  | ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
-    (['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255'
-      '\'' '0'-'9' ]) *
+  | lowercase identchar*
       { LIDENT(Lexing.lexeme lexbuf) }
-  | ['A'-'Z' '\192'-'\214' '\216'-'\222' ]
-    (['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255'
-      '\'' '0'-'9' ]) *
+  | uppercase identchar*
       { UIDENT(Lexing.lexeme lexbuf) }
+  | ident_ext as raw_name
+      {
+        let name = ident_for_extended raw_name in
+        if Misc.Utf8_lexeme.is_capitalized name
+        then UIDENT name
+        else LIDENT name
+      }
   | '"' [^ '"']* "\""
       { let s = Lexing.lexeme lexbuf in
         LIDENT(String.sub s 1 (String.length s - 2)) }

diff --git a/debugger/eval.ml b/debugger/eval.ml
index 190ff4f2fde5aca217c29e32291890d9371e7940..364fac0b3e3d8c94bd4eaed61ab2a5a39855ff9c 100644 (file)
--- a/debugger/eval.ml
+++ b/debugger/eval.ml
@@ -104,8 +104,7 @@ let rec expression event env = function
             | _ ->
                 value_path event env p
           in
-          let typ = Ctype.correct_levels valdesc.val_type in
-          v, typ
+          v, valdesc.val_type
       | exception Not_found ->
           raise(Error(Unbound_long_identifier lid))
     end
@@ -186,26 +185,30 @@ and find_label lbl env ty path tydesc pos = function
 
 open Format
 module Style = Misc.Style
+module Printtyp = Printtyp.Doc
+
+let as_inline_code pr = Format_doc.compat @@ Style.as_inline_code pr
+let inline_code = Format_doc.compat Style.inline_code
 
 let report_error ppf = function
   | Unbound_identifier id ->
       fprintf ppf "@[Unbound identifier %a@]@."
-        Style.inline_code (Ident.name id)
+        inline_code (Ident.name id)
   | Not_initialized_yet path ->
       fprintf ppf
         "@[The module path %a is not yet initialized.@ \
            Please run program forward@ \
            until its initialization code is executed.@]@."
-      (Style.as_inline_code Printtyp.path) path
+      (as_inline_code Printtyp.path) path
   | Unbound_long_identifier lid ->
       fprintf ppf "@[Unbound identifier %a@]@."
-        (Style.as_inline_code Printtyp.longident) lid
+        (as_inline_code Printtyp.longident) lid
   | Unknown_name n ->
       fprintf ppf "@[Unknown value name $%i@]@." n
   | Tuple_index(ty, len, pos) ->
       fprintf ppf
         "@[Cannot extract field number %i from a %i-tuple of type@ %a@]@."
-        pos len (Style.as_inline_code Printtyp.type_expr) ty
+        pos len (as_inline_code Printtyp.type_expr) ty
   | Array_index(len, pos) ->
       fprintf ppf
         "@[Cannot extract element number %i from an array of length %i@]@."
@@ -222,15 +225,15 @@ let report_error ppf = function
   | Wrong_item_type(ty, pos) ->
       fprintf ppf
         "@[Cannot extract item number %i from a value of type@ %a@]@."
-        pos (Style.as_inline_code Printtyp.type_expr) ty
+        pos (as_inline_code Printtyp.type_expr) ty
   | Wrong_label(ty, lbl) ->
       fprintf ppf
         "@[The record type@ %a@ has no label named %a@]@."
-        (Style.as_inline_code Printtyp.type_expr) ty
-        Style.inline_code lbl
+        (as_inline_code Printtyp.type_expr) ty
+        inline_code lbl
   | Not_a_record ty ->
       fprintf ppf
         "@[The type@ %a@ is not a record type@]@."
-        (Style.as_inline_code Printtyp.type_expr) ty
+        (as_inline_code Printtyp.type_expr) ty
   | No_result ->
       fprintf ppf "@[No result available at current program event@]@."

diff --git a/debugger/loadprinter.ml b/debugger/loadprinter.ml
index 15ac6c325c746ec11447123371bd9757b61eb65b..c0f6e35ab3a3a565ee13adcdaa0bfddb0cb6d383 100644 (file)
--- a/debugger/loadprinter.ml
+++ b/debugger/loadprinter.ml
@@ -92,7 +92,7 @@ let eval_value_path env path =
 (* Install, remove a printer (as in toplevel/topdirs) *)
 
 let match_printer_type desc make_printer_type =
-  Ctype.with_local_level ~post:Ctype.generalize begin fun () ->
+  Ctype.with_local_level_generalize begin fun () ->
     let ty_arg = Ctype.newvar() in
     Ctype.unify Env.empty
       (make_printer_type ty_arg)
@@ -140,6 +140,8 @@ let remove_printer lid =
 
 open Format
 module Style = Misc.Style
+let quoted_longident =
+  Format_doc.compat @@ Style.as_inline_code Printtyp.Doc.longident
 
 let report_error ppf = function
   | Load_failure e ->
@@ -147,15 +149,15 @@ let report_error ppf = function
         (Dynlink.error_message e)
   | Unbound_identifier lid ->
       fprintf ppf "@[Unbound identifier %a@]@."
-      (Style.as_inline_code Printtyp.longident) lid
+        quoted_longident lid
   | Unavailable_module(md, lid) ->
       fprintf ppf
         "@[The debugger does not contain the code for@ %a.@ \
-           Please load an implementation of %s first.@]@."
-        (Style.as_inline_code Printtyp.longident) lid md
+         Please load an implementation of %s first.@]@."
+        quoted_longident lid md
   | Wrong_type lid ->
       fprintf ppf "@[%a has the wrong type for a printing function.@]@."
-      (Style.as_inline_code Printtyp.longident) lid
+        quoted_longident lid
   | No_active_printer lid ->
       fprintf ppf "@[%a is not currently active as a printing function.@]@."
-      (Style.as_inline_code Printtyp.longident) lid
+        quoted_longident lid

diff --git a/debugger/main.ml b/debugger/main.ml
index 006e8fd5bb77f9953e4723f8d600ea0e25965e09..6c25435130baa783384e968dbf4a00f015d37c12 100644 (file)
--- a/debugger/main.ml
+++ b/debugger/main.ml
@@ -198,6 +198,8 @@ let report report_error error =
   eprintf "Debugger [version %s] environment error:@ @[@;%a@]@.;"
     Config.version report_error error
 
+let usage = "Usage: ocamldebug [options] <program> [arguments]\nOptions are:"
+
 let main () =
   Callback.register "Debugger.function_placeholder" function_placeholder;
   try
@@ -211,11 +213,8 @@ let main () =
                                 ("camldebug" ^ (Int.to_string (Unix.getpid ())))
       );
     begin try
-      Arg.parse speclist anonymous "";
-      Arg.usage speclist
-        "No program name specified\n\
-         Usage: ocamldebug [options] <program> [arguments]\n\
-         Options are:";
+      Arg.parse speclist anonymous usage;
+      Arg.usage speclist ("No program name specified\n" ^ usage);
       exit 2
     with Found_program_name ->
       for j = !Arg.current + 1 to Array.length Sys.argv - 1 do

diff --git a/debugger/program_management.ml b/debugger/program_management.ml
index ea315589d2047894a4e6ce22060a9c2546b5b7c2..3a3b84092662c8a48e7f58132c565123fc13c4d5 100644 (file)
--- a/debugger/program_management.ml
+++ b/debugger/program_management.ml
@@ -45,7 +45,7 @@ let control_connection pid fd =
 
 (* Accept a connection from another process. *)
 let accept_connection continue fd =
-  let (sock, _) = accept fd.io_fd in
+  let (sock, _) = accept ~cloexec:true fd.io_fd in
   let io_chan = io_channel_of_descr sock in
   let pid = input_binary_int io_chan.io_in in
   if pid = -1 then begin
@@ -62,16 +62,15 @@ let accept_connection continue fd =
 (* Initialize the socket. *)
 let open_connection address continue =
   try
-    let (sock_domain, sock_address) = convert_address address in
+    let addr_info = convert_address address in
       file_name :=
-        (match sock_address with
-           ADDR_UNIX file ->
-             Some file
-         | _ ->
-             None);
-      let sock = socket sock_domain SOCK_STREAM 0 in
+        (match addr_info with
+         | { ai_addr = ADDR_UNIX file; _} -> Some file
+         | _ -> None);
+      let sock = socket ~cloexec:true addr_info.ai_family addr_info.ai_socktype
+                   addr_info.ai_protocol in
         (try
-           bind sock sock_address;
+           bind sock addr_info.ai_addr;
            setsockopt sock SO_REUSEADDR true;
            listen sock 3;
            connection := io_channel_of_descr sock;
@@ -79,7 +78,7 @@ let open_connection address continue =
            connection_opened := true
          with x -> cleanup x @@ fun () -> close sock)
   with
-    Failure _ -> raise Toplevel
+    Failure e -> prerr_endline e; raise Toplevel
   | (Unix_error _) as err -> report_error err; raise Toplevel
 
 (* Close the socket. *)

diff --git a/debugger/unix_tools.ml b/debugger/unix_tools.ml
index f61ac9133571f3e2068a64da9606d2963430b063..e054615addcad80bff22ef86e8bb9dd12408b194 100644 (file)
--- a/debugger/unix_tools.ml
+++ b/debugger/unix_tools.ml
@@ -22,24 +22,31 @@ open Unix
 
 (*** Convert a socket name into a socket address. ***)
 let convert_address address =
-  try
-    let n = String.index address ':' in
-      let host = String.sub address 0 n
-      and port = String.sub address (n + 1) (String.length address - n - 1)
-      in
-        (PF_INET,
-         ADDR_INET
-           ((try inet_addr_of_string host with Failure _ ->
-               try (gethostbyname host).h_addr_list.(0) with Not_found ->
-                 prerr_endline ("Unknown host: " ^ host);
-                 failwith "Can't convert address"),
-            (try int_of_string port with Failure _ ->
-               prerr_endline "The port number should be an integer";
-               failwith "Can't convert address")))
-  with Not_found ->
-    match Sys.os_type with
-      "Win32" -> failwith "Unix sockets not supported"
-    | _ -> (PF_UNIX, ADDR_UNIX address)
+  if address = "" then
+    failwith "Can't convert address: empty address";
+  let unix_addr_info =
+    { ai_family = PF_UNIX; ai_socktype = SOCK_STREAM; ai_protocol = 0;
+      ai_addr = ADDR_UNIX address; ai_canonname = ""; } in
+  match String.rindex address ':' with
+  | exception Not_found -> unix_addr_info
+  (* "./foo" is explicitly a path and not a network address *)
+  | _ when not (Filename.is_implicit address) -> unix_addr_info
+  | n ->
+     let is_likely_ipv6 =
+       n >= 4 && address.[0] = '[' && address.[n - 1] = ']' in
+     let host = if is_likely_ipv6 then String.sub address 1 (n - 2)
+                else String.sub address 0 n
+     and port = String.(sub address (n + 1) (length address - n - 1)) in
+     if host = "" || port = "" then
+       Printf.ksprintf failwith "Can't convert address %S: \
+                                 empty host or empty port" address;
+     port |> String.iter (fun c -> if c < '0' || '9' < c then
+       Printf.ksprintf failwith "Can't convert address %S: \
+                                 the port number should be an integer" address);
+     match getaddrinfo host port [AI_SOCKTYPE SOCK_STREAM] with
+     | addr_info :: _ -> addr_info
+     | [] -> Printf.ksprintf failwith
+               "Can't convert address: unknown host %S port %S" host port
 
 (*** Report a unix error. ***)
 let report_error = function

diff --git a/debugger/unix_tools.mli b/debugger/unix_tools.mli
index db3af072cc6dbea87354b31743bab95139435a9c..e579f9620bd39be38aa3eaaeb811a9d9f20b40c8 100644 (file)
--- a/debugger/unix_tools.mli
+++ b/debugger/unix_tools.mli
@@ -19,7 +19,7 @@
 open Unix
 
 (* Convert a socket name into a socket address. *)
-val convert_address : string -> socket_domain * sockaddr
+val convert_address : string -> addr_info
 
 (* Report an unix error. *)
 val report_error : exn -> unit

diff --git a/driver/compenv.ml b/driver/compenv.ml
index 921c0565500196c3453d838ca8b33a38d0a7ea17..d61d2b19fd0f3b45a4d36cf612c962df7790f44a 100644 (file)
--- a/driver/compenv.ml
+++ b/driver/compenv.ml
@@ -451,7 +451,7 @@ let read_one_param ppf position name v =
     end
   | "dump-into-file" -> Clflags.dump_into_file := true
   | "dump-dir" -> Clflags.dump_dir := Some v
-
+  | "keywords"  -> Clflags.keyword_edition := Some v
   | _ ->
     if not (List.mem name !can_discard) then begin
       can_discard := name :: !can_discard;

diff --git a/driver/compile.ml b/driver/compile.ml
index 3d581ea45076076753ee1f01967ce32c5dc42ef9..c54f9a3fbdb5f8992a58a84b063e24fb020ff93e 100644 (file)
--- a/driver/compile.ml
+++ b/driver/compile.ml
@@ -22,7 +22,8 @@ let with_info =
   Compile_common.with_info ~native:false ~tool_name
 
 let interface ~source_file ~output_prefix =
-  with_info ~source_file ~output_prefix ~dump_ext:"cmi" @@ fun info ->
+  let unit_info = Unit_info.make ~source_file Intf output_prefix in
+  with_info ~dump_ext:"cmi" unit_info @@ fun info ->
   Compile_common.interface info
 
 (** Bytecode compilation backend for .ml files. *)
@@ -61,7 +62,8 @@ let implementation ~start_from ~source_file ~output_prefix =
     let bytecode = to_bytecode info typed in
     emit_bytecode info bytecode
   in
-  with_info ~source_file ~output_prefix ~dump_ext:"cmo" @@ fun info ->
+  let unit_info = Unit_info.make ~source_file Impl output_prefix in
+  with_info ~dump_ext:"cmo" unit_info @@ fun info ->
   match (start_from : Clflags.Compiler_pass.t) with
   | Parsing -> Compile_common.implementation info ~backend
   | _ -> Misc.fatal_errorf "Cannot start from %s"

diff --git a/driver/compile_common.ml b/driver/compile_common.ml
index a57f81933e2f3d90dcb889f63586673b9ca45fc3..9b56c542c65c5bbd916dc10b8de884747e616b51 100644 (file)
--- a/driver/compile_common.ml
+++ b/driver/compile_common.ml
@@ -23,15 +23,14 @@ type info = {
   native : bool;
 }
 
-let with_info ~native ~tool_name ~source_file ~output_prefix ~dump_ext k =
+let with_info ~native ~tool_name ~dump_ext unit_info k =
   Compmisc.init_path ();
-  let target = Unit_info.make ~source_file output_prefix in
-  Env.set_unit_name (Unit_info.modname target);
+  Env.set_current_unit unit_info ;
   let env = Compmisc.initial_env() in
-  let dump_file = String.concat "." [output_prefix; dump_ext] in
+  let dump_file = String.concat "." [Unit_info.prefix unit_info; dump_ext] in
   Compmisc.with_ppf_dump ~file_prefix:dump_file @@ fun ppf_dump ->
   k {
-    target;
+    target = unit_info;
     env;
     ppf_dump;
     tool_name;
@@ -52,21 +51,21 @@ let typecheck_intf info ast =
     |> Typemod.type_interface info.env
     |> print_if info.ppf_dump Clflags.dump_typedtree Printtyped.interface
   in
+  let alerts = Builtin_attributes.alerts_of_sig ~mark:true ast in
   let sg = tsg.Typedtree.sig_type in
   if !Clflags.print_types then
     Printtyp.wrap_printing_env ~error:false info.env (fun () ->
         Format.(fprintf std_formatter) "%a@."
           (Printtyp.printed_signature (Unit_info.source_file info.target))
           sg);
-  ignore (Includemod.signatures info.env ~mark:Mark_both sg sg);
+  ignore (Includemod.signatures info.env ~mark:true sg sg);
   Typecore.force_delayed_checks ();
   Builtin_attributes.warn_unused ();
   Warnings.check_fatal ();
-  tsg
+  alerts, tsg
 
-let emit_signature info ast tsg =
+let emit_signature info alerts tsg =
   let sg =
-    let alerts = Builtin_attributes.alerts_of_sig ast in
     Env.save_signature ~alerts tsg.Typedtree.sig_type
       (Unit_info.cmi info.target)
   in
@@ -76,9 +75,9 @@ let interface info =
   Profile.record_call (Unit_info.source_file info.target) @@ fun () ->
   let ast = parse_intf info in
   if Clflags.(should_stop_after Compiler_pass.Parsing) then () else begin
-    let tsg = typecheck_intf info ast in
+    let alerts, tsg = typecheck_intf info ast in
     if not !Clflags.print_types then begin
-      emit_signature info ast tsg
+      emit_signature info alerts tsg
     end
   end
 

diff --git a/driver/compile_common.mli b/driver/compile_common.mli
index 158b1f9ce1294cd4b21b0178cb2c0c72fdbacbf5..4fd144327a18deeba48801717179bb2ce6a19d1f 100644 (file)
--- a/driver/compile_common.mli
+++ b/driver/compile_common.mli
@@ -28,15 +28,14 @@ type info = {
 val with_info :
   native:bool ->
   tool_name:string ->
-  source_file:string ->
-  output_prefix:string ->
   dump_ext:string ->
+  Unit_info.t ->
   (info -> 'a) -> 'a
-(** [with_info ~native ~tool_name ~source_file ~output_prefix ~dump_ext k]
-   invokes its continuation [k] with an [info] structure built from
-   its input, after initializing various global variables. This info
-   structure and the initialized global state are not valid anymore
-   after the continuation returns.
+(** [with_info ~native ~tool_name ~dump_ext unit_info k] invokes its
+    continuation [k] with an [info] structure passed as input, after
+    initializing various global variables. This info structure and the
+    initialized global state are not valid anymore after the continuation
+    returns.
 
    Due to current implementation limitations in the compiler, it is
    unsafe to try to compile several distinct compilation units by
@@ -48,12 +47,13 @@ val with_info :
 val parse_intf : info -> Parsetree.signature
 (** [parse_intf info] parses an interface (usually an [.mli] file). *)
 
-val typecheck_intf : info -> Parsetree.signature -> Typedtree.signature
+val typecheck_intf :
+  info -> Parsetree.signature -> Misc.alerts * Typedtree.signature
 (** [typecheck_intf info parsetree] typechecks an interface and returns
     the typedtree of the associated signature.
 *)
 
-val emit_signature : info -> Parsetree.signature -> Typedtree.signature -> unit
+val emit_signature : info -> Misc.alerts -> Typedtree.signature -> unit
 (** [emit_signature info parsetree typedtree] emits the [.cmi] file
     containing the given signature.
 *)

diff --git a/driver/compmisc.ml b/driver/compmisc.ml
index dea87b479a96b5db72aae15ac639d6c448930b79..d4100900380c3d43b43f1dc300b7a3c03a4bc11e 100644 (file)
--- a/driver/compmisc.ml
+++ b/driver/compmisc.ml
@@ -38,7 +38,9 @@ let init_path ?(auto_include=auto_include) ?(dir="") () =
     List.concat
       [!Compenv.last_include_dirs;
        visible;
-       Config.flexdll_dirs;
+       (* Config.flexdll_dirs is either [] or ["+flexdll"]: don't include a
+          reference to the Standard Library when -nostdlib was specified. *)
+       (if !Clflags.no_std_include then [] else Config.flexdll_dirs);
        !Compenv.first_include_dirs]
   in
   let visible =

diff --git a/driver/main_args.ml b/driver/main_args.ml
index 732dea3d54433f7baae1bdc0e1540ca623cc369c..ea07d15cf19f3037d082b82e43e5fc2072a87de2 100644 (file)
--- a/driver/main_args.ml
+++ b/driver/main_args.ml
@@ -407,6 +407,15 @@ let mk_ppx f =
   "-ppx", Arg.String f,
   "<command>  Pipe abstract syntax trees through preprocessor <command>"
 
+let mk_keywords f =
+  "-keywords", Arg.String f,
+  "<version+list>  set keywords following the <version+list> spec:\n
+  \                -<version> if present specifies the base set of keywords\n
+  \                  (if absent the current set of keywords is used)
+  \                -<list> is a \"+\"-separated list of keywords to add to\n
+  \                  the base set of keywords.
+  "
+
 let mk_plugin f =
   "-plugin", Arg.String f,
   "<plugin>  (no longer supported)"
@@ -782,6 +791,7 @@ module type Common_options = sig
   val _nocwd : unit -> unit
   val _open : string -> unit
   val _ppx : string -> unit
+  val _keywords: string -> unit
   val _principal : unit -> unit
   val _no_principal : unit -> unit
   val _rectypes : unit -> unit
@@ -1053,6 +1063,7 @@ struct
     mk_no_keep_docs F._no_keep_docs;
     mk_keep_locs F._keep_locs;
     mk_no_keep_locs F._no_keep_locs;
+    mk_keywords F._keywords;
     mk_labels F._labels;
     mk_linkall F._linkall;
     mk_make_runtime F._make_runtime;
@@ -1161,6 +1172,7 @@ struct
     mk_nopervasives F._nopervasives;
     mk_open F._open;
     mk_ppx F._ppx;
+    mk_keywords F._keywords;
     mk_principal F._principal;
     mk_no_principal F._no_principal;
     mk_rectypes F._rectypes;
@@ -1258,6 +1270,7 @@ struct
     mk_no_keep_docs F._no_keep_docs;
     mk_keep_locs F._keep_locs;
     mk_no_keep_locs F._no_keep_locs;
+    mk_keywords F._keywords;
     mk_labels F._labels;
     mk_linkall F._linkall;
     mk_inline_max_depth F._inline_max_depth;
@@ -1394,6 +1407,7 @@ module Make_opttop_options (F : Opttop_options) = struct
     mk_inline_indirect_cost F._inline_indirect_cost;
     mk_inline_lifting_benefit F._inline_lifting_benefit;
     mk_inline_branch_factor F._inline_branch_factor;
+    mk_keywords F._keywords;
     mk_labels F._labels;
     mk_alias_deps F._alias_deps;
     mk_no_alias_deps F._no_alias_deps;
@@ -1491,6 +1505,7 @@ struct
     mk_intf F._intf;
     mk_intf_suffix F._intf_suffix;
     mk_intf_suffix_2 F._intf_suffix;
+    mk_keywords F._keywords;
     mk_labels F._labels;
     mk_modern F._labels;
     mk_alias_deps F._alias_deps;
@@ -1631,6 +1646,7 @@ module Default = struct
       Misc.set_or_ignore error_style_reader.parse error_style
     let _nopervasives = set nopervasives
     let _ppx s = Compenv.first_ppx := (s :: (!Compenv.first_ppx))
+    let _keywords s = Clflags.keyword_edition := (Some s)
     let _unsafe = set unsafe
     let _warn_error s =
       Warnings.parse_options true s |> Option.iter Location.(prerr_alert none)
@@ -1884,6 +1900,7 @@ module Default = struct
     let _intf_suffix s = Config.interface_suffix := s
     let _pp s = Clflags.preprocessor := (Some s)
     let _ppx s = Clflags.all_ppx := (s :: (!Clflags.all_ppx))
+    let _keywords s = Clflags.keyword_edition := Some s
     let _thread = set Clflags.use_threads
     let _v () = Compenv.print_version_and_library "documentation generator"
     let _verbose = set Clflags.verbose

diff --git a/driver/main_args.mli b/driver/main_args.mli
index 2a9faeb514a4b3616a7a6cf464569005316e929b..554b1fa36bad1f376ae487d858e774a8d7992dea 100644 (file)
--- a/driver/main_args.mli
+++ b/driver/main_args.mli
@@ -33,6 +33,7 @@ module type Common_options = sig
   val _nocwd : unit -> unit
   val _open : string -> unit
   val _ppx : string -> unit
+  val _keywords: string -> unit
   val _principal : unit -> unit
   val _no_principal : unit -> unit
   val _rectypes : unit -> unit

diff --git a/driver/makedepend.ml b/driver/makedepend.ml
index c90a22036fdced37d800fd008e169fe9e84c4cc8..ecd74183043a1abb4eef7b5800cc91b844eac375 100644 (file)
--- a/driver/makedepend.ml
+++ b/driver/makedepend.ml
@@ -427,7 +427,7 @@ let sort_files_by_dependencies files =
 
 (* Init Hashtbl with all defined modules *)
   let files = List.map (fun (file, file_kind, deps, pp_deps) ->
-    let modname = Unit_info.modname_from_source file in
+    let modname = Unit_info.lax_modname_from_source file in
     let key = (modname, file_kind) in
     let new_deps = ref [] in
     Hashtbl.add h key (file, new_deps);
@@ -526,7 +526,7 @@ let parse_map fname =
       ~mli_file:process_mli_map
   in
   Clflags.transparent_modules := old_transp;
-  let modname = Unit_info.modname_from_source fname in
+  let modname = Unit_info.lax_modname_from_source fname in
   if String.Map.is_empty m then
     report_err (Failure (fname ^ " : empty map file or parse error"));
   let mm = Depend.make_node m in

diff --git a/driver/optcompile.ml b/driver/optcompile.ml
index 1638951fbbb38b3d4d7db024f996f91623c502fc..5278e5bfe73e53062d2dff3c38d9777aac998333 100644 (file)
--- a/driver/optcompile.ml
+++ b/driver/optcompile.ml
@@ -24,7 +24,8 @@ let with_info =
   Compile_common.with_info ~native:true ~tool_name
 
 let interface ~source_file ~output_prefix =
-  with_info ~source_file ~output_prefix ~dump_ext:"cmi" @@ fun info ->
+  let unit_info = Unit_info.make ~source_file Intf output_prefix in
+  with_info ~dump_ext:"cmi" unit_info @@ fun info ->
   Compile_common.interface info
 
 let (|>>) (x, y) f = (x, f y)
@@ -108,7 +109,8 @@ let implementation ~backend ~start_from ~source_file ~output_prefix =
     then flambda info backend typed
     else clambda info backend typed
   in
-  with_info ~source_file ~output_prefix ~dump_ext:"cmx" @@ fun info ->
+  let unit_info = Unit_info.make ~source_file Impl output_prefix in
+  with_info ~dump_ext:"cmx" unit_info @@ fun info ->
   match (start_from:Clflags.Compiler_pass.t) with
   | Parsing -> Compile_common.implementation info ~backend
   | Emit -> emit info

diff --git a/driver/pparse.ml b/driver/pparse.ml
index f2b5e412a7ea90e8ba6f8ae08cec5ed6d2330aa8..736dda7cc928788b46fa3aee1972647326874126 100644 (file)
--- a/driver/pparse.ml
+++ b/driver/pparse.ml
@@ -13,7 +13,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Format
+open Format_doc
 
 type error =
   | CannotRun of string
@@ -218,7 +218,7 @@ let file_aux ~tool_name ~sourcefile inputfile (type a) parse_fun invariant_fun
 let file ~tool_name inputfile parse_fun ast_kind =
   file_aux ~tool_name ~sourcefile:inputfile inputfile parse_fun ignore ast_kind
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | CannotRun cmd ->
       fprintf ppf "Error while running external preprocessor@.\
                    Command line: %s@." cmd
@@ -229,10 +229,12 @@ let report_error ppf = function
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
 
+let report_error = Format_doc.compat report_error_doc
+
 let parse_file ~tool_name invariant_fun parse kind sourcefile =
   Location.input_name := sourcefile;
   let inputfile = preprocess sourcefile in

diff --git a/driver/pparse.mli b/driver/pparse.mli
index 40b77a8b042b741fdec1e3b4e9c23bd4206c8e2a..63cfb025600d1b319957d8f8fa66dd14a34c09e3 100644 (file)
--- a/driver/pparse.mli
+++ b/driver/pparse.mli
@@ -20,8 +20,6 @@
 
 *)
 
-open Format
-
 type error =
   | CannotRun of string
   | WrongMagic of string
@@ -53,7 +51,8 @@ val apply_rewriters_sig:
   ?restore:bool -> tool_name:string -> Parsetree.signature ->
   Parsetree.signature
 
-val report_error : formatter -> error -> unit
+val report_error : error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
 
 
 val parse_implementation:

diff --git a/dune b/dune
index fd719c52980fec4efde4b20fcb1e773bc26365e0..6b2ca4c0a7540a257cc123061bb705ac08ffd08c 100644 (file)
--- a/dune
+++ b/dune
@@ -39,13 +39,14 @@
  (flags (:standard -principal -nostdlib \ -short-paths))
  (libraries stdlib)
  (modules_without_implementation
-   annot asttypes cmo_format outcometree parsetree value_rec_types)
+   annot cmo_format outcometree parsetree value_rec_types)
  (modules
    ;; UTILS
-   config build_path_prefix_map misc identifiable numbers arg_helper clflags
-   profile terminfo ccomp warnings consistbl strongly_connected_components
-   targetint load_path int_replace_polymorphic_compare binutils local_store
-   lazy_backtrack diffing diffing_with_keys unit_info compression
+   config build_path_prefix_map misc identifiable numbers arg_helper
+   clflags profile terminfo ccomp format_doc warnings consistbl
+   strongly_connected_components targetint load_path
+   int_replace_polymorphic_compare binutils local_store lazy_backtrack diffing
+   diffing_with_keys unit_info compression linkdeps
 
    ;; PARSING
    location longident docstrings syntaxerr ast_helper camlinternalMenhirLib

diff --git a/file_formats/cmi_format.ml b/file_formats/cmi_format.ml
index 9b29030ca2802231df465842957386723a28e11b..8e8c27edc2f57c0f5b278d5ab41ba25f3ce54545 100644 (file)
--- a/file_formats/cmi_format.ml
+++ b/file_formats/cmi_format.ml
@@ -94,25 +94,26 @@ let output_cmi filename oc cmi =
 
 (* Error report *)
 
-open Format
-module Style = Misc.Style
+open Format_doc
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Not_an_interface filename ->
       fprintf ppf "%a@ is not a compiled interface"
-        (Style.as_inline_code Location.print_filename) filename
+        Location.Doc.quoted_filename filename
   | Wrong_version_interface (filename, older_newer) ->
       fprintf ppf
         "%a@ is not a compiled interface for this version of OCaml.@.\
          It seems to be for %s version of OCaml."
-        (Style.as_inline_code  Location.print_filename) filename older_newer
+        Location.Doc.quoted_filename filename older_newer
   | Corrupted_interface filename ->
       fprintf ppf "Corrupted compiled interface@ %a"
-        (Style.as_inline_code Location.print_filename) filename
+        Location.Doc.quoted_filename filename
 
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/file_formats/cmi_format.mli b/file_formats/cmi_format.mli
index 2a63deb3dc7286f5a5845489791cacd33fc38472..1a170106ce1e317ea3dbe32a985ac89d413ee6fc 100644 (file)
--- a/file_formats/cmi_format.mli
+++ b/file_formats/cmi_format.mli
@@ -45,6 +45,5 @@ type error =
 
 exception Error of error
 
-open Format
-
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/file_formats/cmt_format.ml b/file_formats/cmt_format.ml
index 853aeec8f0a0d9eeb84b0fdf417f9bc4346d0026..c9efa3c051d0b1fa15a7d72760cc5d0186f3561d 100644 (file)
--- a/file_formats/cmt_format.ml
+++ b/file_formats/cmt_format.ml
@@ -45,11 +45,11 @@ and binary_part =
   | Partial_signature_item of signature_item
   | Partial_module_type of module_type
 
+type dependency_kind =  Definition_to_declaration | Declaration_to_declaration
 type cmt_infos = {
   cmt_modname : string;
   cmt_annots : binary_annots;
-  cmt_value_dependencies :
-    (Types.value_description * Types.value_description) list;
+  cmt_declaration_dependencies : (dependency_kind * Uid.t * Uid.t) list;
   cmt_comments : (string * Location.t) list;
   cmt_args : string array;
   cmt_sourcefile : string option;
@@ -425,19 +425,19 @@ let read_cmi filename =
     | Some cmi, _ -> cmi
 
 let saved_types = ref []
-let value_deps = ref []
+let uids_deps : (dependency_kind * Uid.t * Uid.t) list ref = ref []
 
 let clear () =
   saved_types := [];
-  value_deps := []
+  uids_deps := []
 
 let add_saved_type b = saved_types := b :: !saved_types
 let get_saved_types () = !saved_types
 let set_saved_types l = saved_types := l
 
-let record_value_dependency vd1 vd2 =
-  if vd1.Types.val_loc <> vd2.Types.val_loc then
-    value_deps := (vd1, vd2) :: !value_deps
+let record_declaration_dependency (rk, uid1, uid2) =
+  if not (Uid.equal uid1 uid2) then
+    uids_deps := (rk, uid1, uid2) :: !uids_deps
 
 let save_cmt target binary_annots initial_env cmi shape =
   if !Clflags.binary_annotations && not !Clflags.print_types then begin
@@ -462,7 +462,7 @@ let save_cmt target binary_annots initial_env cmi shape =
          let cmt = {
            cmt_modname = Unit_info.Artifact.modname target;
            cmt_annots;
-           cmt_value_dependencies = !value_deps;
+           cmt_declaration_dependencies = !uids_deps;
            cmt_comments = Lexer.comments ();
            cmt_args = Sys.argv;
            cmt_sourcefile = sourcefile;

diff --git a/file_formats/cmt_format.mli b/file_formats/cmt_format.mli
index d27f56bccb4ead7c1af215ad159c8faa48a76e94..524283bc6fe09210ce2aed074f03b2ab1fc2bf20 100644 (file)
--- a/file_formats/cmt_format.mli
+++ b/file_formats/cmt_format.mli
@@ -50,11 +50,11 @@ and binary_part =
   | Partial_signature_item of signature_item
   | Partial_module_type of module_type
 
+type dependency_kind = Definition_to_declaration | Declaration_to_declaration
 type cmt_infos = {
   cmt_modname : modname;
   cmt_annots : binary_annots;
-  cmt_value_dependencies :
-    (Types.value_description * Types.value_description) list;
+  cmt_declaration_dependencies : (dependency_kind * Uid.t * Uid.t) list;
   cmt_comments : (string * Location.t) list;
   cmt_args : string array;
   cmt_sourcefile : string option;
@@ -109,8 +109,7 @@ val add_saved_type : binary_part -> unit
 val get_saved_types : unit -> binary_part list
 val set_saved_types : binary_part list -> unit
 
-val record_value_dependency:
-  Types.value_description -> Types.value_description -> unit
+val record_declaration_dependency: dependency_kind * Uid.t * Uid.t -> unit
 
 (*
 

diff --git a/file_formats/linear_format.ml b/file_formats/linear_format.ml
index 5b45ff9a80982d96c309bf03e5100de6374bbcf6..98e2563cb1d301180e88ffb343e8bd887fc7ed02 100644 (file)
--- a/file_formats/linear_format.ml
+++ b/file_formats/linear_format.ml
@@ -76,23 +76,22 @@ let restore filename =
 
 (* Error report *)
 
-open Format
-module Style=Misc.Style
+open Format_doc
 
 let report_error ppf = function
   | Wrong_format filename ->
       fprintf ppf "Expected Linear format. Incompatible file %a"
-        (Style.as_inline_code Location.print_filename) filename
+         Location.Doc.quoted_filename filename
   | Wrong_version filename ->
       fprintf ppf
         "%a@ is not compatible with this version of OCaml"
-        (Style.as_inline_code Location.print_filename) filename
+        Location.Doc.quoted_filename filename
   | Corrupted filename ->
       fprintf ppf "Corrupted format@ %a"
-        (Style.as_inline_code Location.print_filename) filename
+        Location.Doc.quoted_filename filename
   | Marshal_failed filename ->
       fprintf ppf "Failed to marshal Linear to file@ %a"
-        (Style.as_inline_code Location.print_filename) filename
+         Location.Doc.quoted_filename filename
 
 let () =
   Location.register_error_of_exn

diff --git a/lambda/lambda.ml b/lambda/lambda.ml
index 6a4e16e707c50d2f334ded86a37bc8a598e7a381..9fdbc8146e9f36f9f2b8bc5ced8bb2f03f9b9f9f 100644 (file)
--- a/lambda/lambda.ml
+++ b/lambda/lambda.ml
@@ -151,6 +151,8 @@ type primitive =
   | Popaque
   (* Fetching domain-local state *)
   | Pdls_get
+  (* Poll for runtime actions *)
+  | Ppoll
 
 and integer_comparison =
     Ceq | Cne | Clt | Cgt | Cle | Cge
@@ -575,6 +577,10 @@ let shallow_iter ~tail ~non_tail:f = function
 let iter_head_constructor f l =
   shallow_iter ~tail:f ~non_tail:f l
 
+let is_evaluated = function
+  | Lconst _ | Lvar _ | Lfunction _ -> true
+  | _ -> false
+
 let rec free_variables = function
   | Lvar id
   | Lmutvar id -> Ident.Set.singleton id

diff --git a/lambda/lambda.mli b/lambda/lambda.mli
index 2a3113bc486a256e91f5762dd9a87a024b4b6db3..6f5d9717914b4bc202cbda887eab58a6db3d3ab9 100644 (file)
--- a/lambda/lambda.mli
+++ b/lambda/lambda.mli
@@ -161,6 +161,10 @@ type primitive =
   | Popaque
   (* Fetching domain-local state *)
   | Pdls_get
+  (* Poll for runtime actions. May run pending actions such as signal
+     handlers, finalizers, memprof callbacks, etc, as well as GCs and
+     GC slices, so should not be moved or optimised away. *)
+  | Ppoll
 
 and integer_comparison =
     Ceq | Cne | Clt | Cgt | Cle | Cge
@@ -424,6 +428,10 @@ val transl_prim: string -> string -> lambda
     ]}
 *)
 
+val is_evaluated : lambda -> bool
+(** [is_evaluated lam] returns [true] if [lam] is either a constant, a variable
+    or a function abstract. *)
+
 val free_variables: lambda -> Ident.Set.t
 
 val transl_module_path: scoped_location -> Env.t -> Path.t -> lambda

diff --git a/lambda/matching.ml b/lambda/matching.ml
index ac51f7828ded5d49714a212f044e71bb08ccc5eb..337c9d2fdd3c56321423fe0722fbb18e984f9128 100644 (file)
--- a/lambda/matching.ml
+++ b/lambda/matching.ml
@@ -93,7 +93,7 @@ open Types
 open Typedtree
 open Lambda
 open Parmatch
-open Printpat
+open Printpat.Compat
 
 module Scoped_location = Debuginfo.Scoped_location
 
@@ -489,6 +489,8 @@ module Context : sig
 
   val lub : pattern -> t -> t
 
+  val erase_first_col : t -> t
+
   val matches : t -> matrix -> bool
 
   val combine : t -> t
@@ -522,6 +524,11 @@ end = struct
       | _ :: xs -> { left = Patterns.omega :: left; right = xs }
       | _ -> assert false
 
+    let erase_first_col { left; right } =
+      match right with
+      | _ :: right -> { left; right = Patterns.omega :: right }
+      | _ -> assert false
+
     let rshift { left; right } =
       match left with
       | p :: ps -> { left = ps; right = p :: right }
@@ -534,11 +541,10 @@ end = struct
     (** Recombination of contexts.
         For example:
           { (_,_)::left; p1::p2::right } -> { left; (p1,p2)::right }
-        All mutable fields are replaced by '_', since side-effects in
-        guards can alter these fields. *)
+    *)
     let combine { left; right } =
       match left with
-      | p :: ps -> { left = ps; right = set_args_erase_mutable p right }
+      | p :: ps -> { left = ps; right = set_args p right }
       | _ -> assert false
   end
 
@@ -567,6 +573,8 @@ end = struct
 
   let rshift ctx = List.map Row.rshift ctx
 
+  let erase_first_col ctx = List.map Row.erase_first_col ctx
+
   let rshift_num n ctx = List.map (Row.rshift_num n) ctx
 
   let combine ctx = List.map Row.combine ctx
@@ -669,15 +677,24 @@ let flatten_matrix size pss =
     provide static information on what happens "after" each jump, which we use
     to optimize our exit choices.
     This is what [mk_failaction_pos] (and its callers) does.
+
+    The default environment also carries a special [final_exit] exit
+    number, which is used for values that are not matched by any
+    clauses of the matching being compiled. The final exit is treated
+    as a free variable, it is not bound in the [raise_num * matrix]
+    list. When [Default_environment.pop] returns [None], there are no
+    exit handlers to matching clauses left, but
+    (for non-exhaustive matches) inputs could still jump to the final
+    exit.
 *)
 module Default_environment : sig
   type t
 
-  val is_empty : t -> bool
-
   val pop : t -> ((int * matrix) * t) option
 
-  val empty : t
+  val empty : final_exit:int -> t
+
+  val raise_final_exit : t -> lambda
 
   val cons : matrix -> int -> t -> t
 
@@ -690,22 +707,27 @@ module Default_environment : sig
   val flatten : int -> t -> t
 
   val pp : Format.formatter -> t -> unit
+
+  val pp_section : Format.formatter -> t -> unit
 end = struct
-  type t = (int * matrix) list
+  type t = {
+    env: (int * matrix) list;
+    final_exit: int;
+  }
   (** All matrices in the list should have the same arity -- their rows should
       have the same number of columns -- as it should match the arity of the
       current scrutiny vector. *)
 
-  let empty = []
+  let empty ~final_exit = { env = []; final_exit; }
 
-  let is_empty = function
-    | [] -> true
-    | _ -> false
+  let raise_final_exit { final_exit; _ } =
+    Lstaticraise (final_exit, [])
 
   let cons matrix raise_num default =
     match matrix with
     | [] -> default
-    | _ -> (raise_num, matrix) :: default
+    | _ ->
+        { default with env = (raise_num, matrix) :: default.env }
 
   let specialize_matrix arity matcher pss =
     let rec filter_rec = function
@@ -791,7 +813,7 @@ end = struct
     in
     filter_rec pss
 
-  let specialize_ arity matcher env =
+  let specialize_ arity matcher def =
     let rec make_rec = function
       | [] -> []
       | (i, ([] :: _)) :: _ -> [ (i, [ [] ]) ]
@@ -809,7 +831,7 @@ end = struct
           | pss -> (i, pss) :: make_rec rem
         )
     in
-    make_rec env
+    { def with env = make_rec def.env }
 
   let specialize head def =
     specialize_ (Patterns.Head.arity head) (matcher head) def
@@ -825,17 +847,17 @@ end = struct
     in
     specialize_ 0 compat_matcher def
 
-  let pop = function
+  let pop def = match def.env with
     | [] -> None
-    | def :: defs -> Some (def, defs)
+    | i_mat :: rem -> Some (i_mat, { def with env = rem })
 
   let pp ppf def =
     Format.fprintf ppf
-      "@[<v 2>Default environment:@,\
-       %a@]"
+      "@[<v 2>Default environment:%a@]"
       (fun ppf li ->
-         if li = [] then Format.fprintf ppf "empty"
-         else
+         if li = [] then Format.fprintf ppf " empty"
+         else begin
+           Format.fprintf ppf "@,";
            Format.pp_print_list ~pp_sep:Format.pp_print_cut
              (fun ppf (i, pss) ->
                 Format.fprintf ppf
@@ -844,10 +866,17 @@ end = struct
                   i
                   pretty_matrix pss
              ) ppf li
-      ) def
+         end
+      ) def.env
+
+  let pp_section ppf def =
+    if def.env = [] then ()
+    else Format.fprintf ppf "@,%a" pp def
 
   let flatten size def =
-    List.map (fun (i, pss) -> (i, flatten_matrix size pss)) def
+    { def with
+      env = List.map (fun (i, pss) -> (i, flatten_matrix size pss)) def.env;
+    }
 end
 
 (** For a given code fragment, we call "external" exits the exit numbers that
@@ -856,13 +885,26 @@ end
     The jump summary of a code fragment is an ordered list of
     [raise_num * Context.t] pairs, mapping all its external exit numbers to
     context information valid for all its raise points within the code fragment.
+
+    Jump summaries also carry a [partial] information, that carries
+    information on whether the "final exit" of the default environment
+    is used -- whether any values will jump to it, and whether it
+    occurs in the generated code. If [partial] is [Total], then the
+    [final_exit] is not used in the generated code. (A reason to
+    special-case the final exit in this way is that we don't need to
+    track its context for matching code generation.)
 *)
 module Jumps : sig
   type t
 
-  val is_empty : t -> bool
+  val partial : t -> partial
 
-  val empty : t
+  val empty : partial -> t
+  (** [empty Total] is the jump summary of exhaustive matching code
+      that never fails. [empty Partial] is the jump summary of
+      matching code that does not exit into any handler of the default
+      environment, but may still use the final failure action in the
+      final exit. *)
 
   val singleton : int -> Context.t -> t
 
@@ -881,46 +923,60 @@ module Jumps : sig
   val extract : int -> t -> Context.t * t
 
   val pp : Format.formatter -> t -> unit
-end = struct
-  type t = (int * Context.t) list
 
-  let pp ppf (env : t) =
-    if env = [] then Format.fprintf ppf "empty" else
-    Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf (i, ctx) ->
-      Format.fprintf ppf
-        "jump for %d@,\
-         %a"
-        i
-        Context.pp ctx
-    ) ppf env
+  val pp_section : Format.formatter -> t -> unit
+end = struct
+  type t = {
+    env : (int * Context.t) list;
+    partial : partial;
+  }
 
-  let rec extract i = function
+  let partial { partial = p; _ } = p
+
+  let pp ppf ({ env; partial } : t) =
+    Format.fprintf ppf "@[<v 2>JUMPS:%t@]"
+      (fun ppf ->
+         if env = [] then
+           Format.fprintf ppf " empty (%a)"
+             pp_partial partial
+         else begin
+           Format.fprintf ppf " (%a)@," pp_partial partial;
+           Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf (i, ctx) ->
+             Format.fprintf ppf
+               "jump for %d@,\
+                %a"
+               i
+               Context.pp ctx
+           ) ppf env
+         end)
+
+  let pp_section ppf jumps =
+    Format.fprintf ppf "@,%a" pp jumps
+
+  let extract i jumps =
+    let rec extract i = function
     | [] -> (Context.empty, [])
-    | ((j, pss) as x) :: rem as all ->
+    | ((j, ctx) as x) :: rem as all ->
         if i = j then
-          (pss, rem)
+          (ctx, rem)
         else if j < i then
           (Context.empty, all)
         else
           let r, rem = extract i rem in
           (r, x :: rem)
+    in
+    let (ctx, rem) = extract i jumps.env in
+    (ctx, { jumps with env = rem })
 
-  let rec remove i = function
+  let remove i jumps =
+    let rec remove i = function
     | [] -> []
     | (j, _) :: rem when i = j -> rem
     | x :: rem -> x :: remove i rem
+    in
+    { jumps with env = remove i jumps.env }
 
-  let empty = []
-
-  and is_empty = function
-    | [] -> true
-    | _ -> false
-
-  let singleton i ctx =
-    if Context.is_empty ctx then
-      []
-    else
-      [ (i, ctx) ]
+  let empty partial = { env = []; partial; }
 
   let add i ctx jumps =
     let rec add = function
@@ -936,19 +992,33 @@ end = struct
     if Context.is_empty ctx then
       jumps
     else
-      add jumps
-
-  let rec union (env1 : t) env2 =
-    match (env1, env2) with
-    | [], _ -> env2
-    | _, [] -> env1
-    | ((i1, pss1) as x1) :: rem1, ((i2, pss2) as x2) :: rem2 ->
-        if i1 = i2 then
-          (i1, Context.union pss1 pss2) :: union rem1 rem2
-        else if i1 > i2 then
-          x1 :: union rem1 env2
-        else
-          x2 :: union env1 rem2
+      { jumps with env = add jumps.env }
+
+  let singleton i ctx =
+    (* Total: a singleton only jumps to exit [i],
+       not to the final exit. *)
+    add i ctx (empty Total)
+
+  let union j1 j2 =
+    let rec union env1 env2 =
+      match (env1, env2) with
+      | [], _ -> env2
+      | _, [] -> env1
+      | ((i1, pss1) as x1) :: rem1, ((i2, pss2) as x2) :: rem2 ->
+          if i1 = i2 then
+            (i1, Context.union pss1 pss2) :: union rem1 rem2
+          else if i1 > i2 then
+            x1 :: union rem1 env2
+          else
+            x2 :: union env1 rem2
+    in
+    {
+      env = union j1.env j2.env;
+      partial = (match j1.partial, j2.partial with
+        | Total, Total -> Total
+        | Partial, _ | _, Partial -> Partial
+      );
+    }
 
   let rec merge = function
     | env1 :: env2 :: rem -> union env1 env2 :: merge rem
@@ -956,46 +1026,155 @@ end = struct
 
   let rec unions envs =
     match envs with
-    | [] -> []
+    | [] -> empty Total
     | [ env ] -> env
     | _ -> unions (merge envs)
 
-  let map f env = List.map (fun (i, pss) -> (i, f pss)) env
+  let map f jumps =
+    { jumps with
+      env = List.map (fun (i, pss) -> (i, f pss)) jumps.env;
+    }
 end
 
+(* Temporality information *)
+
+type temporality =
+  | First
+  | Following
+(** The [temporality] information tracks information about the
+    placement of the current submatrix within the
+    whole pattern-matching.
+
+    - [First]: this is the first submatrix on this position seen by values
+      that flow into the submatrix.
+    - [Following]: there was a split, some other submatrix was tried first
+      and failed, and the control jumped to the current submatrix.
+
+    This information is used in {!compute_arg_partial}.
+*)
+
+let pp_tempo ppf = function
+  | First -> Format.fprintf ppf "First"
+  | Following -> Format.fprintf ppf "Following"
+
+
+(* Partiality information. *)
+
+(** [Typedtree.partial] is just [Total | Partial].
+    The pattern-matching compiler tracks more fine-grained information as
+    it traverses patterns, grouped in the following [partiality] type. *)
+type partiality = {
+  current : partial;
+  (** The 'current' information tracks whether the current sub-matrix
+      is Partial or Total, that is, if it may fail to match some possible
+      values and have to generate a jump to some external exit. *)
+
+  global : partial;
+  (** The 'global' information indicates whether the pattern-matching
+      as a whole, at the toplevel, is Partial or Total. This
+      information is decided by the type-checker and passed down to
+      the pattern-matching compiler.
+
+      When a pattern-matching is globally Total, a jump out of a given
+      submatrix may only target a default submatrix correspond to
+      a further split. When it is globally Partial, some jumps may
+      fail to match any of the following submatrices, and go to the
+      'final exit'. *)
+
+  tempo: temporality;
+  (** The {!temporality} of the current submatrix. *)
+}
+
+let pp_partiality ppf {current; global; tempo} =
+  Format.fprintf ppf "{ current = %a; global = %a; tempo = %a }"
+    pp_partial current
+    pp_partial global
+    pp_tempo tempo
+
 (* Pattern matching before any compilation *)
 
-type 'row pattern_matching = {
+type ('args, 'row) pattern_matching = {
   mutable cases : 'row list;
-  args : (lambda * let_kind) list;
-      (** args are not just Ident.t in at least the following cases:
-        - when matching the arguments of a constructor,
-          direct field projections are used (make_field_args)
-        - with lazy patterns args can be of the form [Lazy.force ...]
-          (inline_lazy_force). *)
+  args : 'args;
   default : Default_environment.t
 }
 
+type 'a arg = {
+  arg : 'a;
+  binding_kind : let_kind;
+  mut : mutable_flag;
+  (** We track with a [mutable_flag] whether a mutable read was
+      performed to access the corresponding sub-value of the
+      scrutinee: an argument is [Mutable] if the path from the root of
+      the value to the argument contains a mutable field. More
+      precisely, a position is considered [Mutable] when accesses to
+      the same position in different branches of the pattern
+      matching -- outside the scope of the strict binding generated
+      for the mutable read -- may observe a different value. *)
+}
+
+type args = lambda arg list
+(** args are not just Ident.t in at least the following cases:
+    - when matching the arguments of a constructor,
+      direct field projections are used (make_field_args)
+    - with lazy patterns args can be of the form [Lazy.force ...]
+      (inline_lazy_force). *)
+
+type split_args = {
+  first : pure_arg arg;
+  rest : args;
+}
+(** [split_args] is a more restricted form of argument list, used
+    when argument in first position is about to be matched upon. *)
+
+and pure_arg =
+  | Var of Ident.t
+  | Tuple of lambda
+(** The first argument in [split_args] form has already been bound to
+    a variable or it is a tuple of variables in the weird
+    [do_for_multiple_match] case; in particular, it is a pure
+    expression. *)
+
+let arg_of_pure = function
+  | Var v -> Lvar v
+  | Tuple tup -> tup
+
 type handler = {
   provenance : matrix;
   exit : int;
   vars : (Ident.t * Lambda.value_kind) list;
-  pm : initial_clause pattern_matching
+  pm : (args, initial_clause) pattern_matching
 }
 
-type ('head_pat, 'matrix) pm_or_compiled = {
-  body : 'head_pat Non_empty_row.t clause pattern_matching;
+type ('args, 'head_pat, 'matrix) pm_or_compiled = {
+  body : ('args, 'head_pat Non_empty_row.t clause) pattern_matching;
   handlers : handler list;
   or_matrix : 'matrix
 }
 
+
+(* The composed mutability of two argument positions:
+   is x.f.g a mutable position of x, depending whether f and g are mutable?
+
+   Note that the following equations hold:
+   - compose_mut mut Immutable = mut
+   - compose_mut mut Mutable = Mutable
+   but we do *not* use them in the code of get_expr_args_* below. We prefer
+   to call [compose_mut] explicitly to make the logic more regular, make
+   it obvious that we thought about how this value should evolve (or not).
+*)
+let compose_mut m1 m2 =
+  match m1, m2 with
+  | Immutable, Immutable -> Immutable
+  | Mutable, _ | _, Mutable -> Mutable
+
 (* Pattern matching after application of both the or-pat rule and the
    mixture rule *)
 
 type pm_half_compiled =
-  | PmOr of (Simple.pattern, matrix) pm_or_compiled
+  | PmOr of (split_args, Simple.pattern, matrix) pm_or_compiled
   | PmVar of { inside : pm_half_compiled }
-  | Pm of Simple.clause pattern_matching
+  | Pm of (split_args, Simple.clause) pattern_matching
 
 (* Only used inside the various split functions, we only keep [me] when we're
    done splitting / precompiling. *)
@@ -1026,9 +1205,8 @@ let pretty_cases ppf cases =
 
 let pretty_pm_ ~print_default ppf pm =
   pretty_cases ppf pm.cases;
-  if print_default && not (Default_environment.is_empty pm.default) then
-    Format.fprintf ppf "@,%a"
-      Default_environment.pp pm.default
+  if print_default then
+    Default_environment.pp_section ppf pm.default
 
 let rec pretty_precompiled_ ~print_default ppf = function
   | Pm pm ->
@@ -1396,7 +1574,7 @@ let as_matrix cases =
 
 *)
 
-let rec split_or ~arg (cls : Half_simple.clause list) args def =
+let rec split_or (cls : Half_simple.clause list) args def =
   let rec do_split (rev_before : Simple.clause list) rev_ors rev_no = function
     | [] ->
         cons_next (List.rev rev_before) (List.rev rev_ors) (List.rev rev_no)
@@ -1427,7 +1605,7 @@ let rec split_or ~arg (cls : Half_simple.clause list) args def =
     in
     match yesor with
     | [] -> split_no_or yes args def nexts
-    | _ -> precompile_or ~arg yes yesor args def nexts
+    | _ -> precompile_or yes yesor args def nexts
   in
   do_split [] [] [] cls
 
@@ -1502,9 +1680,8 @@ and precompile_var args cls def k =
      precompile the rest, add a PmVar to all precompiled submatrices.
 
      If the rest doesn't generate any split, abort and do_not_precompile. *)
-  match args with
-  | [] -> assert false
-  | _ :: ((Lvar v, _) as arg) :: rargs -> (
+  match args.rest with
+  | { arg = Lvar v; _ } as first :: rargs -> (
       (* We will use the name of the head column of the submatrix
          we compile, and this is the *second* column of our argument. *)
       match cls with
@@ -1513,20 +1690,19 @@ and precompile_var args cls def k =
           do_not_precompile args cls def k
       | _ -> (
           (* Precompile *)
-          let var_args = arg :: rargs in
+          let var_args = { first = { first with arg = Var v }; rest = rargs } in
           let var_cls =
             List.map
               (fun ((p, ps), act) ->
                 assert (simple_omega_like p);
-
                 (* we learned by pattern-matching on [args]
                    that [p::ps] has at least two arguments,
                    so [ps] must be non-empty *)
-                half_simplify_clause ~arg:(fst arg) (ps, act))
+                half_simplify_clause ~arg:(Lvar v) (ps, act))
               cls
           and var_def = Default_environment.pop_column def in
           let { me = first; matrix }, nexts =
-            split_or ~arg:(Lvar v) var_cls var_args var_def
+            split_or var_cls var_args var_def
           in
           (* Compute top information *)
           match nexts with
@@ -1577,7 +1753,7 @@ and do_not_precompile args cls def k =
     },
     k )
 
-and precompile_or ~arg (cls : Simple.clause list) ors args def k =
+and precompile_or (cls : Simple.clause list) ors args def k =
   (* Example: if [cls] is a single-row matrix
 
        s11        p12 .. p1n -> act1
@@ -1632,11 +1808,7 @@ and precompile_or ~arg (cls : Simple.clause list) ors args def k =
               { cases =
                   (patl, action)
                   :: List.map (fun ((_, ps), action) -> (ps, action)) others;
-                args =
-                  ( match args with
-                  | _ :: r -> r
-                  | _ -> assert false
-                  );
+                args = args.rest;
                 default = Default_environment.pop_compat orp def
               }
             in
@@ -1655,6 +1827,7 @@ and precompile_or ~arg (cls : Simple.clause list) ors args def k =
               Lstaticraise (or_num, List.map (fun v -> Lvar v) vars)
             in
             let new_cases =
+              let arg = arg_of_pure args.first.arg in
               Simple.explode_or_pat ~arg p
                 ~mk_action:mk_new_action
                 ~patbound_action_vars:(List.map fst patbound_action_vars)
@@ -1732,39 +1905,37 @@ let split_and_precompile_simplified pm =
   dbg_split_and_precompile pm next nexts;
   (next, nexts)
 
-let split_and_precompile_half_simplified ~arg pm =
-  let { me = next }, nexts = split_or ~arg pm.cases pm.args pm.default in
+let split_and_precompile_half_simplified pm =
+  let { me = next }, nexts = split_or pm.cases pm.args pm.default in
   dbg_split_and_precompile pm next nexts;
   (next, nexts)
 
 (* General divide functions *)
 
 type cell = {
-  pm : initial_clause pattern_matching;
+  pm : (args, initial_clause) pattern_matching;
   ctx : Context.t;
   discr : Patterns.Head.t
 }
 (** a submatrix after specializing by discriminant pattern;
     [ctx] is the context shared by all rows. *)
 
-let make_matching get_expr_args head def ctx = function
-  | [] -> fatal_error "Matching.make_matching"
-  | arg :: rem ->
-      let def = Default_environment.specialize head def
-      and args = get_expr_args head arg rem
-      and ctx = Context.specialize head ctx in
-      { pm = { cases = []; args; default = def }; ctx; discr = head }
-
-let make_line_matching get_expr_args head def = function
-  | [] -> fatal_error "Matching.make_line_matching"
-  | arg :: rem ->
-      { cases = [];
-        args = get_expr_args head arg rem;
-        default = Default_environment.specialize head def
-      }
+let make_matching get_expr_args head def ctx { first; rest } =
+  let def = Default_environment.specialize head def in
+  let first = { first with arg = arg_of_pure first.arg } in
+  let args = get_expr_args head first rest in
+  let ctx = Context.specialize head ctx in
+  { pm = { cases = []; args; default = def }; ctx; discr = head }
+
+let make_line_matching get_expr_args head def { first; rest } =
+  let first = { first with arg = arg_of_pure first.arg } in
+  { cases = [];
+    args = get_expr_args head first rest;
+    default = Default_environment.specialize head def
+  }
 
 type 'a division = {
-  args : (lambda * let_kind) list;
+  args : split_args;
   cells : ('a * cell) list
 }
 
@@ -1782,7 +1953,7 @@ let add_in_div make_matching_fun eq_key key patl_action division =
   { division with cells }
 
 let divide get_expr_args eq_key get_key get_pat_args ctx
-    (pm : Simple.clause pattern_matching) =
+    (pm : (split_args, Simple.clause) pattern_matching) =
   let add ((p, patl), action) division =
     let ph = Simple.head p in
     let p = General.erase p in
@@ -1799,7 +1970,7 @@ let add_line patl_action pm =
   pm
 
 let divide_line make_ctx get_expr_args get_pat_args discr ctx
-    (pm : Simple.clause pattern_matching) =
+    (pm : (split_args, Simple.clause) pattern_matching) =
   let add ((p, patl), action) submatrix =
     let p = General.erase p in
     add_line (get_pat_args p patl, action) submatrix
@@ -1854,7 +2025,7 @@ let get_pat_args_constr p rem =
   | { pat_desc = Tpat_construct (_, _, args, _) } -> args @ rem
   | _ -> assert false
 
-let get_expr_args_constr ~scopes head (arg, _mut) rem =
+let get_expr_args_constr ~scopes head { arg; mut; _ } rem =
   let cstr =
     match head.pat_desc with
     | Patterns.Head.Construct cstr -> cstr
@@ -1866,19 +2037,22 @@ let get_expr_args_constr ~scopes head (arg, _mut) rem =
       if pos > last_pos then
         argl
       else
-        (Lprim (Pfield (pos, Pointer, Immutable), [ arg ], loc),
-               binding_kind) :: make_args (pos + 1)
+        {
+          arg = Lprim (Pfield (pos, Pointer, Immutable), [ arg ], loc);
+          mut = compose_mut mut Immutable;
+          binding_kind;
+        } :: make_args (pos + 1)
     in
     make_args first_pos
   in
   if cstr.cstr_inlined <> None then
-    (arg, Alias) :: rem
+    { arg; binding_kind = Alias; mut } :: rem
   else
     match cstr.cstr_tag with
     | Cstr_constant _
     | Cstr_block _ ->
         make_field_accesses Alias 0 (cstr.cstr_arity - 1) rem
-    | Cstr_unboxed -> (arg, Alias) :: rem
+    | Cstr_unboxed -> { arg; binding_kind = Alias; mut } :: rem
     | Cstr_extension _ -> make_field_accesses Alias 1 cstr.cstr_arity rem
 
 let divide_constructor ~scopes ctx pm =
@@ -1893,9 +2067,13 @@ let divide_constructor ~scopes ctx pm =
 
 let get_expr_args_variant_constant = drop_expr_arg
 
-let get_expr_args_variant_nonconst ~scopes head (arg, _mut) rem =
+let get_expr_args_variant_nonconst ~scopes head { arg; mut; _ } rem =
   let loc = head_loc ~scopes head in
-  (Lprim (Pfield (1, Pointer, Immutable), [ arg ], loc), Alias) :: rem
+  {
+    arg = Lprim (Pfield (1, Pointer, Immutable), [ arg ], loc);
+    binding_kind = Alias;
+    mut = compose_mut mut Immutable;
+  } :: rem
 
 let divide_variant ~scopes row ctx { cases = cl; args; default = def } =
   let rec divide = function
@@ -2076,7 +2254,7 @@ let inline_lazy_force arg loc =
         ap_loc = loc;
         ap_func = Lazy.force code_force_lazy;
         ap_args = [ Lconst (Const_base (Const_int 0)); arg ];
-        ap_inlined = Default_inline;
+        ap_inlined = Never_inline;
         ap_specialised = Default_specialise
       }
   else if !Clflags.native_code then
@@ -2087,9 +2265,15 @@ let inline_lazy_force arg loc =
          tables (~ 250 elts); conditionals are better *)
     inline_lazy_force_cond arg loc
 
-let get_expr_args_lazy ~scopes head (arg, _mut) rem =
+let get_expr_args_lazy ~scopes head { arg; mut; _ } rem =
   let loc = head_loc ~scopes head in
-  (inline_lazy_force arg loc, Strict) :: rem
+  {
+    arg = inline_lazy_force arg loc;
+    binding_kind = Strict;
+    mut = compose_mut mut Immutable;
+    (* A lazy pattern is considered immutable, forcing its argument
+       always returns the same value. *)
+  } :: rem
 
 let divide_lazy ~scopes head ctx pm =
   divide_line (Context.specialize head)
@@ -2105,15 +2289,18 @@ let get_pat_args_tuple arity p rem =
   | { pat_desc = Tpat_tuple args } -> args @ rem
   | _ -> assert false
 
-let get_expr_args_tuple ~scopes head (arg, _mut) rem =
+let get_expr_args_tuple ~scopes head { arg; mut; _ } rem =
   let loc = head_loc ~scopes head in
   let arity = Patterns.Head.arity head in
   let rec make_args pos =
     if pos >= arity then
       rem
     else
-      (Lprim (Pfield (pos, Pointer, Immutable), [ arg ], loc),
-             Alias) :: make_args (pos + 1)
+      {
+        arg = Lprim (Pfield (pos, Pointer, Immutable), [ arg ], loc);
+        binding_kind = Alias;
+        mut = compose_mut mut Immutable;
+      } :: make_args (pos + 1)
   in
   make_args 0
 
@@ -2138,7 +2325,7 @@ let get_pat_args_record num_fields p rem =
       record_matching_line num_fields lbl_pat_list @ rem
   | _ -> assert false
 
-let get_expr_args_record ~scopes head (arg, _mut) rem =
+let get_expr_args_record ~scopes head { arg; mut; _ } rem =
   let loc = head_loc ~scopes head in
   let all_labels =
     let open Patterns.Head in
@@ -2164,12 +2351,16 @@ let get_expr_args_record ~scopes head (arg, _mut) rem =
         | Record_extension _ ->
             Lprim (Pfield (lbl.lbl_pos + 1, ptr, lbl.lbl_mut), [ arg ], loc)
       in
-      let str =
+      let binding_kind =
         match lbl.lbl_mut with
         | Immutable -> Alias
         | Mutable -> StrictOpt
       in
-      (access, str) :: make_args (pos + 1)
+      {
+        arg = access;
+        binding_kind;
+        mut = compose_mut mut lbl.lbl_mut;
+      } :: make_args (pos + 1)
   in
   make_args 0
 
@@ -2196,7 +2387,7 @@ let get_pat_args_array p rem =
   | { pat_desc = Tpat_array patl } -> patl @ rem
   | _ -> assert false
 
-let get_expr_args_array ~scopes kind head (arg, _mut) rem =
+let get_expr_args_array ~scopes kind head { arg; mut; _ } rem =
   let len =
     let open Patterns.Head in
     match head.pat_desc with
@@ -2208,10 +2399,16 @@ let get_expr_args_array ~scopes kind head (arg, _mut) rem =
     if pos >= len then
       rem
     else
-      ( Lprim
-          (Parrayrefu kind, [ arg; Lconst (Const_base (Const_int pos)) ], loc),
-        StrictOpt )
-      :: make_args (pos + 1)
+      let arg =
+        Lprim
+          (Parrayrefu kind,
+           [ arg; Lconst (Const_base (Const_int pos)) ], loc)
+      in
+      {
+        arg;
+        binding_kind = StrictOpt;
+        mut = compose_mut mut Mutable;
+      } :: make_args (pos + 1)
   in
   make_args 0
 
@@ -2729,81 +2926,82 @@ let complete_pats_constrs = function
         (complete_constrs constr (List.map constr_of_pat constrs))
   | _ -> assert false
 
+(* a type of per-argument partiality information used by
+   [mk_failaction_*] functions to reason statically about which
+   partiality information is used for these per-argument functions. *)
+type arg_partiality = Arg of partiality
+
+let pp_arg_partiality ppf (Arg partial) = pp_partiality ppf partial
+
+let comp_final_exit def =
+  (Default_environment.raise_final_exit def, Jumps.empty Partial)
+
+let comp_exit partial ctx def =
+  match Default_environment.pop def with
+  | Some ((i, _), _) -> Some (Lstaticraise (i, []), Jumps.singleton i ctx)
+  | None ->
+      (* If we know that we are in Total match, we do not need to
+         generate a final exit in this case. *)
+      match partial.global with
+      | Total -> None
+      | Partial -> Some (comp_final_exit def)
+
 (*
-     Following two ``failaction'' function compute n, the trap handler
-    to jump to in case of failure of elementary tests
+    The following two ``failaction'' functions compute n, the trap
+    handler to jump to in case of failure of elementary tests.
 *)
 
-let mk_failaction_neg partial ctx def =
+let mk_failaction_neg arg_partial ctx def =
   debugf
     "@,@[<v 2>COMBINE (mk_failaction_neg %a)@]"
-    pp_partial partial
+    pp_arg_partiality arg_partial
   ;
-  match partial with
-  | Partial -> (
-      match Default_environment.pop def with
-      | Some ((idef, _), _) ->
-          (Some (Lstaticraise (idef, [])), Jumps.singleton idef ctx)
-      | None ->
-          (* Act as Total, this means
-             If no appropriate default matrix exists,
-             then this switch cannot fail *)
-          (None, Jumps.empty)
-    )
-  | Total -> (None, Jumps.empty)
-
-(* In line with the article and simpler than before *)
-let mk_failaction_pos partial seen ctx defs =
-  let rec scan_def env to_test defs =
-    match (to_test, Default_environment.pop defs) with
-    | [], _
-    | _, None ->
-        List.fold_left
-          (fun (klist, jumps) (i, pats) ->
-            let action = Lstaticraise (i, []) in
-            let klist =
-              List.fold_right
-                (fun pat r -> (get_key_constr pat, action) :: r)
-                pats klist
-            and jumps =
-              Jumps.add i (Context.lub (list_as_pat pats) ctx) jumps
-            in
-            (klist, jumps))
-          ([], Jumps.empty) env
-    | _, Some ((idef, pss), rem) -> (
-        let now, later =
-          List.partition (fun (_p, p_ctx) -> Context.matches p_ctx pss) to_test
-        in
-        match now with
-        | [] -> scan_def env to_test rem
-        | _ -> scan_def ((idef, List.map fst now) :: env) later rem
-      )
-  in
-  let fail_pats = complete_pats_constrs seen in
-  if List.length fail_pats < !Clflags.match_context_rows then (
-    let fail, jmps =
-      scan_def []
-        (List.map (fun pat -> (pat, Context.lub pat ctx)) fail_pats)
-        defs
-    in
-    debugf
-      "@,@[<v 2>COMBINE (mk_failaction_pos %a)@,\
-           %a@,\
-           @[<v 2>FAIL PATTERNS:@,\
-             %a@]@,\
-           @[<v 2>POSITIVE JUMPS:@,\
-             %a@]\
-           @]"
-      pp_partial partial
-      Default_environment.pp defs
-      (Format.pp_print_list ~pp_sep:Format.pp_print_cut
-         Printpat.pretty_pat) fail_pats
-      Jumps.pp jmps
-    ;
-    (None, fail, jmps)
-  ) else (
-    (* Too many non-matched constructors -> reduced information *)
-    let fail, jumps = mk_failaction_neg partial ctx defs in
+  match arg_partial with
+  | Arg { current = Total; _ } ->
+      (None, Jumps.empty Total)
+  | Arg ({ current = Partial; _ } as partial) ->
+      match comp_exit partial ctx def with
+      | None -> (None, Jumps.empty Total)
+      | Some (lam, jumps) -> (Some lam, jumps)
+
+(* In [mk_failaction_pos partial seen ctx defs],
+   - [partial] indicates whether the current switch
+     is exhaustive
+   - [seen] is the list of constructors accepted by the switch
+     (those that will be matched)
+   - [ctx] is the current context (what we know of the value
+     being matched)
+   - [defs] is the default environment (what inputs
+     are expected by the switches present at larger exit numbers).
+
+   The function returns a triple [(fail, fails, jumps)] containing
+   information for the failure cases, the constructors missing from
+   the current switch:
+   - [fail] is an optional 'default' action for the switch
+   - [fails] is a list of extra switch clauses to add for failure cases,
+     each jumping to a larger exit number
+   - [jumps] contains a jump summary for all these new cases
+     (context information for all exits they reach)
+
+   The general strategy is to compute an accurate list of [fails] and
+   try to avoid having a default action, as this generates better
+   code. But we choose to have a default action when the list [fails]
+   would be too large or too costly to compute.
+
+   Through its jump summary, [mk_failaction_pos] propagates "negative
+   information" about the constructors not taken. For example, if
+   a switch only accepts the [None] constructor, [mk_failaction_pos]
+   generates a failure clause along with context information that the
+   value reaching the failure clause must be [Some _].
+*)
+let mk_failaction_pos arg_partial seen ctx defs =
+  (* The failure patterns are formed of the constructors not present
+     in [seen]. For example, if [seen] is [[None]], then [fail_pats]
+     will be [[Some _]]. *)
+  let input_fail_pats = complete_pats_constrs seen in
+  if List.length input_fail_pats >= !Clflags.match_context_rows then (
+    (* Too many non-matched constructors -> reduced information. *)
+    let fail, jumps = mk_failaction_neg arg_partial ctx defs in
     debugf
       "@,@[<v 2>COMBINE (mk_failaction_pos)@,\
            %a@,\
@@ -2817,6 +3015,90 @@ let mk_failaction_pos partial seen ctx defs =
       )
     ;
     (fail, [], jumps)
+  ) else (
+    let fail_pats_in_ctx =
+      List.filter_map (fun pat ->
+        let pat_ctx = Context.lub pat ctx in
+        if Context.is_empty pat_ctx then None
+        else Some (pat, pat_ctx)
+      ) input_fail_pats in
+    let mk_fails fail_pats action =
+      List.map (fun pat -> (get_key_constr pat, action)) fail_pats
+    in
+    (* We compare our failure patterns against our default environment;
+       for each failure pattern we compute a good exit, and from
+       it build a failure clause/action and the corresponding jump
+       summary. *)
+    let rec fails_and_jumps defs fail_pats_in_ctx =
+      if fail_pats_in_ctx = [] then
+        (* We have assigned exit point to all failure patterns, so
+           we can stop iterating on the exits. *)
+        [], Jumps.empty Total
+      else match Default_environment.pop defs with
+      | Some ((idef, pss), rem) ->
+          (* Collect the failure patterns whose context matches the
+             matrix [pss] of the next exit [idef] in the default
+             environment. *)
+          let now, later =
+            List.partition_map (fun ((p, p_ctx) as fail_pat) ->
+              if Context.matches p_ctx pss
+              then Either.Left p
+              else Either.Right fail_pat
+            ) fail_pats_in_ctx
+          in
+          if now = [] then fails_and_jumps rem later
+          else
+            let fails, jumps = fails_and_jumps rem later in
+            (* Grow the failing actions and jump summary for
+               these failure patterns. *)
+            let fails' =
+              mk_fails now (Lstaticraise (idef, [])) @ fails
+            in
+            let jumps' =
+              (* We specialize the current context to the or-pattern of
+                 all fail patterns going to this exit. This is equivalent
+                 to unioning the specialized contexts of each failure
+                 pattern, but more efficient -- the union would have a lot
+                 of redundancy. *)
+              let fail_pat = list_as_pat now in
+              let fail_ctx = Context.lub fail_pat ctx in
+              Jumps.add idef fail_ctx jumps
+            in
+            fails', jumps'
+      | None ->
+          match arg_partial with
+          | Arg { global = Total; _ } ->
+              (* If the pattern-matching is globally [Total], all
+                 missing values are either ill-typed or they are
+                 handled by a matrix of the default environment. The
+                 remaining failing patterns cannot arise. *)
+              [], Jumps.empty Total
+          | Arg { global = Partial; _ } ->
+              (* in [Partial] mode, remaining failing patterns
+                 go to the final exit. *)
+              let final_pats = List.map fst fail_pats_in_ctx in
+              mk_fails final_pats (Default_environment.raise_final_exit defs),
+              Jumps.empty Partial
+    in
+    let fails, jumps = fails_and_jumps defs fail_pats_in_ctx in
+    debugf
+      "@,@[<v 2>COMBINE (mk_failaction_pos %a)@,\
+           %a@,\
+           @[<v 2>CTX:@,\
+             %a@]@,\
+           @[<v 2>FAIL PATTERNS:@,\
+             %a@]@,\
+           @[<v 2>POSITIVE JUMPS (%a):%a@]\
+           @]"
+      pp_arg_partiality arg_partial
+      Default_environment.pp defs
+      Context.pp ctx
+      (Format.pp_print_list ~pp_sep:Format.pp_print_cut
+         Printpat.Compat.pretty_pat) input_fail_pats
+      pp_partial (Jumps.partial jumps)
+      Jumps.pp jumps
+    ;
+    (None, fails, jumps)
   )
 
 let combine_constant loc arg cst partial ctx def
@@ -2966,7 +3248,7 @@ let combine_constructor loc arg pat_env cstr partial ctx def
       let sig_complete = ncases = nconstrs in
       let fail_opt, fails, local_jumps =
         if sig_complete then
-          (None, [], Jumps.empty)
+          (None, [], Jumps.empty Total)
         else
           let constrs =
             List.map2 (fun (constr, _act) p -> { p with pat_desc = constr })
@@ -3107,10 +3389,10 @@ let combine_variant loc row arg partial ctx def (tag_lambda_list, total1, _pats)
       sig_complete
       ||
       match partial with
-      | Total -> true
-      | _ -> false
+      | Arg { current = Total; _ } -> true
+      | Arg { current = Partial; _ } -> false
     then
-      (None, Jumps.empty)
+      (None, Jumps.empty Total)
     else
       mk_failaction_neg partial ctx def
   in
@@ -3250,12 +3532,12 @@ let compile_orhandlers compile_fun lambda1 total1 ctx to_catch =
   in
   do_rec lambda1 total1 to_catch
 
-let compile_test compile_fun partial divide combine ctx to_match =
+let compile_test compile_fun arg_partial divide combine ctx to_match =
   let division = divide ctx to_match in
   let c_div = compile_list compile_fun division.cells in
   match c_div with
   | [], _, _ -> (
-      match mk_failaction_neg partial ctx to_match.default with
+      match mk_failaction_neg arg_partial ctx to_match.default with
       | None, _ -> raise Unused
       | Some l, total -> (l, total)
     )
@@ -3298,16 +3580,11 @@ let rec lower_bind v arg lam =
         Llet (Alias, k, vv, lv, lower_bind v arg l)
   | _ -> bind Alias v arg lam
 
-let bind_check str v arg lam =
-  match (str, arg) with
-  | _, Lvar _ -> bind str v arg lam
+let bind_check kind v arg lam =
+  match (kind, arg) with
+  | _, Lvar _ -> bind kind v arg lam
   | Alias, _ -> lower_bind v arg lam
-  | _, _ -> bind str v arg lam
-
-let comp_exit ctx m =
-  match Default_environment.pop m.default with
-  | Some ((i, _), _) -> (Lstaticraise (i, []), Jumps.singleton i ctx)
-  | None -> fatal_error "Matching.comp_exit"
+  | _, _ -> bind kind v arg lam
 
 let rec comp_match_handlers comp_fun partial ctx first_match next_matches =
   match next_matches with
@@ -3316,14 +3593,22 @@ let rec comp_match_handlers comp_fun partial ctx first_match next_matches =
       let rec c_rec body jumps_body = function
         | [] -> (body, jumps_body)
         | (i, pm_i) :: rem -> (
+            let partial =
+              (* [c_rec] is only called on [Following] sub-matrices;
+                 this is the key point where the [Following]
+                 temporality is introduced in the pattern-matching
+                 compilation. *)
+              { partial with tempo = Following } in
             separate_debug_output ();
             let ctx_i, jumps_rem = Jumps.extract i jumps_body in
             if Context.is_empty ctx_i then
               c_rec body jumps_body rem
             else begin
+              (* All those submatrices are [Partial], except possibly
+                 for the last one. *)
               let partial = match rem with
                 | [] -> partial
-                | _ -> Partial
+                | _ -> { partial with current = Partial }
               in
               match comp_fun partial ctx_i pm_i with
               | lambda_i, jumps_i ->
@@ -3338,7 +3623,7 @@ let rec comp_match_handlers comp_fun partial ctx first_match next_matches =
             end
           )
       in
-      match comp_fun Partial ctx first_match with
+      match comp_fun { partial with current = Partial } ctx first_match with
       | first_lam, jumps ->
         c_rec first_lam jumps next_matches
       | exception Unused ->
@@ -3359,10 +3644,8 @@ let rec name_pattern default = function
 
 let arg_to_var arg cls =
   match arg with
-  | Lvar v -> (v, arg)
-  | _ ->
-      let v = name_pattern "*match*" cls in
-      (v, Lvar v)
+  | Lvar v -> v
+  | _ -> name_pattern "*match*" cls
 
 (*
   The main compilation function.
@@ -3376,7 +3659,7 @@ let arg_to_var arg cls =
 *)
 
 let rec compile_match ~scopes repr partial ctx
-    (m : initial_clause pattern_matching) =
+    (m : (args, initial_clause) pattern_matching) : lambda * Jumps.t =
   match m.cases with
   | ([], action) :: rem ->
       let res =
@@ -3386,7 +3669,7 @@ let rec compile_match ~scopes repr partial ctx
           in
           (event_branch repr (patch_guarded lambda action), total)
         else
-          (event_branch repr action, Jumps.empty)
+          (event_branch repr action, Jumps.empty Total)
       in
       debugf "empty matrix%t"
         (fun ppf -> if is_guarded action then Format.fprintf ppf " (guarded)");
@@ -3396,49 +3679,202 @@ let rec compile_match ~scopes repr partial ctx
         { m with cases = map_on_rows Non_empty_row.of_initial nonempty_cases }
 
 and compile_match_nonempty ~scopes repr partial ctx
-    (m : Typedtree.pattern Non_empty_row.t clause pattern_matching) =
+    (m : (args, Typedtree.pattern Non_empty_row.t clause) pattern_matching) =
   match m with
-  | { cases = []; args = [] } -> comp_exit ctx m
-  | { args = (arg, str) :: argl } ->
-      let v, newarg = arg_to_var arg m.cases in
-      let args = (newarg, Alias) :: argl in
-      let cases = List.map (half_simplify_nonempty ~arg:newarg) m.cases in
-      let m = { m with args; cases } in
-      let first_match, rem =
-        split_and_precompile_half_simplified ~arg:newarg m in
-      combine_handlers ~scopes repr partial ctx (v, str, arg) first_match rem
+  | { cases = []; args = [] } ->
+      begin match comp_exit partial ctx m.default with
+      | None -> fatal_error "Matching: impossible empty matrix in a Total match"
+      | Some exit -> exit
+      end
+  | { args = { arg; binding_kind; _ } as first :: rest } ->
+      let v = arg_to_var arg m.cases in
+      bind_match_arg binding_kind v arg (
+        let args = { first = { first with arg = Var v }; rest } in
+        let cases = List.map (half_simplify_nonempty ~arg:(Lvar v)) m.cases in
+        let m = { m with args; cases } in
+        let first_match, rem =
+          split_and_precompile_half_simplified m in
+        combine_handlers ~scopes repr partial ctx first_match rem
+      )
   | _ -> assert false
 
 and compile_match_simplified ~scopes repr partial ctx
-    (m : Simple.clause pattern_matching) =
-  match m with
-  | { cases = []; args = [] } -> comp_exit ctx m
-  | { args = ((Lvar v as arg), str) :: argl } ->
-      let args = (arg, Alias) :: argl in
-      let m = { m with args } in
-      let first_match, rem = split_and_precompile_simplified m in
-      combine_handlers ~scopes repr partial ctx (v, str, arg) first_match rem
-  | _ -> assert false
-
-and combine_handlers ~scopes repr partial ctx (v, str, arg) first_match rem =
-  let lam, total =
-    comp_match_handlers
-      (( if dbg then
+    (m : (split_args, Simple.clause) pattern_matching) =
+  let first_match, rem = split_and_precompile_simplified m in
+  combine_handlers ~scopes repr partial ctx first_match rem
+
+(* Note on [compute_arg_partial].
+
+   Partiality information is provided by the
+   type-checker. A pattern-matching is compiled as Total if the
+   type-checker verified that any well-typed value of the scrutinee
+   type is matched by at least one unguarded clause.
+
+   The pattern-matching compiler also tracks information relevant to
+   partiality/exhaustiveness: it checks that a switch on constructors
+   is 'complete' (all constructors at that type are matched), and it
+   carries fine-grained context information that allows to determine
+   that some incomplete switches are in fact exhaustive
+   (missing constructors were matched previously), or refine
+   information about which constructors are left to match for the
+   following switches.
+
+   Sometimes the pattern-matching compiler cannot tell that a switch
+   on an argument is complete, but the type-checker can. This is the
+   case in particular for GADTs -- the compiler does not use type
+   information to rule certain constructors out.
+
+     type _ t =
+       | Int : int -> int t
+       | Bool : bool -> bool t
+
+     let total_function : int t -> int = function
+       | Int n -> n
+
+   In these cases we want to trust the type-checker totality
+   information to generate better code: we know that the only possible
+   constructor is [Int], so we can generate branchless code that
+   fetches its argument directly. Users rely on this performant
+   compilation scheme for GADTs.
+
+   Trusting the totality information also lets us avoid computing
+   fine-grained 'negative' information, which can avoid some
+   pathological cases for pattern-matching compilation. (The vast
+   majority of 'match' and 'function' uses in practice are total.)
+
+   On the other hand, there are cases where the type-checker wrongly
+   believes that a matching is total, because its totality criterion
+   (all well-typed values are matched by a non-guarded clause) ignores
+   side-effects.
+
+     let r = ref (Some 42)
+
+     let () = match Some r with
+       | { contents = None } -> 0
+       | _ when (r := None; false) -> 1
+       | { contents = Some n } -> n
+
+   In this example, the pattern-matching compiler will notice that the
+   [Some n] case is not total (this is thanks to the use of
+   [set_args_erase_mutable] in Context.combine), but the type-checker
+   believes that it is total, so that the only possible value reaching
+   the third clause has a [Some] constructor. Trusting the
+   type-checker would lead us to generate a direct field access to the
+   [Some] argument, which is unsound as the value at this point has
+   become [None].
+
+   The job of [compute_arg_partial] is to combine the totality
+   information coming from the type-checker and contextual information
+   provided by the compiler to decide whether a switch on a given
+   argument should be considered partial or not, in a way that is
+   correct but does not pessimize too many code patterns.
+
+   The criterion that we use is based on two contextual informations:
+
+   - [mut]: is the current sub-value we are switching over placed
+     (transitively) under a mutable field?
+
+   - [tempo]: is this always the first switch on this position,
+     or did some value jump here after coming from previous submatrices
+     that may already have switched on the position?
+
+   If [mut = Mutable], that is we are in a transitivitely mutable position,
+   and [tempo = Following], this may not be the first switch on this position,
+   then we pessimize totality information.
+
+   Remark: when we split a matrix into several submatrices that have
+   to be tried in turn, and the original matrix was in a [Total]
+   context, we compile all submatrices as [Partial] except for the
+   very last one that remains [Total] -- see
+   {!comp_match_handlers}. And that very last matrix will be
+   a [Following] matrix, unless there was no actual split -- we split
+   into only one matrix. The criterion above can thus be understood
+   as: either we are at an [Immutable] position, or there was no
+   actual split from the root of the pattern-matching to the current
+   submatrix.
+
+   With this criterion, pure patterns are never pessimized, but even
+   patterns that have some GADTs and some non-GADT mutable components
+   work well -- for example, a pair of a GADT value and
+   a reference. On the other hand, matching on GADTs inside
+   a reference is pessimized when the GADT matching occurs under
+   a mutable constructor and after a split.
+*)
+(* The code should ensure that all partiality information that is used
+   to make code-generation decisions has gone through
+   [compute_arg_partial]. To do this statically we distinguish the
+   general type [partial] of partiality information from the
+   specialized type [arg_partial] used to make code-generation
+   decisions for a given argument switch. *)
+and compute_arg_partial partial mut =
+  match partial.tempo, mut with
+  | Following, Mutable -> Arg { partial with global = Partial }
+  | First, _ | _, Immutable -> Arg partial
+
+and mut_of_binding_kind =
+  (* This is somewhat of a hack: we notice that a pattern-matching
+     argument is mutable (its value can change if evaluated
+     several times) exactly when it is bound as StrictOpt. Alias
+     bindings are obviously pure, but Strict bindings are also only
+     used in the pattern-matching compiler for expressions that give
+     the same value when evaluated twice.
+     An alternative would be to track 'mutability of the field'
+     directly.
+  *)
+  function
+  | Strict | Alias -> Immutable
+  | StrictOpt -> Mutable
+
+and bind_match_arg kind v arg (lam, jumps) =
+  let jumps =
+    (* If the Lambda expression [arg] to access the first argument is
+       a mutable field read, then its binding and evaluation may be
+       emitted in different calls to [combine_handlers] on the same
+       column. Consider for example:
+
+         type ('a, 'b) mut_second = { immut : 'a; mutable mut : 'b; }
+
+         function
+         | {immut = false; mut = None} -> -1
+         | {immut = true ; mut = None} -> 0
+         | {immut = _ ;    mut = Some n} -> n
+
+       When compiling this example, [immut] will be matched first, and
+       each case will perform a [None] check and also jump to a shared
+       exit handler containing the [Some n] clause. The field access
+       to the [mut] field will be emitted three times, in each branch
+       of the switch and in the shared handler.
+
+       In the general case, the value of the mutable field may change
+       between the reads (due to a [when] guard or even a race from
+       another thread or domain), so we must be careful not to
+       propagate context information that could have become
+       incorrect. We "fix" the context information on mutable arguments
+       by calling [Context.erase_first_col] below.
+    *)
+    match mut_of_binding_kind kind with
+    | Immutable -> jumps
+    | Mutable ->
+        Jumps.map Context.erase_first_col jumps in
+  (bind_check kind v arg lam,
+   jumps)
+
+and combine_handlers ~scopes repr partial ctx first_match rem =
+  comp_match_handlers
+    (( if dbg then
          do_compile_matching_pr ~scopes
        else
          do_compile_matching ~scopes
-       )
-         repr)
-      partial ctx first_match rem
-  in
-  (bind_check str v arg lam, total)
+     )
+       repr)
+    partial ctx first_match rem
 
 (* verbose version of do_compile_matching, for debug *)
 and do_compile_matching_pr ~scopes repr partial ctx x =
   debugf
     "@[<v>MATCH %a\
      @,%a"
-    pp_partial partial
+    pp_partiality partial
     pretty_precompiled x;
   debugf "@,@[<v 2>CTX:@,%a@]"
     Context.pp ctx;
@@ -3450,77 +3886,75 @@ and do_compile_matching_pr ~scopes repr partial ctx x =
         raise exn
   in
   debugf "@]";
-  if Jumps.is_empty jumps then
-    debugf "@,NO JUMPS"
-  else
-    debugf "@,@[<v 2>JUMPS:@,%a@]"
-      Jumps.pp jumps;
+  debugf "%a" Jumps.pp_section jumps;
   debugf "@]";
   r
 
 and do_compile_matching ~scopes repr partial ctx pmh =
   match pmh with
   | Pm pm -> (
-      let arg =
-        match pm.args with
-        | (first_arg, _) :: _ -> first_arg
-        | _ ->
-            (* We arrive in do_compile_matching from:
-               - compile_matching
-               - recursive call on PmVars
-               The first one explicitly checks that [args] is nonempty, the
-               second one is only generated when the inner pm first looks at
-               a variable (i.e. there is something to look at).
-            *)
-            assert false
+      let first = pm.args.first in
+      let arg = arg_of_pure first.arg in
+      let arg_partial =
+        compute_arg_partial partial first.mut
+        (* It is important to distinguish:
+           - [arg_partial]: the partiality information that will
+             be used to compile the 'upcoming' switch on the first argument
+           - [partial]: the partiality information that will be used
+             recursively for all submatrices, including on different columns.
+
+           If the argument is in a transivitely-mutable position, we
+           conservatively consider the switch Partial (this is the
+           role of [compute_arg_partial]), but this should not
+           pessimize the compilation of other columns. *)
       in
       let ph = what_is_cases pm.cases in
       let pomega = Patterns.Head.to_omega_pattern ph in
       let ploc = head_loc ~scopes ph in
+      let compile_no_test divide combine =
+        compile_no_test ~scopes divide combine repr partial ctx pm
+      in
+      let compile_test divide combine =
+        compile_test
+          (compile_match ~scopes repr partial)
+          arg_partial divide combine ctx pm
+      in
       let open Patterns.Head in
       match ph.pat_desc with
       | Any ->
-          compile_no_test ~scopes
+          compile_no_test
             divide_var
-            Context.rshift repr partial ctx pm
+            Context.rshift
       | Tuple _ ->
-          compile_no_test ~scopes
+          compile_no_test
             (divide_tuple ~scopes ph)
-            Context.combine repr partial ctx pm
+            Context.combine
       | Record [] -> assert false
       | Record (lbl :: _) ->
-          compile_no_test ~scopes
+          compile_no_test
             (divide_record ~scopes lbl.lbl_all ph)
-            Context.combine repr partial ctx pm
+            Context.combine
       | Constant cst ->
           compile_test
-            (compile_match ~scopes repr partial)
-            partial divide_constant
-            (combine_constant ploc arg cst partial)
-            ctx pm
+            divide_constant
+            (combine_constant ploc arg cst arg_partial)
       | Construct cstr ->
           compile_test
-            (compile_match ~scopes repr partial)
-            partial (divide_constructor ~scopes)
-            (combine_constructor ploc arg ph.pat_env cstr partial)
-            ctx pm
+            (divide_constructor ~scopes)
+            (combine_constructor ploc arg ph.pat_env cstr arg_partial)
       | Array _ ->
           let kind = Typeopt.array_pattern_kind pomega in
           compile_test
-            (compile_match ~scopes repr partial)
-            partial (divide_array ~scopes kind)
-            (combine_array ploc arg kind partial)
-            ctx pm
+            (divide_array ~scopes kind)
+            (combine_array ploc arg kind arg_partial)
       | Lazy ->
-          compile_no_test ~scopes
+          compile_no_test
             (divide_lazy ~scopes ph)
-            Context.combine repr partial ctx pm
+            Context.combine
       | Variant { cstr_row = row } ->
           compile_test
-            (compile_match ~scopes repr partial)
-            partial (divide_variant ~scopes !row)
-            (combine_variant ploc !row arg partial)
-            ctx pm
+            (divide_variant ~scopes !row)
+            (combine_variant ploc !row arg arg_partial)
     )
   | PmVar { inside = pmh } ->
       let lam, total =
@@ -3541,98 +3975,15 @@ and compile_no_test ~scopes divide up_ctx repr partial ctx to_match =
 
 (* The entry points *)
 
-(*
-   If there is a guard in a matching or a lazy pattern,
-   then set exhaustiveness info to Partial.
-   (because of side effects, assume the worst).
-
-   Notice that exhaustiveness information is trusted by the compiler,
-   that is, a match flagged as Total should not fail at runtime.
-   More specifically, for instance if match y with x::_ -> x is flagged
-   total (as it happens during JoCaml compilation) then y cannot be []
-   at runtime. As a consequence, the static Total exhaustiveness information
-   have to be downgraded to Partial, in the dubious cases where guards
-   or lazy pattern execute arbitrary code that may perform side effects
-   and change the subject values.
-LM:
-   Lazy pattern was PR#5992, initial patch by lpw25.
-   I have  generalized the patch, so as to also find mutable fields.
-*)
-
-let is_lazy_pat p =
-  match p.pat_desc with
-  | Tpat_lazy _ -> true
-  | Tpat_alias _
-  | Tpat_variant _
-  | Tpat_record _
-  | Tpat_tuple _
-  | Tpat_construct _
-  | Tpat_array _
-  | Tpat_or _
-  | Tpat_constant _
-  | Tpat_var _
-  | Tpat_any ->
-      false
-
-let has_lazy p = Typedtree.exists_pattern is_lazy_pat p
-
-let is_record_with_mutable_field p =
-  match p.pat_desc with
-  | Tpat_record (lps, _) ->
-      List.exists
-        (fun (_, lbl, _) ->
-          match lbl.Types.lbl_mut with
-          | Mutable -> true
-          | Immutable -> false)
-        lps
-  | Tpat_alias _
-  | Tpat_variant _
-  | Tpat_lazy _
-  | Tpat_tuple _
-  | Tpat_construct _
-  | Tpat_array _
-  | Tpat_or _
-  | Tpat_constant _
-  | Tpat_var _
-  | Tpat_any ->
-      false
-
-let has_mutable p = Typedtree.exists_pattern is_record_with_mutable_field p
-
-(* Downgrade Total when
-   1. Matching accesses some mutable fields;
-   2. And there are  guards or lazy patterns.
-*)
-
-let check_partial has_mutable has_lazy pat_act_list = function
-  | Partial -> Partial
-  | Total ->
-      if
-        pat_act_list = []
-        || (* allow empty case list *)
-           List.exists
-             (fun (pats, lam) ->
-               has_mutable pats && (is_guarded lam || has_lazy pats))
-             pat_act_list
-      then
-        Partial
-      else
-        Total
-
-let check_partial_list pats_act_list =
-  check_partial (List.exists has_mutable) (List.exists has_lazy) pats_act_list
-
-let check_partial pat_act_list =
-  check_partial has_mutable has_lazy pat_act_list
-
-(* have toplevel handler when appropriate *)
-
 type failer_kind =
   | Raise_match_failure
   | Reraise_noloc of lambda
+  | Reperform_noloc of lambda list
 
 let failure_handler ~scopes loc ~failer () =
   match failer with
+  | Reperform_noloc reperform_lst ->
+    Lprim (Preperform, reperform_lst, Loc_unknown)
   | Reraise_noloc exn_lam ->
     Lprim (Praise Raise_reraise, [ exn_lam ], Scoped_location.Loc_unknown)
   | Raise_match_failure ->
@@ -3660,13 +4011,6 @@ let failure_handler ~scopes loc ~failer () =
         ],
         sloc )
 
-let check_total ~scopes loc ~failer total lambda i =
-  if Jumps.is_empty total then
-    lambda
-  else
-    Lstaticcatch (lambda, (i, []),
-                  failure_handler ~scopes loc ~failer ())
-
 let toplevel_handler ~scopes loc ~failer partial args cases compile_fun =
   let compile_fun partial pm =
     debugf "@[<v>MATCHING@,";
@@ -3674,31 +4018,54 @@ let toplevel_handler ~scopes loc ~failer partial args cases compile_fun =
     debugf "@]@.";
     result
   in
-  match partial with
-  | Total when not !Clflags.safer_matching ->
-      let default = Default_environment.empty in
-      let pm = { args; cases; default } in
-      let (lam, total) = compile_fun Total pm in
-      assert (Jumps.is_empty total);
-      lam
-  | Partial | Total (* when !Clflags.safer_matching *) ->
-      let raise_num = next_raise_count () in
-      let default =
-        Default_environment.cons [ Patterns.omega_list args ] raise_num
-          Default_environment.empty in
-      let pm = { args; cases; default } in
-      begin match compile_fun Partial pm with
-      | exception Unused -> assert false
-      | (lam, total) ->
-          check_total ~scopes loc ~failer total lam raise_num
-      end
+  let final_exit = next_raise_count () in
+  let default = Default_environment.empty ~final_exit in
+  let pm = { args; cases; default } in
+  let partial =
+    let only_refutations =
+      (* Example: [function _ -> .]. *)
+      cases = []
+    in
+    if only_refutations || !Clflags.safer_matching
+    then Partial
+    else partial
+  in
+  let partial = { current = partial; global = partial; tempo = First; } in
+  begin match compile_fun partial pm with
+  | exception Unused -> assert false
+  | (lam, jumps) ->
+      match Jumps.partial jumps with
+      | Total -> lam
+      | Partial ->
+        if partial.global = Total then begin
+          (* In this case the type-checker believed the
+             pattern-matching to be Total, but the compiler found it
+             to be Partial. See the discussion in the "Warning
+             reference" section of the reference manual. *)
+          let warning = Warnings.Degraded_to_partial_match in
+          if Warnings.is_active warning then
+            Location.prerr_warning loc warning
+        end;
+        Lstaticcatch (lam, (final_exit, []),
+                      failure_handler ~scopes loc ~failer ())
+  end
+
+let root_arg arg binding_kind =
+  (* The mutability information denotes the mutability of a *position*
+     inside the value, which indicates whether looking inside the
+     value of the scrutinee is a pure operation. At the root we are
+     immutable. *)
+  { arg; binding_kind; mut = Immutable }
 
 let compile_matching ~scopes loc ~failer repr arg pat_act_list partial =
-  let partial = check_partial pat_act_list partial in
-  let args = [ (arg, Strict) ] in
+  let args = [ root_arg arg Strict ] in
   let rows = map_on_rows (fun pat -> (pat, [])) pat_act_list in
-  toplevel_handler ~scopes loc ~failer partial args rows (fun partial pm ->
-    compile_match_nonempty ~scopes repr partial (Context.start 1) pm)
+  let handler =
+    toplevel_handler ~scopes loc ~failer partial args rows
+  in
+  handler (fun partial pm ->
+    compile_match_nonempty ~scopes repr partial (Context.start 1) pm
+  )
 
 let for_function ~scopes loc repr param pat_act_list partial =
   compile_matching ~scopes loc ~failer:Raise_match_failure
@@ -3716,6 +4083,11 @@ let for_trywith ~scopes loc param pat_act_list =
   compile_matching ~scopes loc ~failer:(Reraise_noloc param)
     None param pat_act_list Partial
 
+let for_handler ~scopes loc param cont cont_tail pat_act_list =
+  compile_matching ~scopes loc
+    ~failer:(Reperform_noloc [param; cont; cont_tail])
+    None param pat_act_list Partial
+
 let simple_for_let ~scopes loc param pat body =
   compile_matching ~scopes loc ~failer:Raise_match_failure
     None param [ (pat, body) ] Partial
@@ -3889,8 +4261,7 @@ let for_let ~scopes loc param pat body =
 
 (* Easy case since variables are available *)
 let for_tupled_function ~scopes loc paraml pats_act_list partial =
-  let partial = check_partial_list pats_act_list partial in
-  let args = List.map (fun id -> (Lvar id, Strict)) paraml in
+  let args = List.map (fun id -> root_arg (Lvar id) Strict) paraml in
   let handler =
     toplevel_handler ~scopes loc ~failer:Raise_match_failure
       partial args pats_act_list in
@@ -3943,8 +4314,8 @@ let flatten_handler size handler =
   { handler with provenance = flatten_matrix size handler.provenance }
 
 type pm_flattened =
-  | FPmOr of (pattern, unit) pm_or_compiled
-  | FPm of pattern Non_empty_row.t clause pattern_matching
+  | FPmOr of (args, pattern, unit) pm_or_compiled
+  | FPm of (args, pattern Non_empty_row.t clause) pattern_matching
 
 let flatten_precompiled size args pmh =
   match pmh with
@@ -3969,35 +4340,31 @@ let compile_flattened ~scopes repr partial ctx pmh =
       let lam, total = compile_match_nonempty ~scopes repr partial ctx b in
       compile_orhandlers (compile_match ~scopes repr partial) lam total ctx hs
 
-let do_for_multiple_match ~scopes loc paraml pat_act_list partial =
+let do_for_multiple_match ~scopes loc idl pat_act_list partial =
   let repr = None in
   let arg =
     let sloc = Scoped_location.of_location ~scopes loc in
-    Lprim (Pmakeblock (0, Immutable, None), paraml, sloc) in
+    let args = List.map (fun id -> Lvar id) idl in
+    Lprim (Pmakeblock (0, Immutable, None), args, sloc) in
+  let input_args = { first = root_arg (Tuple arg) Strict; rest = [] } in
   let handler =
-    let partial = check_partial pat_act_list partial in
     let rows = map_on_rows (fun p -> (p, [])) pat_act_list in
     toplevel_handler ~scopes loc ~failer:Raise_match_failure
-      partial [ (arg, Strict) ] rows in
+      partial input_args rows in
   handler (fun partial pm1 ->
     let pm1_half =
-      { pm1 with cases = List.map (half_simplify_nonempty ~arg) pm1.cases }
+      { pm1 with
+        cases = List.map (half_simplify_nonempty ~arg) pm1.cases }
     in
-    let next, nexts = split_and_precompile_half_simplified ~arg pm1_half in
-    let size = List.length paraml
-    and idl = List.map (function
-      | Lvar id -> id
-      | _ -> Ident.create_local "*match*") paraml in
-    let args = List.map (fun id -> (Lvar id, Alias)) idl in
+    let next, nexts = split_and_precompile_half_simplified pm1_half in
+    let size = List.length idl in
+    let args = List.map (fun id -> root_arg (Lvar id) Alias) idl in
     let flat_next = flatten_precompiled size args next
     and flat_nexts =
       List.map (fun (e, pm) -> (e, flatten_precompiled size args pm)) nexts
     in
-    let lam, total =
-      comp_match_handlers (compile_flattened ~scopes repr) partial
-        (Context.start size) flat_next flat_nexts
-    in
-    List.fold_right2 (bind Strict) idl paraml lam, total
+    comp_match_handlers (compile_flattened ~scopes repr) partial
+      (Context.start size) flat_next flat_nexts
   )
 
 (* PR#4828: Believe it or not, the 'paraml' argument below
@@ -4015,9 +4382,9 @@ let bind_opt (v, eo) k =
 
 let for_multiple_match ~scopes loc paraml pat_act_list partial =
   let v_paraml = List.map param_to_var paraml in
-  let paraml = List.map (fun (v, _) -> Lvar v) v_paraml in
+  let vl = List.map fst v_paraml in
   List.fold_right bind_opt v_paraml
-    (do_for_multiple_match ~scopes loc paraml pat_act_list partial)
+    (do_for_multiple_match ~scopes loc vl pat_act_list partial)
 
 let for_optional_arg_default ~scopes loc pat ~default_arg ~param body =
   let supplied_or_default =

diff --git a/lambda/matching.mli b/lambda/matching.mli
index f5eb3e0c98dfc79bb28081ce3e0dcaac4fdcf467..0c4000b7350b992b6962ac5e29c9b3f969a19d95 100644 (file)
--- a/lambda/matching.mli
+++ b/lambda/matching.mli
@@ -28,6 +28,10 @@ val for_trywith:
         scopes:scopes -> Location.t ->
         lambda -> (pattern * lambda) list ->
         lambda
+val for_handler:
+        scopes:scopes -> Location.t ->
+        lambda -> lambda -> lambda -> (pattern * lambda) list ->
+        lambda
 val for_let:
         scopes:scopes -> Location.t ->
         lambda -> pattern -> lambda ->

diff --git a/lambda/printlambda.ml b/lambda/printlambda.ml
index e43564f87ed826aa3d14b954989ad66c961e1226..76989a4035f7435a3d3dbe067587c4a7cefbdff5 100644 (file)
--- a/lambda/printlambda.ml
+++ b/lambda/printlambda.ml
@@ -359,6 +359,7 @@ let primitive ppf = function
   | Patomic_fetch_add -> fprintf ppf "atomic_fetch_add"
   | Popaque -> fprintf ppf "opaque"
   | Pdls_get -> fprintf ppf "dls_get"
+  | Ppoll -> fprintf ppf "poll"
 
 let name_of_primitive = function
   | Pbytes_of_string -> "Pbytes_of_string"
@@ -474,6 +475,7 @@ let name_of_primitive = function
   | Pperform -> "Pperform"
   | Preperform -> "Preperform"
   | Pdls_get -> "Pdls_get"
+  | Ppoll -> "Ppoll"
 
 let function_attribute ppf t =
   if t.is_a_functor then

diff --git a/lambda/tmc.ml b/lambda/tmc.ml
index 59f852b1104f506450e9b7cd6b59c7455b1947ab..8b5b66642fcf3f953917238446273ab020af7a10 100644 (file)
--- a/lambda/tmc.ml
+++ b/lambda/tmc.ml
@@ -895,6 +895,7 @@ let rec choice ctx t =
     | Pbbswap _
     | Pint_as_pointer
     | Psequand | Psequor
+    | Ppoll
       ->
         let primargs = traverse_list ctx primargs in
         Choice.lambda (Lprim (prim, primargs, loc))
@@ -1002,7 +1003,7 @@ let () =
                Ambiguous_constructor_arguments
                  { explicit = false; arguments }) ->
           let print_msg ppf =
-            Format.fprintf ppf
+            Format_doc.fprintf ppf
               "%a:@ this@ constructor@ application@ may@ be@ \
                TMC-transformed@ in@ several@ different@ ways.@ \
                Please@ disambiguate@ by@ adding@ an@ explicit@ %a \
@@ -1027,7 +1028,7 @@ let () =
                Ambiguous_constructor_arguments
                  { explicit = true; arguments }) ->
           let print_msg ppf =
-            Format.fprintf ppf
+            Format_doc.fprintf ppf
               "%a:@ this@ constructor@ application@ may@ be@ \
                TMC-transformed@ in@ several@ different@ ways.@ Only@ one@ of@ \
                the@ arguments@ may@ become@ a@ TMC@ call,@ but@ several@ \

diff --git a/lambda/translattribute.ml b/lambda/translattribute.ml
index aa889e1f7d363e1fa5a0390302e332d4838761de..11e062b69dd69dde35637dfea6d21dc705f6bbb8 100644 (file)
--- a/lambda/translattribute.ml
+++ b/lambda/translattribute.ml
@@ -80,7 +80,8 @@ let get_id_from_exp =
 let get_int_from_exp =
   let open Parsetree in
   function
-    | { pexp_desc = Pexp_constant (Pconst_integer(s, None)) } ->
+    | { pexp_desc = Pexp_constant
+            {pconst_desc = Pconst_integer(s, None); _} } ->
         begin match Misc.Int_literal_converter.int s with
         | n -> Result.Ok n
         | exception (Failure _) -> Result.Error ()

diff --git a/lambda/translclass.ml b/lambda/translclass.ml
index f7b77ebdb31c6a3a3bcf52af8d9373763bab4df7..5a69398708509bb911841699fdce27582fb1b74a 100644 (file)
--- a/lambda/translclass.ml
+++ b/lambda/translclass.ml
@@ -215,6 +215,9 @@ let rec build_object_init_0
     Tcl_let (_rec_flag, _defs, vals, cl) ->
       build_object_init_0
         ~scopes cl_table (vals@params) cl copy_env subst_env top ids
+  | Tcl_open (_descr, cl) ->
+      build_object_init_0
+        ~scopes cl_table params cl copy_env subst_env top ids
   | _ ->
       let self = Ident.create_local "self" in
       let env = Ident.create_local "env" in
@@ -284,7 +287,7 @@ let rec build_class_init ~scopes cla cstr super inh_init cl_init msubst top cl =
            Llet (Strict, Pgenval, obj_init,
                  mkappl(Lprim(Pfield (1, Pointer, Mutable),
                               [path_lam], Loc_unknown), Lvar cla ::
-                        if top then [Lprim(Pfield (3, Pointer, Mutable),
+                        if top then [Lprim(Pfield (2, Pointer, Mutable),
                                      [path_lam], Loc_unknown)]
                         else []),
                  bind_super cla super cl_init))
@@ -413,6 +416,11 @@ let rec build_class_lets ~scopes cl =
       (env, fun lam_and_kind ->
           let lam, rkind = wrap lam_and_kind in
           Translcore.transl_let ~scopes rec_flag defs lam, rkind)
+  | Tcl_open (open_descr, cl) ->
+      (* Failsafe to ensure we get a compilation error if arbitrary
+         module expressions become allowed *)
+      let _ : Path.t * Longident.t loc = open_descr.open_expr in
+      build_class_lets ~scopes cl
   | _ ->
       (cl.cl_env, fun lam_and_kind -> lam_and_kind)
 
@@ -529,8 +537,7 @@ let transl_class_rebind ~scopes cl vf =
                    lfunction [envs, Pgenval]
                      (mkappl(Lvar new_init,
                              [mkappl(Lvar env_init, [Lvar envs])]))));
-           lfield cla 2;
-           lfield cla 3],
+           lfield cla 2],
           Loc_unknown)))
   with Exit ->
     lambda_unit
@@ -636,16 +643,26 @@ open M
     * class without local dependencies -> direct translation
     * with local dependencies -> generate a stubs tree,
       with a node for every local classes inherited
-   A class is a 4-tuple:
-    (obj_init, class_init, env_init, env)
-    obj_init: creation function (unit -> obj)
-    class_init: inheritance function (table -> env_init)
+   A class is a 3-tuple:
+    (obj_init, class_init, env)
+    obj_init: creation function (unit -> params -> obj)
+    class_init: inheritance function (table -> env -> obj_init)
       (one by source code)
-    env_init: parameterisation by the local environment
-      (env -> params -> obj_init)
-      (one for each combination of inherited class_init )
     env: local environment
-   If ids=0 (immediate object), then only env_init is conserved.
+
+   The local environment is used for cached classes. When a
+   class definition occurs under a call to Translobj.oo_wrap
+   (typically inside a functor), the class creation code is
+   split between a static part (depending only on toplevel names)
+   and a dynamic part, the environment. The static part is cached
+   in a toplevel structure, so that only the first class creation
+   computes it and the subsequent classes can reuse it.
+   Because of that, the (static) [class_init] function takes both
+   the class table to be filled and the environment as parameters,
+   and when called is given the [env] field of the class.
+   For the [obj_init] part, an [env_init] function (of type [env -> obj_init])
+   is stored in the cache, and called on the environment to generate
+   the [obj_init] at class creation time.
 *)
 
 (*
@@ -822,7 +839,7 @@ let transl_class ~scopes ids cl_id pub_meths cl vflag =
       mkappl (oo_prim "init_class", [Lvar table]),
       Lprim(Pmakeblock(0, Immutable, None),
             [mkappl (Lvar env_init, [lambda_unit]);
-             Lvar class_init; Lvar env_init; lambda_unit],
+             Lvar class_init; lambda_unit],
             Loc_unknown)))),
       Static
   and lbody_virt lenvs =
@@ -833,7 +850,7 @@ let transl_class ~scopes ids cl_id pub_meths cl vflag =
                           ~loc:Loc_unknown
                           ~return:Pgenval
                           ~params:[cla, Pgenval] ~body:cl_init;
-           lambda_unit; lenvs],
+           lenvs],
          Loc_unknown),
     Static
   in
@@ -861,7 +878,7 @@ let transl_class ~scopes ids cl_id pub_meths cl vflag =
   and linh_envs =
     List.map
       (fun (_, path_lam, _) ->
-        Lprim(Pfield (3, Pointer, Mutable), [path_lam], Loc_unknown))
+        Lprim(Pfield (2, Pointer, Mutable), [path_lam], Loc_unknown))
       (List.rev inh_init)
   in
   let make_envs (lam, rkind) =
@@ -951,9 +968,8 @@ let transl_class ~scopes ids cl_id pub_meths cl vflag =
         (if concrete then
           [mkappl (lfield cached 0, [lenvs]);
            lfield cached 1;
-           lfield cached 0;
            lenvs]
-        else [lambda_unit; lfield cached 0; lambda_unit; lenvs]),
+        else [lambda_unit; lfield cached 0; lenvs]),
         Loc_unknown
        ),
     Static)))
@@ -978,10 +994,10 @@ let () =
 
 (* Error report *)
 
-open Format
+open Format_doc
 module Style = Misc.Style
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Tags (lab1, lab2) ->
       fprintf ppf "Method labels %a and %a are incompatible.@ %s"
         Style.inline_code lab1
@@ -992,7 +1008,9 @@ let () =
   Location.register_error_of_exn
     (function
       | Error (loc, err) ->
-        Some (Location.error_of_printer ~loc report_error err)
+        Some (Location.error_of_printer ~loc report_error_doc err)
       | _ ->
         None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/lambda/translclass.mli b/lambda/translclass.mli
index 89eb8f556e69acd597c91479ffb6f46feaf72556..7520c9af5d0fd5dd3b5f3583dba607fdf8082d2e 100644 (file)
--- a/lambda/translclass.mli
+++ b/lambda/translclass.mli
@@ -26,6 +26,5 @@ type error = Tags of string * string
 
 exception Error of Location.t * error
 
-open Format
-
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/lambda/translcore.ml b/lambda/translcore.ml
index 7d2daf0485176a85114578e7868a5f0d57fc8afd..dc84de4811cd6dce1bbcd7b3e82a2515aee612a9 100644 (file)
--- a/lambda/translcore.ml
+++ b/lambda/translcore.ml
@@ -51,7 +51,7 @@ let prim_fresh_oo_id =
 let transl_extension_constructor ~scopes env path ext =
   let path =
     Printtyp.wrap_printing_env env ~error:true (fun () ->
-      Option.map (Printtyp.rewrite_double_underscore_paths env) path)
+      Option.map (Out_type.rewrite_double_underscore_paths env) path)
   in
   let name =
     match path, !Clflags.for_package with
@@ -242,13 +242,37 @@ and transl_exp0 ~in_new_scope ~scopes e =
       event_after ~scopes e
         (transl_apply ~scopes ~tailcall ~inlined ~specialised
            (transl_exp ~scopes funct) oargs (of_location ~scopes e.exp_loc))
-  | Texp_match(arg, pat_expr_list, partial) ->
+  | Texp_match(arg, pat_expr_list, [], partial) ->
       transl_match ~scopes e arg pat_expr_list partial
-  | Texp_try(body, pat_expr_list) ->
+  | Texp_match(arg, pat_expr_list, eff_pat_expr_list, partial) ->
+  (* need to separate the values from exceptions for transl_handler *)
+      let split_case (val_cases, exn_cases as acc)
+            ({ c_lhs; c_rhs } as case) =
+        if c_rhs.exp_desc = Texp_unreachable then acc else
+        let val_pat, exn_pat = split_pattern c_lhs in
+        match val_pat, exn_pat with
+        | None, None -> assert false
+        | Some pv, None ->
+            { case with c_lhs = pv } :: val_cases, exn_cases
+        | None, Some pe ->
+            val_cases, { case with c_lhs = pe } :: exn_cases
+        | Some pv, Some pe ->
+            { case with c_lhs = pv } :: val_cases,
+            { case with c_lhs = pe } :: exn_cases
+      in
+      let pat_expr_list, exn_pat_expr_list =
+        let x, y = List.fold_left split_case ([], []) pat_expr_list in
+        List.rev x, List.rev y
+      in
+      transl_handler ~scopes e arg (Some (pat_expr_list, partial))
+        exn_pat_expr_list eff_pat_expr_list
+  | Texp_try(body, pat_expr_list, []) ->
       let id = Typecore.name_cases "exn" pat_expr_list in
       Ltrywith(transl_exp ~scopes body, id,
                Matching.for_trywith ~scopes e.exp_loc (Lvar id)
                  (transl_cases_try ~scopes pat_expr_list))
+  | Texp_try(body, exn_pat_expr_list, eff_pat_expr_list) ->
+      transl_handler ~scopes e body None exn_pat_expr_list eff_pat_expr_list
   | Texp_tuple el ->
       let ll, shape = transl_list_with_shape ~scopes el in
       begin try
@@ -588,13 +612,20 @@ and transl_guard ~scopes guard rhs =
       event_before ~scopes cond
         (Lifthenelse(transl_exp ~scopes cond, expr, staticfail))
 
-and transl_case ~scopes {c_lhs; c_guard; c_rhs} =
-  (c_lhs, transl_guard ~scopes c_guard c_rhs)
+and transl_cont cont c_cont body =
+  match cont, c_cont with
+  | Some id1, Some id2 -> Llet(Alias, Pgenval, id2, Lvar id1, body)
+  | None, None
+  | Some _, None -> body
+  | None, Some _ -> assert false
 
-and transl_cases ~scopes cases =
+and transl_case ~scopes ?cont {c_lhs; c_cont; c_guard; c_rhs} =
+  (c_lhs, transl_cont cont c_cont (transl_guard ~scopes c_guard c_rhs))
+
+and transl_cases ~scopes ?cont cases =
   let cases =
     List.filter (fun c -> c.c_rhs.exp_desc <> Texp_unreachable) cases in
-  List.map (transl_case ~scopes) cases
+  List.map (transl_case ~scopes ?cont) cases
 
 and transl_case_try ~scopes {c_lhs; c_guard; c_rhs} =
   iter_exn_names Translprim.add_exception_ident c_lhs;
@@ -742,7 +773,9 @@ and transl_tupled_function ~scopes loc return repr params body =
     | [], Tfunction_cases { cases; partial } ->
         Some (cases, partial)
     | [ { fp_kind = Tparam_pat pat; fp_partial } ], Tfunction_body body ->
-        let case = { c_lhs = pat; c_guard = None; c_rhs = body } in
+        let case =
+          { c_lhs = pat; c_cont = None; c_guard = None; c_rhs = body }
+        in
         Some ([ case ], fp_partial)
     | _ -> None
   in
@@ -1153,6 +1186,65 @@ and transl_match ~scopes e arg pat_expr_list partial =
     Lstaticcatch (body, (static_exception_id, val_ids), handler)
   ) classic static_handlers
 
+and prim_alloc_stack =
+  Pccall (Primitive.simple ~name:"caml_alloc_stack" ~arity:3 ~alloc:true)
+
+and transl_handler ~scopes e body val_caselist exn_caselist eff_caselist =
+  let val_fun =
+    match val_caselist with
+    | None ->
+        let param = Ident.create_local "param" in
+        lfunction ~kind:Curried ~params:[param, Pgenval]
+         ~return:Pgenval ~body:(Lvar param)
+         ~attr:default_function_attribute ~loc:Loc_unknown
+    | Some (val_caselist, partial) ->
+        let val_cases = transl_cases ~scopes val_caselist in
+        let param = Typecore.name_cases "param" val_caselist in
+        let body =
+          Matching.for_function ~scopes e.exp_loc None (Lvar param) val_cases
+            partial
+        in
+        lfunction ~kind:Curried ~params:[param, Pgenval]
+          ~return:Pgenval ~attr:default_function_attribute
+          ~loc:Loc_unknown ~body
+  in
+  let exn_fun =
+    let exn_cases = transl_cases ~scopes exn_caselist in
+    let param = Typecore.name_cases "exn" exn_caselist in
+    let body = Matching.for_trywith ~scopes e.exp_loc (Lvar param) exn_cases in
+    lfunction ~kind:Curried ~params:[param, Pgenval] ~return:Pgenval
+      ~attr:default_function_attribute ~loc:Loc_unknown ~body
+  in
+  let eff_fun =
+    let param = Typecore.name_cases "eff" eff_caselist in
+    let cont = Ident.create_local "k" in
+    let cont_tail = Ident.create_local "ktail" in
+    let eff_cases = transl_cases ~scopes ~cont eff_caselist in
+    let body =
+      Matching.for_handler ~scopes e.exp_loc (Lvar param) (Lvar cont)
+        (Lvar cont_tail) eff_cases
+    in
+    lfunction ~kind:Curried
+      ~params:[(param, Pgenval); (cont, Pgenval); (cont_tail, Pgenval)]
+      ~return:Pgenval ~attr:default_function_attribute ~loc:Loc_unknown ~body
+  in
+  let (body_fun, arg) =
+    match transl_exp ~scopes body with
+    | Lapply { ap_func = fn; ap_args = [arg]; _ }
+        when is_evaluated fn && is_evaluated arg -> (fn, arg)
+    | body ->
+       let param = Ident.create_local "param" in
+       (lfunction ~kind:Curried ~params:[param, Pgenval] ~return:Pgenval
+                  ~attr:default_function_attribute ~loc:Loc_unknown
+                  ~body,
+        Lconst(Const_base(Const_int 0)))
+  in
+  let alloc_stack =
+    Lprim(prim_alloc_stack, [val_fun; exn_fun; eff_fun], Loc_unknown)
+  in
+  Lprim(Prunstack, [alloc_stack; body_fun; arg],
+        of_location ~scopes e.exp_loc)
+
 and transl_letop ~scopes loc env let_ ands param case partial =
   let rec loop prev_lam = function
     | [] -> prev_lam
@@ -1221,9 +1313,9 @@ let transl_let rec_flag pat_expr_list body =
 
 (* Error report *)
 
-open Format
+open Format_doc
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Free_super_var ->
       fprintf ppf
         "Ancestor names can only be used to select inherited methods"
@@ -1234,7 +1326,9 @@ let () =
   Location.register_error_of_exn
     (function
       | Error (loc, err) ->
-          Some (Location.error_of_printer ~loc report_error err)
+          Some (Location.error_of_printer ~loc report_error_doc err)
       | _ ->
         None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/lambda/translcore.mli b/lambda/translcore.mli
index dce2d2750dd66b5d073097ebfb394d0a94cd2c12..7c119d9856065501396eb0eb65db2639909170b9 100644 (file)
--- a/lambda/translcore.mli
+++ b/lambda/translcore.mli
@@ -45,9 +45,8 @@ type error =
 
 exception Error of Location.t * error
 
-open Format
-
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
 
 (* Forward declaration -- to be filled in by Translmod.transl_module *)
 val transl_module :

diff --git a/lambda/translmod.ml b/lambda/translmod.ml
index 31884a137a0c8e2eb9dfd6b9977d4a7d790a8e22..5b0092c9aca50126f45d11406f0134689e9c07eb 100644 (file)
--- a/lambda/translmod.ml
+++ b/lambda/translmod.ml
@@ -1657,14 +1657,14 @@ let transl_store_package component_names target_name coercion =
 
 (* Error report *)
 
-open Format
+open Format_doc
 module Style = Misc.Style
 
 let print_cycle ppf cycle =
-  let print_ident ppf (x,_) = Format.pp_print_string ppf (Ident.name x) in
+  let print_ident ppf (x,_) = pp_print_string ppf (Ident.name x) in
   let pp_sep ppf () = fprintf ppf "@ -> " in
-  Format.fprintf ppf "%a%a%s"
-    (Format.pp_print_list ~pp_sep print_ident) cycle
+  fprintf ppf "%a%a%s"
+    (pp_print_list ~pp_sep print_ident) cycle
     pp_sep ()
     (Ident.name @@ fst @@ List.hd cycle)
 (* we repeat the first element to make the cycle more apparent *)
@@ -1674,7 +1674,7 @@ let explanation_submsg (id, unsafe_info) =
   | Unnamed -> assert false (* can't be part of a cycle. *)
   | Unsafe {reason;loc;subid} ->
       let print fmt =
-        let printer = Format.dprintf fmt
+        let printer = doc_printf fmt
             Style.inline_code (Ident.name id)
             Style.inline_code (Ident.name subid) in
         Location.mkloc printer loc in

diff --git a/lambda/translobj.ml b/lambda/translobj.ml
index 15d300067255c82f0c5be550bc4e7b48c20c61e7..e094503839bc96cfb8ea73b6707315a1e2867afc 100644 (file)
--- a/lambda/translobj.ml
+++ b/lambda/translobj.ml
@@ -84,7 +84,7 @@ let reset_labels () =
 let int n = Lconst (Const_base (Const_int n))
 
 let prim_makearray =
-  Primitive.simple ~name:"caml_make_vect" ~arity:2 ~alloc:true
+  Primitive.simple ~name:"caml_array_make" ~arity:2 ~alloc:true
 
 (* Also use it for required globals *)
 let transl_label_init_general f =

diff --git a/lambda/translprim.ml b/lambda/translprim.ml
index 88ad5cb7d4df23351cfb7d7d5d13fb598e4ed472..df46ea3a44af00be9244f0ace450b8a4f3d562c2 100644 (file)
--- a/lambda/translprim.ml
+++ b/lambda/translprim.ml
@@ -374,6 +374,7 @@ let primitives_table =
     "%perform", Primitive (Pperform, 1);
     "%resume", Primitive (Presume, 4);
     "%dls_get", Primitive (Pdls_get, 1);
+    "%poll", Primitive (Ppoll, 1);
   ]
 
 
@@ -645,7 +646,7 @@ let lambda_of_loc kind sloc =
   | Loc_FILE -> Lconst (Const_immstring file)
   | Loc_MODULE ->
     let filename = Filename.basename file in
-    let name = Env.get_unit_name () in
+    let name = Env.get_current_unit_name () in
     let module_name = if name = "" then "//"^filename^"//" else name in
     Lconst (Const_immstring module_name)
   | Loc_LOC ->
@@ -813,7 +814,7 @@ let lambda_primitive_needs_event_after = function
   | Pbigstring_load_16 _ | Pbigstring_load_32 _ | Pbigstring_load_64 _
   | Pbigstring_set_16 _ | Pbigstring_set_32 _ | Pbigstring_set_64 _
   | Prunstack | Pperform | Preperform | Presume
-  | Pbbswap _ -> true
+  | Pbbswap _ | Ppoll -> true
 
   | Pbytes_to_string | Pbytes_of_string | Pignore | Psetglobal _
   | Pgetglobal _ | Pmakeblock _ | Pfield _ | Pfield_computed | Psetfield _
@@ -869,10 +870,10 @@ let transl_primitive_application loc p env ty path exp args arg_exps =
 
 (* Error report *)
 
-open Format
+open Format_doc
 module Style = Misc.Style
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Unknown_builtin_primitive prim_name ->
       fprintf ppf "Unknown builtin primitive %a" Style.inline_code prim_name
   | Wrong_arity_builtin_primitive prim_name ->
@@ -883,7 +884,9 @@ let () =
   Location.register_error_of_exn
     (function
       | Error (loc, err) ->
-          Some (Location.error_of_printer ~loc report_error err)
+          Some (Location.error_of_printer ~loc report_error_doc err)
       | _ ->
         None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/lambda/translprim.mli b/lambda/translprim.mli
index aa4370141f68f5be42836246be3906fbeb7c4c90..5c288e358dd26d3c0e8691556bc24709769ea072 100644 (file)
--- a/lambda/translprim.mli
+++ b/lambda/translprim.mli
@@ -49,6 +49,5 @@ type error =
 
 exception Error of Location.t * error
 
-open Format
-
-val report_error : formatter -> error -> unit
+val report_error :  error Format_doc.format_printer
+val report_error_doc:  error Format_doc.printer

diff --git a/lambda/value_rec_compiler.ml b/lambda/value_rec_compiler.ml
index ec1812743ea7f68a5564ed83443a31d421ecec92..a240a7805e229a289d8ef2e431f5da86586193a6 100644 (file)
--- a/lambda/value_rec_compiler.ml
+++ b/lambda/value_rec_compiler.ml
@@ -197,11 +197,12 @@ let compute_static_size lam =
     | Pbytes_set_64 _
     | Pbigstring_set_16 _
     | Pbigstring_set_32 _
-    | Pbigstring_set_64 _ ->
+    | Pbigstring_set_64 _
+    | Ppoll ->
         (* Unit-returning primitives. Most of these are only generated from
            external declarations and not special-cased by [Value_rec_check],
            but it doesn't hurt to be consistent. *)
-        Constant
+      Constant
 
     | Pduprecord (repres, size) ->
         begin match repres with

diff --git a/lex/lexer.mll b/lex/lexer.mll
index ca6f17071310ec18b0981f4d62ee5471ef9084d2..7ad0d57e6dec39f28e117e5bd2ae919019ebb9a5 100644 (file)
--- a/lex/lexer.mll
+++ b/lex/lexer.mll
@@ -21,11 +21,6 @@ open Parser
 
 (* Auxiliaries for the lexical analyzer *)
 
-let brace_depth = ref 0
-and comment_depth = ref 0
-
-let in_pattern () = !brace_depth = 0 && !comment_depth = 0
-
 exception Lexical_error of string * string * int * int
 
 let string_buff = Buffer.create 256
@@ -52,14 +47,14 @@ let raise_lexical_error lexbuf msg =
                         p.Lexing.pos_lnum,
                         p.Lexing.pos_cnum - p.Lexing.pos_bol + 1))
 
-let handle_lexical_error fn lexbuf =
+let handle_lexical_error fn arg lexbuf =
   let p = Lexing.lexeme_start_p lexbuf in
   let line = p.Lexing.pos_lnum
   and column = p.Lexing.pos_cnum - p.Lexing.pos_bol + 1
   and file = p.Lexing.pos_fname
   in
   try
-    fn lexbuf
+    fn arg lexbuf
   with Lexical_error (msg, "", 0, 0) ->
     raise(Lexical_error(msg, file, line, column))
 
@@ -115,6 +110,7 @@ let update_loc lexbuf opt_file line =
     Lexing.pos_bol = pos.Lexing.pos_cnum;
   }
 
+type string_context = Pattern | Action | Comment
 }
 
 let identstart =
@@ -129,6 +125,15 @@ let ident = identstart identbody*
 let extattrident = ident ('.' ident)*
 let blank = [' ' '\009' '\012']
 
+let uppercase = ['A'-'Z']
+let ocaml_identstart = lowercase | uppercase
+let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
+let utf8 = ['\192'-'\255'] ['\128'-'\191']*
+let identstart_ext = ocaml_identstart | utf8
+let identchar_ext = identchar | utf8
+let ocaml_ident = identstart_ext identchar_ext*
+
+
 rule main = parse
     [' ' '\013' '\009' '\012' ] +
     { main lexbuf }
@@ -142,8 +147,7 @@ rule main = parse
       main lexbuf
     }
   | "(*"
-    { comment_depth := 1;
-      handle_lexical_error comment lexbuf;
+    { handle_lexical_error comment 0 lexbuf;
       main lexbuf }
   | '_' { Tunderscore }
   | ident
@@ -159,7 +163,7 @@ rule main = parse
       | s -> Tident s }
   | '"'
     { reset_string_buffer();
-      handle_lexical_error string lexbuf;
+      handle_lexical_error string Pattern lexbuf;
       Tstring(get_stored_string()) }
 (* note: ''' is a valid character literal (by contrast with the compiler) *)
   | "'" [^ '\\'] "'"
@@ -188,8 +192,7 @@ rule main = parse
       let n1 = p.Lexing.pos_cnum
       and l1 = p.Lexing.pos_lnum
       and s1 = p.Lexing.pos_bol in
-      brace_depth := 1;
-      let n2 = handle_lexical_error action lexbuf in
+      let n2 = handle_lexical_error action [] lexbuf in
       Taction({loc_file = f; start_pos = n1; end_pos = n2;
                start_line = l1; start_col = n1 - s1}) }
   | '='  { Tequal }
@@ -212,59 +215,59 @@ rule main = parse
 
 
 (* String parsing comes from the compiler lexer *)
-and string = parse
+and string in_pattern = parse
     '"'
     { () }
   | '\\' ('\013'* '\010') ([' ' '\009'] * as spaces)
     { incr_loc lexbuf (String.length spaces);
-      string lexbuf }
+      string in_pattern lexbuf }
   | '\\' (backslash_escapes as c)
     { store_string_char(char_for_backslash c);
-      string lexbuf }
+      string in_pattern lexbuf }
   | '\\' (['0'-'9'] as c) (['0'-'9'] as d) (['0'-'9']  as u)
     { let v = decimal_code c d u in
-      if in_pattern () then
+      if in_pattern = Pattern then
         if v > 255 then
           raise_lexical_error lexbuf
             (Printf.sprintf
               "illegal backslash escape in string: '\\%c%c%c'" c d u)
         else
           store_string_char (Char.chr v);
-      string lexbuf }
+      string in_pattern lexbuf }
   | '\\' 'o' (['0'-'3'] as c) (['0'-'7'] as d) (['0'-'7'] as u)
     { store_string_char (char_for_octal_code c d u);
-      string lexbuf }
+      string in_pattern lexbuf }
   | '\\' 'x' (['0'-'9' 'a'-'f' 'A'-'F'] as d) (['0'-'9' 'a'-'f' 'A'-'F'] as u)
     { store_string_char (char_for_hexadecimal_code d u) ;
-      string lexbuf }
+      string in_pattern lexbuf }
   | '\\' 'u' '{' (['0'-'9' 'a'-'f' 'A'-'F'] + as s) '}'
     { let v = hexadecimal_code s in
-      if in_pattern () then
+      if in_pattern = Pattern then
         if not (Uchar.is_valid v) then
           raise_lexical_error lexbuf
             (Printf.sprintf
               "illegal uchar escape in string: '\\u{%s}'" s)
         else
           store_string_uchar (Uchar.unsafe_of_int v);
-      string lexbuf }
+      string in_pattern lexbuf }
   | '\\' (_ as c)
-    {if in_pattern () then
-       warning lexbuf
-        (Printf.sprintf "illegal backslash escape in string: '\\%c'" c) ;
+    { if in_pattern = Pattern then
+        warning lexbuf
+          (Printf.sprintf "illegal backslash escape in string: '\\%c'" c) ;
       store_string_char '\\' ;
       store_string_char c ;
-      string lexbuf }
+      string in_pattern lexbuf }
   | eof
     { raise(Lexical_error("unterminated string", "", 0, 0)) }
   | '\013'* '\010' as s
-    { if !comment_depth = 0 then
+    { if in_pattern <> Comment then
         warning lexbuf (Printf.sprintf "unescaped newline in string") ;
       store_string_chars s;
       incr_loc lexbuf 0;
-      string lexbuf }
+      string in_pattern lexbuf }
   | _ as c
     { store_string_char c;
-      string lexbuf }
+      string in_pattern lexbuf }
 
 and quoted_string delim = parse
   | '\013'* '\010'
@@ -284,64 +287,65 @@ and quoted_string delim = parse
    in order not to be confused by what is inside them.
 *)
 
-and comment = parse
-    "(*"
-    { incr comment_depth; comment lexbuf }
-  | "*)"
-    { decr comment_depth;
-      if !comment_depth = 0 then () else comment lexbuf }
+and comment depth = parse
+    "(*" { comment (depth + 1) lexbuf }
+  | "*)" { if depth > 0 then comment (depth - 1) lexbuf }
   | '"'
     { reset_string_buffer();
-      string lexbuf;
+      string Comment lexbuf;
       reset_string_buffer();
-      comment lexbuf }
+      comment depth lexbuf }
   | '{' ('%' '%'? extattrident blank*)? (lowercase* as delim) "|"
     { quoted_string delim lexbuf;
-      comment lexbuf }
+      comment depth lexbuf }
   | "'"
     { skip_char lexbuf ;
-      comment lexbuf }
+      comment depth lexbuf }
   | eof
     { raise(Lexical_error("unterminated comment", "", 0, 0)) }
   | '\010'
     { incr_loc lexbuf 0;
-      comment lexbuf }
-  | ident
-    { comment lexbuf }
+      comment depth lexbuf }
+  | ocaml_ident
+    { comment depth lexbuf }
   | _
-    { comment lexbuf }
-
-and action = parse
-    '{'
-    { incr brace_depth;
-      action lexbuf }
+    { comment depth lexbuf }
+
+and action stk = parse
+  | '(' { action ('(' :: stk) lexbuf }
+  | '{' { action ('{' :: stk) lexbuf }
+  | ')'
+    { match stk with
+      | '(' :: stk' -> action stk' lexbuf
+      | _ -> raise_lexical_error lexbuf "Unmatched ) in action" }
   | '}'
-    { decr brace_depth;
-      if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf }
+    { match stk with
+      | [] -> Lexing.lexeme_start lexbuf
+      | '{' :: stk' -> action stk' lexbuf
+      | _ -> raise_lexical_error lexbuf "Unmatched } in action" }
   | '"'
     { reset_string_buffer();
-      handle_lexical_error string lexbuf;
+      handle_lexical_error string Action lexbuf;
       reset_string_buffer();
-      action lexbuf }
+      action stk lexbuf }
   | '{' ('%' '%'? extattrident blank*)? (lowercase* as delim) "|"
     { quoted_string delim lexbuf;
-      action lexbuf }
+      action stk lexbuf }
   | "'"
     { skip_char lexbuf ;
-      action lexbuf }
+      action stk lexbuf }
   | "(*"
-    { comment_depth := 1;
-      comment lexbuf;
-      action lexbuf }
+    { comment 0 lexbuf;
+      action stk lexbuf }
   | eof
     { raise (Lexical_error("unterminated action", "", 0, 0)) }
   | '\010'
     { incr_loc lexbuf 0;
-      action lexbuf }
-  | ident
-    { action lexbuf }
+      action stk lexbuf }
+  | ocaml_ident
+    { action stk lexbuf }
   | _
-    { action lexbuf }
+    { action stk lexbuf }
 
 and skip_char = parse
   | '\\'? ('\013'* '\010') "'"

diff --git a/lex/main.ml b/lex/main.ml
index 6197f95acf6b10bdeb4514e60f1fce9de6a83dc3..8b817ce961d430d1acff2ccd09023230c50dc668 100644 (file)
--- a/lex/main.ml
+++ b/lex/main.ml
@@ -21,7 +21,7 @@ let ml_automata = ref false
 let source_name = ref None
 let output_name = ref None
 
-let usage = "usage: ocamllex [options] sourcefile"
+let usage = "Usage: ocamllex [options] sourcefile\nOptions are:"
 
 let print_version_string () =
   print_string "The OCaml lexer generator, version ";

diff --git a/lex/outputbis.ml b/lex/outputbis.ml
index 97740b04f41b230a1388c8c09f1a19eeac3c5605..d18a9d71f253b5460e96ad4d2452becdd19e13e8 100644 (file)
--- a/lex/outputbis.ml
+++ b/lex/outputbis.ml
@@ -29,55 +29,57 @@ type ctx = {
 let pr ctx = fprintf ctx.oc
 
 let output_auto_defs ctx =
-  if ctx.has_refill then begin
-    pr ctx "\n";
-    pr ctx "let rec __ocaml_lex_refill_buf lexbuf _buf _len _curr _last \
-                                           _last_action state k =\n";
-    pr ctx "  if lexbuf.Lexing.lex_eof_reached then\n";
-    pr ctx "    state lexbuf _last_action _buf _len _curr _last k 256\n";
-    pr ctx "  else begin\n";
-    pr ctx "    lexbuf.Lexing.lex_curr_pos <- _curr;\n";
-    pr ctx "    lexbuf.Lexing.lex_last_pos <- _last;\n";
-    pr ctx "    __ocaml_lex_refill\n";
-    pr ctx "      (fun lexbuf ->\n";
-    pr ctx "        let _curr = lexbuf.Lexing.lex_curr_pos in\n";
-    pr ctx "        let _last = lexbuf.Lexing.lex_last_pos in\n";
-    pr ctx "        let _len = lexbuf.Lexing.lex_buffer_len in\n";
-    pr ctx "        let _buf = lexbuf.Lexing.lex_buffer in\n";
-    pr ctx "        if _curr < _len then\n";
-    pr ctx "          state lexbuf _last_action _buf _len (_curr + 1) \
-                            _last k\n";
-    pr ctx "            (Char.code (Bytes.unsafe_get _buf _curr))\n";
-    pr ctx "        else\n";
-    pr ctx "          __ocaml_lex_refill_buf lexbuf _buf _len _curr _last \
-                                             _last_action\n";
-    pr ctx "            state k\n";
-    pr ctx "      )\n";
-    pr ctx "      lexbuf\n";
-    pr ctx "  end\n";
-    pr ctx "\n";
-  end else begin
-    pr ctx "\n";
-    pr ctx "let rec __ocaml_lex_refill_buf lexbuf _buf _len _curr _last =\n";
-    pr ctx "  if lexbuf.Lexing.lex_eof_reached then\n";
-    pr ctx "    256, _buf, _len, _curr, _last\n";
-    pr ctx "  else begin\n";
-    pr ctx "    lexbuf.Lexing.lex_curr_pos <- _curr;\n";
-    pr ctx "    lexbuf.Lexing.lex_last_pos <- _last;\n";
-    pr ctx "    lexbuf.Lexing.refill_buff lexbuf;\n";
-    pr ctx "    let _curr = lexbuf.Lexing.lex_curr_pos in\n";
-    pr ctx "    let _last = lexbuf.Lexing.lex_last_pos in\n";
-    pr ctx "    let _len = lexbuf.Lexing.lex_buffer_len in\n";
-    pr ctx "    let _buf = lexbuf.Lexing.lex_buffer in\n";
-    pr ctx "    if _curr < _len then\n";
-    pr ctx "      Char.code (Bytes.unsafe_get _buf _curr), _buf, _len, \
-                            (_curr + 1), _last\n";
-    pr ctx "    else\n";
-    pr ctx "      __ocaml_lex_refill_buf lexbuf _buf _len _curr _last\n";
-    pr ctx "  end\n";
-    pr ctx "\n";
+  if ctx.has_refill then
+    pr ctx
+{|
+let rec __ocaml_lex_refill_buf lexbuf _buf _len _curr _last
+                                           _last_action state k =
+  if lexbuf.Lexing.lex_eof_reached then
+    state lexbuf _last_action _buf _len _curr _last k 256
+  else begin
+    lexbuf.Lexing.lex_curr_pos <- _curr;
+    lexbuf.Lexing.lex_last_pos <- _last;
+    __ocaml_lex_refill
+      (fun lexbuf ->
+        let _curr = lexbuf.Lexing.lex_curr_pos in
+        let _last = lexbuf.Lexing.lex_last_pos in
+        let _len = lexbuf.Lexing.lex_buffer_len in
+        let _buf = lexbuf.Lexing.lex_buffer in
+        if _curr < _len then
+          state lexbuf _last_action _buf _len (_curr + 1) _last k
+            (Char.code (Bytes.unsafe_get _buf _curr))
+        else
+          __ocaml_lex_refill_buf lexbuf _buf _len _curr _last
+                                             _last_action
+            state k
+      )
+      lexbuf
+  end
+
+|}
+  else
+    pr ctx
+{|
+let rec __ocaml_lex_refill_buf lexbuf _buf _len _curr _last =
+  if lexbuf.Lexing.lex_eof_reached then
+    256, _buf, _len, _curr, _last
+  else begin
+    lexbuf.Lexing.lex_curr_pos <- _curr;
+    lexbuf.Lexing.lex_last_pos <- _last;
+    lexbuf.Lexing.refill_buff lexbuf;
+    let _curr = lexbuf.Lexing.lex_curr_pos in
+    let _last = lexbuf.Lexing.lex_last_pos in
+    let _len = lexbuf.Lexing.lex_buffer_len in
+    let _buf = lexbuf.Lexing.lex_buffer in
+    if _curr < _len then
+      Char.code (Bytes.unsafe_get _buf _curr), _buf, _len,
+                            (_curr + 1), _last
+    else
+      __ocaml_lex_refill_buf lexbuf _buf _len _curr _last
   end
 
+|}
+
 let output_memory_actions pref oc = function
   | []  -> ()
   | mvs ->
@@ -116,10 +118,12 @@ let output_action ctx pref mems r =
   output_memory_actions pref ctx.oc mems;
   match r with
   | Backtrack ->
-      pr ctx "%slet _curr = _last in\n\
-              %slexbuf.Lexing.lex_curr_pos <- _curr;\n\
-              %slexbuf.Lexing.lex_last_pos <- _last;\n"
-        pref pref pref;
+      pr ctx
+{|
+%slet _curr = _last in
+%slexbuf.Lexing.lex_curr_pos <- _curr;
+%slexbuf.Lexing.lex_last_pos <- _last;
+|} pref pref pref;
       if ctx.has_refill then
         pr ctx "%sk lexbuf %s\n" pref (last_action ctx)
       else
@@ -196,9 +200,12 @@ let output_tag_actions pref ctx mvs =
 let output_trans_body pref ctx = function
   | Perform (n,mvs) ->
       output_tag_actions pref ctx mvs ;
-      pr ctx "%slexbuf.Lexing.lex_curr_pos <- _curr;\n" pref;
-      pr ctx "%slexbuf.Lexing.lex_last_pos <- _last;\n" pref;
-      pr ctx "%s%s%d\n" pref (if ctx.has_refill then "k lexbuf " else "") n
+      pr ctx
+{|
+%slexbuf.Lexing.lex_curr_pos <- _curr;
+%slexbuf.Lexing.lex_last_pos <- _last;
+%s%s%d
+|} pref pref pref (if ctx.has_refill then "k lexbuf " else "") n
   | Shift (trans, move) ->
       let ctx =
         match trans with
@@ -222,25 +229,29 @@ let output_trans_body pref ctx = function
           "%slet state lexbuf _last_action _buf _len _curr _last k = function\n"
           pref;
         output_moves ctx pref move;
-        pr ctx "%sin\n\
-                %sif _curr >= _len then\n\
-                %s  __ocaml_lex_refill_buf lexbuf _buf _len _curr _last \
-                                                  _last_action state k\n\
-                %selse\n\
-                %s  state lexbuf _last_action _buf _len (_curr + 1) _last k\n\
-                %s    (Char.code (Bytes.unsafe_get _buf _curr))\n"
-        pref pref pref pref pref pref
+        pr ctx
+{|
+%sin
+%sif _curr >= _len then
+%s  __ocaml_lex_refill_buf lexbuf _buf _len _curr _last
+                                                  _last_action state k
+%selse
+%s  state lexbuf _last_action _buf _len (_curr + 1) _last k
+%s    (Char.code (Bytes.unsafe_get _buf _curr))
+|} pref pref pref pref pref pref
       end
       else begin
-        pr ctx "%slet next_char, _buf, _len, _curr, _last =\n\
-                %s  if _curr >= _len then\n\
-                %s    __ocaml_lex_refill_buf lexbuf _buf _len _curr _last\n\
-                %s  else\n\
-                %s    Char.code (Bytes.unsafe_get _buf _curr),\n\
-                %s    _buf, _len, (_curr + 1), _last\n\
-                %sin\n\
-                %sbegin match next_char with\n"
-          pref pref pref pref pref pref pref pref;
+        pr ctx
+{|
+%slet next_char, _buf, _len, _curr, _last =
+%s  if _curr >= _len then
+%s    __ocaml_lex_refill_buf lexbuf _buf _len _curr _last
+%s  else
+%s    Char.code (Bytes.unsafe_get _buf _curr),
+%s    _buf, _len, (_curr + 1), _last
+%sin
+%sbegin match next_char with
+|} pref pref pref pref pref pref pref pref;
         output_moves ctx (pref ^ "  ") move;
         pr ctx "%send\n" pref
       end
@@ -269,26 +280,31 @@ let output_init ctx pref e init_moves =
   if e.auto_mem_size > 0 then
     pr ctx "%slexbuf.Lexing.lex_mem <- Array.make %d (-1);\n"
       pref e.auto_mem_size;
-  pr ctx "%slet _curr = lexbuf.Lexing.lex_curr_pos in\n" pref;
-  pr ctx "%slet _last = _curr in\n" pref;
-  pr ctx "%slet _len = lexbuf.Lexing.lex_buffer_len in\n" pref;
-  pr ctx "%slet _buf = lexbuf.Lexing.lex_buffer in\n" pref;
-  pr ctx "%slet _last_action = -1 in\n" pref;
-  pr ctx "%slexbuf.Lexing.lex_start_pos <- _curr;\n" pref;
+  pr ctx
+{|
+%slet _curr = lexbuf.Lexing.lex_curr_pos in
+%slet _last = _curr in
+%slet _len = lexbuf.Lexing.lex_buffer_len in
+%slet _buf = lexbuf.Lexing.lex_buffer in
+%slet _last_action = -1 in
+%slexbuf.Lexing.lex_start_pos <- _curr;
+|} pref pref pref pref pref pref;
   output_memory_actions pref ctx.oc init_moves
 
 let output_rules ic ctx pref tr e =
-  pr ctx "%sbegin\n" pref;
-  pr ctx "%s  let _curr_p = lexbuf.Lexing.lex_curr_p in\n" pref;
-  pr ctx "%s  if _curr_p != Lexing.dummy_pos then begin\n" pref;
-  pr ctx "%s    lexbuf.Lexing.lex_start_p <- _curr_p;\n" pref;
-  pr ctx "%s    lexbuf.Lexing.lex_curr_p <-\n" pref;
-  pr ctx "%s      {_curr_p with Lexing.pos_cnum =\n" pref;
-  pr ctx "%s       lexbuf.Lexing.lex_abs_pos+lexbuf.Lexing.lex_curr_pos}\n"
-         pref;
-  pr ctx "%s  end\n" pref;
-  pr ctx "%send;\n" pref;
-  pr ctx "%smatch __ocaml_lex_result with\n" pref;
+  pr ctx
+{|
+%sbegin
+%s  let _curr_p = lexbuf.Lexing.lex_curr_p in
+%s  if _curr_p != Lexing.dummy_pos then begin
+%s    lexbuf.Lexing.lex_start_p <- _curr_p;
+%s    lexbuf.Lexing.lex_curr_p <-
+%s      {_curr_p with Lexing.pos_cnum =
+%s       lexbuf.Lexing.lex_abs_pos+lexbuf.Lexing.lex_curr_pos}
+%s  end
+%send;
+%smatch __ocaml_lex_result with
+|} pref pref pref pref pref pref pref pref pref pref;
   List.iter
     (fun (num, env, loc) ->
       pr ctx "%s| %d ->\n" pref num;

diff --git a/man/ocamlc.1 b/man/ocamlc.1
index 853d909b08c0af593f92bf4293a3ab3e73de0463..f503e948c79b7774093edd06c50b9c78e39921c0 100644 (file)
--- a/man/ocamlc.1
+++ b/man/ocamlc.1
@@ -453,6 +453,22 @@ Keep documentation strings in generated .cmi files.
 .TP
 .B \-keep-locs
 Keep locations in generated .cmi files.
+.TP
+.BI \-keywords " version+list"
+Set keywords according to the
+.IR version+list
+specification.
+
+This specification starts with an optional version number, defining the base
+set of keywords, followed by a
+.IR +
+separated list of additional keywords to add to this base set.
+Without an explicit version number, the base set of keywords is the
+set of keywords in the current version of OCaml.
+Additional keywords that do not match any known keyword in the current
+version of the language trigger an error whenever they are present in the
+source code.
+
 .TP
 .B \-labels
 Labels are not ignored in types, labels may be used in applications,
@@ -600,12 +616,8 @@ Cause the compiler to call the given
 .I command
 as a preprocessor for each source file. The output of
 .I command
-is redirected to
-an intermediate file, which is compiled. If there are no compilation
-errors, the intermediate file is deleted afterwards. The name of this
-file is built from the basename of the source file with the
-extension .ppi for an interface (.mli) file and .ppo for an
-implementation (.ml) file.
+is redirected to an intermediate file, which is compiled. If there are
+no compilation errors, the intermediate file is deleted afterwards.
 .TP
 .BI \-ppx " command"
 After parsing, pipe the abstract syntax tree through the preprocessor
@@ -1186,7 +1198,7 @@ mentioned here corresponds to the empty set.
 
 .IP
 The default setting is
-.BR \-w\ +a\-4\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66..70 .
+.BR \-w\ +a\-4\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66..70-74 .
 Note that warnings
 .BR 5 " and " 10
 are not always triggered, depending on the internals of the type checker.

diff --git a/man/ocamlopt.1 b/man/ocamlopt.1
index 9399060a9ec8740b8e881ca36fd246d3932a04a5..52bed675ef2ac0a1a44f9eb9815fb17da9484756 100644 (file)
--- a/man/ocamlopt.1
+++ b/man/ocamlopt.1
@@ -529,9 +529,8 @@ Cause the compiler to call the given
 .I command
 as a preprocessor for each source file. The output of
 .I command
-is redirected to
-an intermediate file, which is compiled. If there are no compilation
-errors, the intermediate file is deleted afterwards.
+is redirected to an intermediate file, which is compiled. If there are
+no compilation errors, the intermediate file is deleted afterwards.
 .TP
 .BI \-ppx " command"
 After parsing, pipe the abstract syntax tree through the preprocessor

diff --git a/manual/src/Makefile b/manual/src/Makefile
index 12849462c9a0c46c38aa7ae0b580c4ea015815ab..1234a07f63fca47082037c02159b48b15aaaa6d3 100644 (file)
--- a/manual/src/Makefile
+++ b/manual/src/Makefile
@@ -56,7 +56,7 @@ $(DIRS):
 
 pdf: files latex_files | texstuff
        cd texstuff \
-         && TEXINPUTS=$(TEXINPUTS) pdflatex manual.tex
+         && TEXINPUTS=$(TEXINPUTS) lualatex manual.tex
 
 index: | texstuff
        cd texstuff \

diff --git a/manual/src/cmds/comp.etex b/manual/src/cmds/comp.etex
index a99fa7a4582252ced928a8159a1d1295ab4930dd..7ae78a628607f1cbe5280ff96406df4bb5b125c5 100644 (file)
--- a/manual/src/cmds/comp.etex
+++ b/manual/src/cmds/comp.etex
@@ -548,3 +548,102 @@ than store useful information in strings.
  semantics (any branch can be taken) relatively to a specific guard.
  More precisely, it warns when guard uses ``ambiguous'' variables, that are bound
  to different parts of the scrutinees by different sides of a or-pattern.
+
+\subsection{ss:warn74}{Warning 74: Pattern matching degraded to partial.}
+
+The OCaml type-checker performs a totality analysis to distinguish
+matches that are ``total'', all possible input values are handled by
+a clause, from matches that are ``partial'', some values may match none
+of the clause and raise a "Match_failure" exception. Total
+matches generate slightly better code.
+
+There are a few rare situations where this totality analysis can be
+wrong: the type-checker believes the pattern-matching to be total, but
+certain values may try clauses in order and fail to match any of
+them. When the pattern-matching compiler detects that it may be in
+this situation, it conservatively compiles the pattern-matching as
+partial, and emits this warning. In some cases, this conservative
+assumption is necessary (the pattern-matching was partial), and in
+some other cases it is in fact overly conservative (a more
+fine-grained analysis would see that it is in fact total).
+
+This situation happens rarely: the only known case requires matching
+on mutable fields. Moreover, the vast majority of programs will see no
+performance difference at all if it were to happen. For these reasons,
+the warning is disabled by default: we believe that the right approach
+when this situation occurs is to do nothing at all.
+
+However, some expert users might still be interested in finding out
+whether some pattern-matchings in their codebase may be affected by this
+issue, for two reasons:
+\begin{enumerate}
+\item Users may want to reason with certainty about which parts of the
+  code may raise a "Match_failure" exception.
+\item Performance-conscious expert users might want to inspect the
+  "-dlambda" generated code if the affected pattern-matching is in
+  a performance-critical section.
+\end{enumerate}
+
+In the rest of this section we explain the only known situation where
+this pessimization occurs.
+
+\paragraph{Repeated matches in mutable positions}
+
+When a pattern-matching contains patterns on mutable fields, it is
+possible in theory that the value of these fields may be mutated
+concurrently with the matching logic, and this mutation the remaining
+clauses failing to match, even though the pattern-matching appears to be
+total -- it does not raise warning 8.
+
+Consider for example:
+\begin{verbatim}
+let f : bool * bool ref -> unit = function
+| (true, {contents = true}) -> ()
+| (_, r) when (r.contents <- true; false) -> assert false
+| (false, _) -> ()
+| (_, {contents = false}) -> ()
+
+let () = f (true, ref false)
+(* Exception: Match_failure(...) *)
+\end{verbatim}
+The OCaml type-checker performs its totality analysis without
+considering the possibility of concurrent mutations of the scrutinee,
+and it believes that the function "f" is total. The function "f"
+\emph{is} partial due to side-effects on mutable fields.
+
+Note that the following version may also be affected:
+\begin{verbatim}
+let g : bool * bool ref -> unit = function
+| (true, {contents = true}) -> ()
+| (false, _) -> ()
+| (_, {contents = false}) -> ()
+\end{verbatim}
+In this example, there is no "when" guard mutating the scrutinee, but it
+is possible that a data race coming from another domain would mutate the
+second field of the input at exactly the wrong time, resulting in the
+same "Match_failure" behavior. In other words, the function "g"
+\emph{might} be partial in presence of side-effects on mutable fields.
+
+Most patterns with mutable fields are \emph{not} affected by this issue,
+because their mutable field is read only once by the control-flow code
+generated by the pattern-matching compiler. For example, the following
+simplification of our example does \emph{not} suffer from this issue:
+\begin{verbatim}
+let h : bool ref -> unit = function
+| ({contents = true}) -> ()
+| r when (r.contents <- true; false) -> assert false
+| ({contents = false}) -> ()
+\end{verbatim}
+Whether a mutable field will be read once or several times depends on
+the implementation of the pattern-matching compiler, it is not
+a property of the source-level pattern matching.
+
+When the compiler detects that this situation is possible -- that the
+pattern \emph{is} partial or that it \emph{might} be partial as in the
+examples above -- it will raise warning 74 if enabled.
+
+Note: this warning was introduced in OCaml 5.3; earlier versions of the
+OCaml compiler would not warn, and they would not ensure that
+a "Match_failure" case is generated in such cases: they would generate
+(slightly more efficient but) incorrect code that could violate type-
+and memory-safety in the case of concurrent mutation during matching.

diff --git a/manual/src/cmds/debugger.etex b/manual/src/cmds/debugger.etex
index e43d7f79b545619ec7fd0e590ecd29672cfaefa2..3fb7476857f48b60b1e861a962db2f7aeecacbbe 100644 (file)
--- a/manual/src/cmds/debugger.etex
+++ b/manual/src/cmds/debugger.etex
@@ -4,13 +4,9 @@
 This chapter describes the OCaml source-level replay debugger
 "ocamldebug".
 
-\begin{unix} The debugger is available on Unix systems that provide
-BSD sockets.
-\end{unix}
-
-\begin{windows} The debugger is available under the Cygwin port of
-OCaml, but not under the native Win32 ports.
-\end{windows}
+The debugger is available on systems that provide BSD sockets,
+including Windows. Under the native Windows ports, the "replay"
+functions are not enabled.
 
 \section{s:debugger-compilation}{Compiling for debugging}
 

diff --git a/manual/src/cmds/intf-c.etex b/manual/src/cmds/intf-c.etex
index 8b126152304f710e71e304c3a2b707444f1f8ad7..24b2076418155d8d7e6bd84b181719030ca5b2c9 100644 (file)
--- a/manual/src/cmds/intf-c.etex
+++ b/manual/src/cmds/intf-c.etex
@@ -740,7 +740,9 @@ numbered from 0 to $\hbox{"string_length"}(v)-1$.
 \var{v}, with type "const char *".
 This pointer is a valid C string: there is a null byte after the last
 byte in the string. However, OCaml strings can contain embedded null bytes,
-which will confuse the usual C functions over strings.
+which will confuse the usual C functions over strings. The function
+"caml_string_is_c_safe("\var{v}")" returns "true" if the OCaml string \var{v}
+does not contain any embedded null bytes.
 \item "Bytes_val("\var{v}")" returns a pointer to the first byte of the
 byte sequence \var{v}, with type "unsigned char *".
 \item "Double_val("\var{v}")" returns the floating-point number contained in
@@ -893,10 +895,10 @@ with argument \var{s}.
 \end{itemize}
 
 Raising arbitrary exceptions from C is more delicate: the
-exception identifier is dynamically allocated by the OCaml program, and
+exception constructor is dynamically allocated by the OCaml program, and
 therefore must be communicated to the C function using the
 registration facility described below in section~\ref{ss:c-register-exn}.
-Once the exception identifier is recovered in C, the following
+Once the exception constructor is recovered in C, the following
 functions actually raise the exception:
 \begin{itemize}
 \item "caml_raise_constant("\var{id}")" raises the exception \var{id} with
@@ -911,6 +913,13 @@ null-terminated C string, raises the exception \var{id} with a copy of
 the C string \var{s} as argument.
 \end{itemize}
 
+Sometimes, it is necessary to clean-up state and release resources
+before actually raising the exception back into OCaml. To this end,
+alternative functions that return the exception instead of raising it
+directly ("caml_exception_failure", "caml_exception_invalid_argument",
+etc.) are provided. The type "caml_result" represents either an OCaml
+value or an exception; see section~\ref{ss:c-result}.
+
 \section{s:c-gc-harmony}{Living in harmony with the garbage collector}
 
 Unused blocks in the heap are automatically reclaimed by the garbage
@@ -935,6 +944,10 @@ with these parameters as arguments.  If your function has more than 5
 parameters of type "value", use "CAMLparam5" with five of these
 parameters, and use one or more calls to the "CAMLxparam" macros for
 the remaining parameters ("CAMLxparam1" to "CAMLxparam5").
+If the function has an argument "x" which is an array of "value"s
+of length "n", use "CAMLparamN (x, n)" to declare it (or
+"CAMLxparamN (x, n)" if you already have a call to "CAMLparam"
+for some other arguments).
 
 The macros "CAMLreturn", "CAMLreturn0", and "CAMLreturnT" are used to
 replace the C keyword "return"; any function using a "CAMLparam" macro
@@ -1284,25 +1297,25 @@ raise asynchronous exceptions and cause mutations on the OCaml heap
 from the same domain. It is recommended to call it regularly at safe
 points inside long-running non-blocking C code.
 
-The variant \verb"caml_process_pending_actions_exn" is provided, that
-returns the exception instead of raising it directly into OCaml code.
-Its result must be tested using {\tt Is_exception_result}, and
-followed by {\tt Extract_exception} if appropriate. It is typically
-used for clean up before re-raising:
+The function \verb"caml_process_pending_actions_res"
+returns the exception instead of raising it directly into OCaml
+code. This is represented by a different C type, "caml_result" rather
+than "value". The result can be tested using
+"caml_result_is_exception", followed by some cleanup logic, and
+finally "caml_get_value_or_raise" which returns the value (here just
+a unit value, ignored) or raises the exception.
 
 \begin{verbatim}
-    CAMLlocal1(exn);
+    CAMLlocalresult(res);
     ...
-    exn = caml_process_pending_actions_exn();
-    if(Is_exception_result(exn)) {
-      exn = Extract_exception(exn);
+    res = caml_process_pending_actions_res();
+    if(caml_result_is_exception(res)) {
       ...cleanup...
-      caml_raise(exn);
+      (void)caml_get_value_or_raise(res);
     }
 \end{verbatim}
 
-Correct use of exceptional return, in particular in the presence of
-garbage collection, is further detailed in Section~\ref{ss:c-callbacks}.
+For more details on "caml_result", see section~\ref{ss:c-result}.
 
 \section{s:c-intf-example}{A complete example}
 
@@ -1496,40 +1509,127 @@ calls back an OCaml function \var{h} that raises a stray exception, then the
 execution of \var{g} is interrupted and the exception is propagated back
 into \var{f}.
 
-If the C code wishes to catch exceptions escaping the OCaml function,
-it can use the functions "caml_callback_exn", "caml_callback2_exn",
-"caml_callback3_exn", "caml_callbackN_exn".  These functions take the same
-arguments as their non-"_exn" counterparts, but catch escaping
-exceptions and return them to the C code.  The return value \var{v} of the
-"caml_callback*_exn" functions must be tested with the macro
-"Is_exception_result("\var{v}")".  If the macro returns ``false'', no
-exception occurred, and \var{v} is the value returned by the OCaml
-function.  If "Is_exception_result("\var{v}")" returns ``true'',
-an exception escaped, and its value (the exception descriptor) can be
-recovered using "Extract_exception("\var{v}")".
-
-\paragraph{Warning:} If the OCaml function returned with an exception,
-"Extract_exception" should be applied to the exception result prior
-to calling a function that may trigger garbage collection.
-Otherwise, if \var{v} is reachable during garbage collection, the runtime
-can crash since \var{v} does not contain a valid value.
+\subsection{ss:c-result}{"caml_result": resource cleanup on OCaml exceptions}
 
-Example:
-\begin{verbatim}
-    CAMLprim value call_caml_f_ex(value closure, value arg)
-    {
-      CAMLparam2(closure, arg);
-      CAMLlocal2(res, tmp);
-      res = caml_callback_exn(closure, arg);
-      if(Is_exception_result(res)) {
-        res = Extract_exception(res);
-        tmp = caml_alloc(3, 0); /* Safe to allocate: res contains valid value. */
-        ...
-      }
-      CAMLreturn (res);
-    }
+If the OCaml function called with "caml_callback"
+(or "caml_process_pending_actions" as mentioned in
+Section~\ref{ss:c-process-pending-actions}) raises an exception, the
+C caller will be interrupted immediately to return to the closest
+OCaml exception handler. This is often the wrong behavior if the
+C caller needs to run some resource cleanup logic to terminate safely.
+
+The OCaml FFI provides an alternative API to call OCaml code from
+C that returns a value of type "caml_result" instead of
+"value". A C value of type "caml_result" is either an OCaml value
+returned correctly by the OCaml function, or an OCaml exception raised
+by the OCaml function. The C caller can run any cleanup logic before
+re-raising the exception (if any) or continuing the computation.
+
+"caml_result" values can be manipulated using the following functions
+and macros:
+\begin{itemize}
+\item "value caml_get_value_or_raise(caml_result \var{res})"
+  (in "fail.h") returns the value contained in \var{res} or reraises
+  the exception it contains. In particular,
+  "(void)caml_get_value_or_raise(res)" can be used to ignore an OCaml
+  result of type "unit", yet propagate exceptions to the caller.
+
+\item "Result_value(value \var{v})" (in "mlvalues.h") is the result
+  that represents returning the value \var{v}.
+
+\item "Result_exception(value \var{exn})" (in "mlvalues.h") is the
+  result that represents raising the exception \var{exn}.
+
+\item "int caml_result_is_exception(caml_result \var{res})"
+  (in "mlvalues.h") is true if \var{res} represents an exception.
+
+\item The macro "CAMLlocalresult(foo)" (in "memory.h") is the
+  "caml_result" counterpart of "CAMLlocal1": it declares a local
+  variable of type "caml_result", whose content is tracked by the
+  OCaml GC. Just like "CAMLlocal1", it can only be used between
+  a "CAMLparam" macro and "CAMLreturn" or "CAMLreturnT" macros. There
+  is no equivalent of "CAMLlocal2", "CAMLlocal3", etc., but the macro
+  can be used several times.
+\end{itemize}
+
+For convenience, "Result_unit" is defined as "Result_value(Val_unit)".
+
+By convention, result-returning C functions have their name suffixed
+with "_res", for example "caml_callback2_res" and
+"caml_process_pending_actions_res".
+
+Some examples:
+\begin{verbatim}
+#include <caml/mlvalues.h> // for the caml_result type, caml_result_is_exception
+#include <caml/memory.h>   // CAMLlocalresult
+#include <caml/callback.h> // caml_callback_res
+#include <caml/fail.h>     // caml_get_value_or_raise
+#include <caml/alloc.h>    // caml_alloc_2
+
+/* This function calls an OCaml callback,
+   and returns the value or reraises the exception. */
+value logging_callback(value f, value arg) {
+  CAMLparam2(f, arg);
+  CAMLlocalresult(res);
+  printf("Start callback.\n");
+  res = caml_callback_res(f, arg);
+  printf("End callback.\n");
+  CAMLreturn (caml_get_value_or_raise(res));
+}
+
+/* This function assumes that the callback returns
+   a 'unit' value and ignores it -- or reraises
+   its exception. It must be called by C, as it
+   does not return a value, but the caller cannot
+   handle exceptions as they are raised directly. */
+void logging_unit_callback(value f, value arg) {
+  CAMLparam2(f, arg);
+  CAMLlocalresult(res);
+  printf("Start unit callback.\n");
+  res = caml_callback_res(f, arg);
+  printf("End callback.\n");
+  (void)caml_get_value_or_raise(res);
+  CAMLreturn0;
+}
+
+/* This function calls a callback on two arguments in turn,
+   and returns the pair of values;
+   it does not reraise exceptions, but returns a caml_result instead, letting
+   its own C caller perform its own cleanup. */
+caml_result two_callbacks_res(value f, value arg1, value arg2) {
+  CAMLparam3(f, arg1, arg2);
+  CAMLlocalresult(res);
+  CAMLlocal3(v1, v2, pair);
+
+  res = caml_callback_res(f, arg1);
+  // early exit on exception
+  if (caml_result_is_exception(res))
+    CAMLreturnT(caml_result, res);
+  v1 = caml_get_value_or_raise(res);
+
+  res = caml_callback_res(f, arg2);
+  if (caml_result_is_exception(res))
+    CAMLreturnT(caml_result, res);
+  v2 = caml_get_value_or_raise(res);
+
+  // build the pair of values, and
+  // wrap it in a caml_result
+  pair = caml_alloc_2(0, v1, v2);
+  res = Result_value(pair);
+  CAMLreturnT(caml_result, res);
+}
 \end{verbatim}
 
+\paragraph{Compatibility:} The "caml_result" type is available since
+OCaml 5.3. Older versions of OCaml use an unsafe concept of "encoded
+exceptions" (suffix "_exn", operations "Is_exception_result" and
+"Extract_exception") which are of type "value" but are not valid
+OCaml values and can crash the GC if they are not extracted
+immediately by the caller. We strongly recommend using "caml_result"
+instead, to have a clear separation between valid values and reified
+exceptions at distinct C types, but the older approach remains
+available for backwards-compatibility.
+
 \subsection{ss:c-closures}{Obtaining or registering OCaml closures for use in C functions}
 
 There are two ways to obtain OCaml function values (closures) to
@@ -1597,16 +1697,16 @@ calls "caml_named_value" only once:
 \subsection{ss:c-register-exn}{Registering OCaml exceptions for use in C functions}
 
 The registration mechanism described above can also be used to
-communicate exception identifiers from OCaml to C. The OCaml code
-registers the exception by evaluating
+communicate exception constructors from OCaml to C. The OCaml code
+registers the exception constructor by evaluating
 "Callback.register_exception" \var{n} \var{exn}, where \var{n} is an
-arbitrary name and \var{exn} is an exception value of the
-exception to register. For example:
+arbitrary name and \var{exn} is an exception value with the
+exception constructor to register. For example:
 \begin{verbatim}
     exception Error of string
     let _ = Callback.register_exception "test exception" (Error "any string")
 \end{verbatim}
-The C code can then recover the exception identifier using
+The C code can then recover the exception constructor using
 "caml_named_value" and pass it as first argument to the functions
 "raise_constant", "raise_with_arg", and "raise_with_string" (described
 in section~\ref{ss:c-exceptions}) to actually raise the exception. For
@@ -1919,10 +2019,16 @@ To build the whole program, just invoke the C compiler as follows:
 
 \section{s:c-custom}{Advanced topic: custom blocks}
 
-Blocks with tag "Custom_tag" contain both arbitrary user data and a
-pointer to a C struct, with type "struct custom_operations", that
-associates user-provided finalization, comparison, hashing,
-serialization and deserialization functions to this block.
+Blocks with tag "Custom_tag" start with a pointer to a C "struct" with
+type "struct custom_operations" that associates user-provided
+finalization, comparison, hashing, serialization and deserialization
+functions for this block.
+
+After this pointer to custom operations, there can be arbitrary data of
+zero, one or more words whose semantics is defined by the user (for
+example this can be just a pointer to a C "struct" or a C "struct"
+itself). Use "Data_custom_val" on the block value to get a pointer on
+the start of this arbitrary data.
 
 \subsection{ss:c-custom-ops}{The "struct custom_operations"}
 
@@ -1939,6 +2045,11 @@ when the block becomes unreachable and is about to be reclaimed.
 The block is passed as first argument to the function.
 The "finalize" field can also be "custom_finalize_default" to indicate that no
 finalization function is associated with the block.
+Note the caution below: there are many restrictions on the behaviour
+of these custom block finalizers; they must not allocate on the Caml
+heap, or call OCaml code or allow it to be called (for example, they
+should not call "caml_release_runtime_system()"). For more powerful
+and flexible finalization, use "Gc.finalise" (see \stdmoduleref{Gc}).
 
 \item "int (*compare)(value v1, value v2)" \\
 The "compare" field contains a pointer to a C function that is
@@ -2008,8 +2119,8 @@ reading back the data written by the "serialize" operation, using the
 in section~\ref{ss:c-custom-serialization}. It must then rebuild the data part
 of the custom block and store it at the pointer given as the "dst" argument.
 Finally, it returns the size in bytes of the data part of the custom block.
-This size must be identical to the "wsize_32" result of the "serialize"
-operation if the architecture is 32 bits, or "wsize_64" if the architecture is
+This size must be identical to the "bsize_32" result of the "serialize"
+operation if the architecture is 32 bits, or "bsize_64" if the architecture is
 64 bits.
 
 The "deserialize" field can be set to "custom_deserialize_default"
@@ -2028,7 +2139,7 @@ specified in the "fixed_length" structure, and do not consume space in
 the serialized output.
 \end{itemize}
 
-Note: the "finalize", "compare", "hash", "serialize", and "deserialize"
+\emph{Caution}: the "finalize", "compare", "hash", "serialize", and "deserialize"
 functions attached to custom blocks descriptors are only allowed limited
 interactions with the OCaml runtime. Within these functions, do not call any of
 the OCaml allocation functions, and do not perform any callback into OCaml
@@ -2417,7 +2528,7 @@ The corresponding C type must be "intnat".
 It is possible to annotate with "[\@untagged]" any immediate type, i.e. types
 that are represented like "int". This includes "bool", "char", any variant
 type with only constant constructors. Note: this does not include
-"Unix.file_descr" which is not represented as an interger on all platforms.
+"Unix.file_descr" which is not represented as an integer on all platforms.
 
 \subsection{ss:c-direct-call}{Direct C call}
 
@@ -2538,34 +2649,46 @@ C primitive must be copied into C data structures before calling
 must be encoded as OCaml values after "caml_acquire_runtime_system()"
 returns.
 
-Example: the following C primitive invokes "gethostbyname" to find the
-IP address of a host name.  The "gethostbyname" function can block for
-a long time, so we choose to release the OCaml run-time system while it
-is running.
+Example: the following C primitive invokes "rmdir" to delete a
+directory.  The "rmdir" function can block for some time, so we choose
+to release the OCaml run-time system while it is running.
 \begin{verbatim}
-CAMLprim stub_gethostbyname(value vname)
+#include <caml/memory.h>
+#include <caml/threads.h>
+#include <caml/unixsupport.h>
+
+CAMLprim value stub_rmdir(value vpath)
 {
-  CAMLparam1 (vname);
-  CAMLlocal1 (vres);
-  struct hostent * h;
-  char * name;
+  CAMLparam1(vpath);
+
+  /* Raise Unix.Unix_error(Unix.ENOENT, ...) if the OCaml string
+     contains embedded null bytes */
+  caml_unix_check_path(vpath, "rmdir");
 
   /* Copy the string argument to a C string, allocated outside the
      OCaml heap. */
-  name = caml_stat_strdup(String_val(vname));
+  char_os *path = caml_stat_strdup_to_os(String_val(vpath));
   /* Release the OCaml run-time system */
   caml_release_runtime_system();
-  /* Resolve the name */
-  h = gethostbyname(name);
+
+  /* Delete the directory */
+#ifdef _WIN32
+  int ret = _wrmdir(path);
+#else
+  int ret = rmdir(path);
+#endif
+
   /* Free the copy of the string, which we might as well do before
      acquiring the runtime system to benefit from parallelism. */
-  caml_stat_free(name);
+  caml_stat_free(path);
   /* Re-acquire the OCaml run-time system */
   caml_acquire_runtime_system();
-  /* Encode the relevant fields of h as the OCaml value vres */
-  ... /* Omitted */
+
+  /* Raise Unix.Unix_error(...) if rmdir failed */
+  if (ret == -1) caml_uerror("rmdir", vpath);
+
   /* Return to OCaml */
-  CAMLreturn (vres);
+  CAMLreturn(Val_unit);
 }
 \end{verbatim}
 

diff --git a/manual/src/cmds/runtime.etex b/manual/src/cmds/runtime.etex
index 242277e4f77060566c15e10701603df86047bc5e..5f41a2d097b971b6cd9456f886ad64a3b26f1925 100644 (file)
--- a/manual/src/cmds/runtime.etex
+++ b/manual/src/cmds/runtime.etex
@@ -109,8 +109,8 @@ The following environment variables are also consulted:
   A parameter specification is an option letter followed by an "="
   sign, a decimal number (or an hexadecimal number prefixed by "0x"),
   and an optional multiplier.  The options are documented below;
-  the options "a, i, l, m, M, n, o, O, s, v, w" correspond to
-  the fields of the "control" record documented in
+  the options "l, m, M, n, o, s, v" correspond to fields of the "control"
+  record documented in
 \ifouthtml
  \ahref{libref/Gc.html}{Module \texttt{Gc}}.
 \else
@@ -129,6 +129,9 @@ The following environment variables are also consulted:
         "caml_shutdown" in section~\ref{ss:c-embedded-code}). The option also enables
         pooling (as in "caml_startup_pooled"). This mode can be used to detect
         leaks with a third-party memory debugger.
+  \item[d] ("max_domains") Maximum number of domains that can be active
+        concurrently. Defaults to 128 on 64-bit platforms and 16 on 32-bit
+        platforms.
   \item[e] ("runtime_events_log_wsize") Size of the per-domain runtime events ring
         buffers in log powers of two words. Defaults to 16, giving 64k word or
         512kb buffers on 64-bit systems.

diff --git a/manual/src/cmds/tsan.etex b/manual/src/cmds/tsan.etex
index 0a0aa8fec1ebfadc22e0c1166118bc54d3a37afe..74491bb3749e671f9a89f81ee5dd843e5ffd89d1 100644 (file)
--- a/manual/src/cmds/tsan.etex
+++ b/manual/src/cmds/tsan.etex
@@ -206,6 +206,11 @@ necessary to obtain the second stack trace, but it also increases memory
 consumption. This setting does not change the number of memory accesses
 remembered per memory location.
 
+Another useful runtime option is \texttt{exitcode=0}, which still reports data
+races but does not change the exit code. This can be useful if TSan complains
+about data races in programs that you don't care about and the non-zero exit
+code disturbs your workflow.
+
 \section{s:tsan-c-code}{Guidelines for linking}
 
 As a general rule, OCaml programs instrumented with TSan should only be linked

diff --git a/manual/src/cmds/unified-options.etex b/manual/src/cmds/unified-options.etex
index 4e31310c1b1a1c88d75d0fc41b0bff22ca0aee85..96cc29ce3323faea325bc05b774681eba77ea67e 100644 (file)
--- a/manual/src/cmds/unified-options.etex
+++ b/manual/src/cmds/unified-options.etex
@@ -363,6 +363,20 @@ Recognize file names ending with \var{string} as interface files
 (instead of the default ".mli").
 }%\notop
 
+\item["-keywords" \var{version+list}]
+Set keywords according to the \var{version+list}
+specification.
+
+This specification starts with an optional version number, defining the base set
+of keywords, followed by a \var{+}-separated list of additional keywords to add
+to this base set.
+
+Without an explicit version number, the base set of keywords is the
+set of keywords in the current version of OCaml.
+Additional keywords that do not match any known keyword in the current
+version of the language trigger an error whenever they are present in the
+source code.
+
 \item["-labels"]
 Labels are not ignored in types, labels may be used in applications,
 and labelled parameters can be given in any order.  This is the default.
@@ -885,13 +899,33 @@ Print the location of the standard library, then exit.
 
 \notop{%
 \item["-with-runtime"]
-Include the runtime system in the generated program. This is the default.
+The pair of options \texttt{-with-runtime} and \texttt{-without-runtime} give
+precise control over the way the runtime is linked. \texttt{-with-runtime} is
+the default. In summary, it instructs to include the runtime system, or a
+reference to the default path of the runtime system, in the generated
+program/executable/object file. The detailed behaviour depends on the compiler
+and options used:
+
+For ocamlc, in its default linking mode (no use of \texttt{-custom} or
+\texttt{-output-*}), \texttt{-with-runtime} creates a file which can be
+executed, whereas \texttt{-without-runtime} creates a pure bytecode image which
+must be explicitly passed to a runtime (i.e. \texttt{./foo} vs \texttt{ocamlrun
+./foo}).
+
+For all other uses of ocamlc and ocamlopt, \texttt{-with-runtime} and
+\texttt{-without-runtime} control whether the compiler passes flags for linking
+with the installed runtime (\texttt{-with-runtime}) or whether the user is
+required to pass them (\texttt{-without-runtime}).
+
+For more information about the options \texttt{-custom} and \texttt{-output-*},
+see their documentation and section~\ref{ss:c-embedded-code} of the manual.
 }
 
 \notop{%
 \item["-without-runtime"]
 The compiler does not include the runtime system (nor a reference to it) in the
-generated program; it must be supplied separately.
+generated program, executable or object file; it must be supplied separately.
+See option \texttt{-with-runtime} for details.
 }
 
 \item["-" \var{file}]

diff --git a/manual/src/html_processing/Makefile b/manual/src/html_processing/Makefile
index f4e03afa6f499e08cb54bb24ed6d166d1c7c8296..a7f9868a0e19b862a78413e58055642577faff2a 100644 (file)
--- a/manual/src/html_processing/Makefile
+++ b/manual/src/html_processing/Makefile
@@ -1,3 +1,6 @@
+ROOTDIR = ../../..
+include $(ROOTDIR)/Makefile.config_if_required
+
 DUNE_CMD := $(if $(wildcard dune/dune.exe),dune/dune.exe,dune)
 DUNE ?= $(DUNE_CMD)
 
@@ -8,9 +11,11 @@ else
     DBG=quiet
 endif
 
+VERSION := $(OCAML_VERSION_MAJOR).$(OCAML_VERSION_MINOR)
+
 WEBDIR = ../webman
-WEBDIRMAN = $(WEBDIR)/manual
-WEBDIRAPI = $(WEBDIR)/api
+WEBDIRMAN = $(WEBDIR)/$(VERSION)
+WEBDIRAPI = $(WEBDIRMAN)/api
 WEBDIRCOMP = $(WEBDIRAPI)/compilerlibref
 
 # The "all" target generates the Web Manual in the directories
@@ -52,9 +57,6 @@ js: $(JS_FILES)
 
 CURL = curl -s
 # download images for local use
-SEARCH := search_icon.svg
-$(WEBDIRAPI)/search_icon.svg: | $(WEBDIRAPI)
-       $(CURL) "https://ocaml.org/img/search.svg" > $(WEBDIRAPI)/$(SEARCH)
 
 $(WEBDIRCOMP)/%: $(WEBDIRAPI)/% | $(WEBDIRCOMP)
        cp $< $@
@@ -71,9 +73,9 @@ $(WEBDIRAPI)/favicon.ico: | $(WEBDIRAPI) $(WEBDIRMAN) $(WEBDIRCOMP)
        $(CURL) "https://raw.githubusercontent.com/ocaml/ocaml-logo/master/Colour/Favicon/32x32.ico" > $(WEBDIRAPI)/$(ICON)
 
 IMG_FILES0 := colour-logo.svg
-IMG_FILES := $(addprefix $(WEBDIRAPI)/, $(IMG_FILES0)) $(addprefix $(WEBDIRCOMP)/, $(IMG_FILES0)) $(addprefix $(WEBDIRMAN)/, $(IMG_FILES0)) 
+IMG_FILES := $(addprefix $(WEBDIRAPI)/, $(IMG_FILES0)) $(addprefix $(WEBDIRCOMP)/, $(IMG_FILES0)) $(addprefix $(WEBDIRMAN)/, $(IMG_FILES0))
 
-img: $(WEBDIRAPI)/search_icon.svg $(WEBDIRAPI)/favicon.ico $(WEBDIRCOMP)/search_icon.svg $(WEBDIRCOMP)/favicon.ico $(IMG_FILES)
+img: $(WEBDIRAPI)/favicon.ico $(WEBDIRCOMP)/favicon.ico $(IMG_FILES)
 
 clean:
        rm -rf $(WEBDIR) src/.merlin _build

diff --git a/manual/src/html_processing/scss/_common.scss b/manual/src/html_processing/scss/_common.scss
index 8a2268febd4884f70e64193f201f1e1507b678af..99e7795c4acf28a9eabf09ba41506fdd2d1fd646 100644 (file)
--- a/manual/src/html_processing/scss/_common.scss
+++ b/manual/src/html_processing/scss/_common.scss
@@ -110,7 +110,7 @@ html {
     max-width:30ex;
     min-width:26ex;
     width:20%;
-    background:linear-gradient(to left,#ccc,transparent);
+    background-color: #ede8e6;
     overflow:auto;
     color:#1F2D3D;
     padding-left:2ex;
@@ -143,7 +143,8 @@ html {
                display:block;
                &:hover {
                    box-shadow:none;
-                   background-color: #edbf84;}
+                   background-color: white;
+                   text-decoration: underline;}
            }
            &.top a {
                color: #848484;

diff --git a/manual/src/html_processing/scss/manual.scss b/manual/src/html_processing/scss/manual.scss
index ff7145ad92c7877f9b4f87884bd3f15618d93d53..b5ddc9c29bb266400fb4160a070a67618b3a3753 100644 (file)
--- a/manual/src/html_processing/scss/manual.scss
+++ b/manual/src/html_processing/scss/manual.scss
@@ -63,10 +63,10 @@
     section>ul>li>a{ /* for Parts title */
        font-family: $font-sans;
        font-size:larger;
-       background:linear-gradient(to left,#fff 0,#ede8e5 100%);
+       background-color: #ede8e5;
     }
     section>ul>li>ul>li:hover{ /* Chapters */
-       background:linear-gradient(to left,#fff 0,#ede8e5 100%);
+       background-color: #ede8e5;
     }
     section>ul>li>ul>li{       
        transition: background 0.5s;
@@ -115,8 +115,7 @@ a:hover{
     box-shadow:0 1px 0 0 #92370a
 }
 :target{
-    background-color:rgba(255,215,181,.3)!important;
-    box-shadow: inset 0 0 0 1px rgba(255,215,181,.8)!important;
+    background-color:#ffd6b5!important;
 }
 :hover>a.section-anchor{
     visibility:visible
@@ -190,7 +189,6 @@ h2, h3, h4, h5 {
     font-weight:400
 }
 .pre,pre{
-    border-left:4px solid #e69c7f;
     overflow-x:auto;
     padding-left:1ex
 }
@@ -214,6 +212,7 @@ p a>code{
 .pre code.ocaml,.pre.code.ocaml,pre code.ocaml{
     font-size:.893rem}
 .keyword,.ocamlkeyword{
+    font-family: $font-sans;
     font-weight:500}
 section+section{
     margin-top:25px}
@@ -247,7 +246,7 @@ nav.toc{
 }
 
 pre{
-    background:linear-gradient(to left,#fff 0,#ede8e5 100%)
+    background-color: #ede8e5;
 }
 code.caml-output.ok,div.caml-output.ok{
     color:#045804

diff --git a/manual/src/html_processing/scss/style.scss b/manual/src/html_processing/scss/style.scss
index c21dde579d8acd2376826a1c39622fcdfa1652ba..13da934c213d6a19aea0e39712e8d59328fa262a 100644 (file)
--- a/manual/src/html_processing/scss/style.scss
+++ b/manual/src/html_processing/scss/style.scss
@@ -51,7 +51,7 @@
            background: rgb(228, 217, 211);
        }
        /* must be same as <pre>: */
-       background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
+       background-color: #ede8e6;
        width: 100%;
        td {
            padding-left: 1ex;
@@ -108,9 +108,8 @@
     }
     
     .sig_block {
-       border-left: 4px solid #e69c7f;
        padding-left: 1em;
-       background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
+       background-color: #ede8e6;
        // PROBLEM the sig_block ends too soon, it should actually
        // include the "end)" line ==> REPORT THIS
        // (eg: compilerlibref/Arg_helper.html)
@@ -162,7 +161,7 @@
        list-style-position: outside
     }
     ul>li {
-       margin-left: 22px;
+       margin-left: 2rem;
     }
     ol>li {
        margin-left: 27.2px;
@@ -199,7 +198,7 @@
        /*box-shadow: 0 0px 0 1px rgba(255, 215, 181, 0.8) !important;*/
        border-radius: 1px;
        /*border-bottom: 4px solid rgb(255, 215, 181);*/
-       box-shadow: 0 4px 0 0px rgb(255, 215, 181);
+       background-color: #ffd6b5;
        z-index: 0;
        @if $ocamlorg {
            /* Because of fixed banner in the ocaml.org site, we have to offset the targets. See https://stackoverflow.com/questions/10732690/offsetting-an-html-anchor-to-adjust-for-fixed-header */
@@ -321,7 +320,7 @@
     }
 
     pre {
-       border-left: 4px solid #e69c7f;
+       border-top: 1px solid #e69c7f;
        white-space: pre-wrap;
        word-wrap: break-word;
        padding-left: 1ex;
@@ -352,6 +351,7 @@
     /* Code lexemes */
 
     .keyword {
+  font-family: $font-sans;
        font-weight: 500;
        color: inherit;
     }
@@ -711,7 +711,7 @@
        display: inline-block;
     } 
     pre {
-       background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
+       background-color: #ede8e6;
     }
 
     #search_results li.match::before {
@@ -886,7 +886,7 @@
     .search_comment #search_help {
        overflow: hidden;
        font-size: smaller;
-       background: linear-gradient(to bottom, white 0%, rgb(237, 232, 229) 100%);
+       background-color: #ede8e6;
        transition: all 0.5s;
     }
     #help_icon {

diff --git a/manual/src/html_processing/src/common.ml.in b/manual/src/html_processing/src/common.ml.in
index 30bacb837503010bb156f6ab3558dd901099c3ad..a7e8b5570beeb0b624e42c4127acd0e662faca25 100644 (file)
--- a/manual/src/html_processing/src/common.ml.in
+++ b/manual/src/html_processing/src/common.ml.in
@@ -27,21 +27,23 @@ let ( // ) = Filename.concat
 
 let process_dir = Filename.current_dir_name
 
+let ocaml_version = "@OCAML_VERSION_SHORT@"
+
 (* Output directory *)
-let web_dir = Filename.parent_dir_name // "webman"
+let web_dir = Filename.parent_dir_name // "webman" // ocaml_version
 
 (* Output for manual *)
-let docs_maindir = web_dir // "manual"
+let docs_maindir = web_dir
 let docs_file = ( // ) docs_maindir
 
 (* Output for API *)
 let api_dir = web_dir // "api"
 
 (* How to go from manual to api *)
-let api_page_url = "../api"
+let api_page_url = "api"
 
 (* How to go from api to manual *)
- let manual_page_url = "../manual"
+let manual_page_url = ".."
 
 (* Set this to the directory where to find the html sources of all versions: *)
 let html_maindir = "../htmlman"
@@ -94,7 +96,8 @@ let add_favicon head =
          favicon ^ {|">|})
   |> append_child head
 
-(* Update html <head> element with javascript and favicon *)
+(* Update html <head> element with javascript and favicon.
+   Including script.js for OCaml.org's instance of Plausible Analytics. *)
 let update_head ?(search = false) soup =
   let head = soup $ "head" in
   if search then begin
@@ -105,6 +108,8 @@ let update_head ?(search = false) soup =
   |> append_child head;
   create_element "script" ~attributes:["src","navigation.js"]
   |> append_child head;
+  create_element "script" ~attributes:["src", "https://plausible.ci.dev/js/script.js"; "defer data-domain", "ocaml.org"]
+  |> append_child head;
   add_favicon head
 
 (* Add version number *)

diff --git a/manual/src/html_processing/src/process_api.ml b/manual/src/html_processing/src/process_api.ml
index 8a462a4c653dc5e1ff9ad0361f559884f2e78bac..70418dfdd1ae4b191ebf56a5e0f4b717cb48521f 100644 (file)
--- a/manual/src/html_processing/src/process_api.ml
+++ b/manual/src/html_processing/src/process_api.ml
@@ -25,12 +25,12 @@ let search_widget with_description =
   let search_decription = if with_description
     then {|<span class="search_comment">(search values, type signatures, and descriptions - case sensitive)<span id="help_icon" onclick="showHelp()">ⓘ</span><div id="search_help" class="hide"><ul><li>You may search bare values, like <code>map</code>, or indicate the module, like <code>List.map</code>, or type signatures, like <code>int -> float</code>.</li><li>To combine several keywords, just separate them by a space. Quotes can be used to prevent from splitting words at spaces. For instance, <code>int array</code> will search for <code>int</code> and/or <code>array</code>, while <code>"int array"</code> will only list functions whose signature contains the <code>int array</code> type.</li><li>You may use the special chars <code>^</code> and <code>$</code> to indicate where the matched string should start or end, respectively. For instance <code>^zip</code> will not show you the <code>unzip</code> function.</li></ul></div></span>|}
     else "" in
-  sprintf {|<div class="api_search"><input type="text" name="apisearch" id="api_search" class="api_search"
+  sprintf {|<div class="api_search"><input type="search" name="apisearch" id="api_search" class="api_search"
         oninput    = "mySearch(%b);"
          onkeypress = "this.oninput();"
          onclick    = "this.oninput();"
         onpaste    = "this.oninput();">
-<img src="search_icon.svg" alt="Search" class="api_search svg" onclick="mySearch(%b)">%s</div>
+<button onclick="mySearch(%b)" style="cursor:pointer">Search <span aria-hidden="true">🔎</span></button> %s</div>
 <div id="search_results"></div>|} with_description with_description search_decription
   |> parse
 

diff --git a/manual/src/html_processing/src/process_manual.ml b/manual/src/html_processing/src/process_manual.ml
index e06517a97e8c6844ad71743a5e6c189fb1ca574d..95d2a9058166fe162fb80287ad135358123a42b3 100644 (file)
--- a/manual/src/html_processing/src/process_manual.ml
+++ b/manual/src/html_processing/src/process_manual.ml
@@ -429,7 +429,7 @@ let get_xfiles = function
           let rf = li $ "a" |> R.attribute "href" in
           dbg "TOC reference = %s" rf;
           if not (String.contains rf '#') &&
-             not (starts_with ".." rf) &&
+             not (starts_with "api" rf) &&
              not (starts_with "http" rf)
           then begin
             li $ "a" |> set_attribute "href" (rf ^ "#start-section");

diff --git a/manual/src/manual.tex b/manual/src/manual.tex
index 0ad0915e855c32a0279ed7797684c4eb42d8b627..55c5b04bac4fd97d3f02b78518faced8617d2060 100644 (file)
--- a/manual/src/manual.tex
+++ b/manual/src/manual.tex
@@ -1,13 +1,8 @@
 \documentclass[11pt]{book}
-\usepackage{lmodern}% for T1 encoding and support of bold ttfamily
 
-\usepackage[utf8]{inputenc}
-\usepackage[T1]{fontenc}
+% HEVEA\usepackage[utf8]{inputenc}
 \usepackage{microtype}
-% HEVEA\@def@charset{UTF-8}%
-% Unicode character declarations
-\DeclareUnicodeCharacter{207A}{{}^{+}}
-\DeclareUnicodeCharacter{2014}{---}
+\usepackage{fontspec}
 
 \usepackage{fullpage}
 \usepackage{syntaxdef}

diff --git a/manual/src/refman/extensions/effects.etex b/manual/src/refman/extensions/effects.etex
index 80d7d04333a81b60ca8f1f07357f059e923a9d4c..1f4dd48015e7f24e6b30a4ac8084ba243c215874 100644 (file)
--- a/manual/src/refman/extensions/effects.etex
+++ b/manual/src/refman/extensions/effects.etex
@@ -1,12 +1,13 @@
-(Introduced in 5.0)
+(Introduced in 5.0. The syntax support for deep handlers was introduced in
+5.3.)
 
-\textit{Note: Effect handlers in OCaml 5.0 should be considered experimental.
-Effect handlers are exposed in the standard library's \stdmoduleref{Effect}
-module as a thin wrapper around their implementation in the runtime. They are
-not supported as a language feature with new syntax. You can rely on them to
-build non-local control-flow abstractions such as user-level threading that do
-not expose the effect handler primitives to the user. Expect breaking changes
-in the future.}
+
+\begin{syntax}
+pattern:
+      ...
+    | 'effect' pattern, value-name
+;
+\end{syntax}
 
 Effect handlers are a mechanism for modular programming with user-defined
 effects. Effect handlers allow the programmers to describe
@@ -43,40 +44,26 @@ We can handle the "Xchg" effect by implementing a handler that always returns
 the successor of the offered value:
 
 \begin{caml_example}{verbatim}
-try_with comp1 ()
-{ effc = fun (type a) (eff: a t) ->
-    match eff with
-    | Xchg n -> Some (fun (k: (a, _) continuation) ->
-        continue k (n+1))
-    | _ -> None }
+try comp1 () with
+| effect (Xchg n), k -> continue k (n+1)
 \end{caml_example}
 
-"try_with" runs the computation "comp1 ()" under an effect handler that handles
-the "Xchg" effect. As mentioned earlier, effect handlers are a generalization
-of exception handlers. Similar to exception handlers, when the computation
-performs the "Xchg" effect, the control jumps to the corresponding handler.
-However, unlike exception handlers, the handler is also provided with the
-delimited continuation "k", which represents the suspended computation between
-the point of "perform" and this handler.
+We run the computation "comp1 ()" under an effect handler that handles the
+"Xchg" effect with a continuation bound to "k". Here "effect" is a keyword
+which signifies that the "Xchg n" pattern matches effects and not exceptions.
+As mentioned earlier, effect handlers are a generalization of exception
+handlers.  Similar to exception handlers, when the computation performs the
+"Xchg" effect, the control jumps to the corresponding handler, and unhandled
+effects are forwarded to the outer handler. However, unlike exception handlers,
+the handler is also provided with the delimited continuation "k", which
+represents the suspended computation between the point of "perform" and this
+handler.
 
 The handler uses the "continue" primitive to resume the suspended computation
 with the successor of the offered value. In this example, the computation
 "comp1" performs "Xchg 0" and "Xchg 1" and receives the values "1" and "2"
 from the handler respectively. Hence, the whole expression evaluates to "3".
 
-It is useful to note that we must use a locally abstract type "(type a)" in
-the effect handler. The type "Effect.t" is a GADT, and the effect declarations
-may have different type parameters for different effects. The type parameter
-"a" in the type "a Effect.t" represents the type of the value returned when
-performing the effect. From the fact that "eff" has type "a Effect.t" and from
-the fact that "Xchg n" has type "int Effect.t", the type-checker deduces that
-"a" must be "int", which is why we are allowed to pass the integer value "n+1"
-as an argument to "continue k".
-
-Another point to note is that the catch-all case ``"| _ -> None"'' is necessary
-when handling effects. This case may be intuitively read as ``forward the
-unhandled effects to the outer handler''.
-
 In this example, we use the \emph{deep} version of the effect handlers here as
 opposed to the \emph{shallow} version. A deep handler monitors a computation
 until the computation terminates (either normally or via an exception), and
@@ -87,21 +74,6 @@ effect only. In situations where they are applicable, deep handlers are usually
 preferred. An example that utilises shallow handlers is discussed later
 in~\ref{s:effects-shallow}.
 
-\subsubsection{s:effects-limitations}{Limitations}
-
-OCaml's effects are \emph{synchronous}: It is not possible to perform
-an effect asynchronously from a signal handler, a finaliser, a memprof
-callback, or a GC alarm, and catch it from the main part of the code.
-Instead, this would result in an "Effect.Unhandled"
-exception (\ref{s:effects-unhandled}).
-
-Similarly, effects are incompatible with the use of callbacks from C
-to OCaml (section~\ref{s:c-callback}). It is not possible for an
-effect to cross a call to "caml_callback", this would instead result
-in an "Effect.Unhandled" exception. In particular, care must be taken
-when mixing libraries that use callbacks from C to OCaml and libraries
-that use effects.
-
 \subsection{s:effects-concurrency}{Concurrency}
 
 The expressive power of effect handlers comes from the delimited continuation.
@@ -122,47 +94,29 @@ type 'a status =
 
 A task either is complete, with a result of type "'a", or is suspended with the
 message "msg" to send and the continuation "cont". The type "(int,'a status)
-continuation" says that the suspended computation expects an "int" value to
-resume and returns a "'a status" value when resumed.
+continuation" says that the suspended delimited computation expects an "int"
+value to resume and returns a value of type "'a status" when resumed.
 
 Next, we define a "step" function that executes one step of computation until
 it completes or suspends:
 
 \begin{caml_example*}{verbatim}
 let step (f : unit -> 'a) () : 'a status =
-  match_with f ()
-  { retc = (fun v -> Complete v);
-    exnc = raise;
-    effc = fun (type a) (eff: a t) ->
-      match eff with
-      | Xchg msg -> Some (fun (cont: (a, _) continuation) ->
-          Suspended {msg; cont})
-      | _ -> None }
+  match f () with
+  | v -> Complete v
+  | effect (Xchg msg), cont -> Suspended {msg; cont}
 \end{caml_example*}
 
 The argument to the "step" function, "f", is a computation that can perform an
 "Xchg" effect and returns a result of type "'a". The "step" function itself
-returns a "'a status" value.
-
-In the "step" function, we use the "match_with" primitive. Like "try_with",
-"match_with" primitive installs an effect handler. However, unlike "try_with",
-where only the effect case "effc" is provided, "match_with" expects the
-handlers for the value ("retc") and exceptional ("exnc") return cases. In fact,
-"try_with" can be defined using "match_with" as follows: "let try_with f v
-{effc} = match_with f v {retc = Fun.id; exnc = raise; effc}".
-
-In the "step" function,
-
-\begin{itemize}
-  \item Case "retc": If the computation returns with a value "v", we return
-    "Complete v".
-  \item Case "exnc": If the computation raises an exception, then the handler
-    raises the same exception.
-  \item Case "effc": If the computation performs the effect "Xchg msg" with the
-    continuation "cont", then we return "Suspended{msg;cont}". Thus, in this
-    case, the continuation "cont" is not immediately invoked by the handler;
-    instead, it is stored in a data structure for later use.
-\end{itemize}
+returns a value of type "'a status". Similar to exception patterns in a "match
+... with" expression (\ref{sss:exception-match}), OCaml also supports "effect"
+patterns. Here, we pattern match the result of running the computation "f". If
+the computation returns with a value "v", we return "Complete v". Instead, if
+the computation performs the effect "Xchg msg" with the continuation "cont",
+then we return "Suspended {msg;cont}". In this case, the continuation "cont" is
+not immediately invoked by the handler; instead, it is stored in a data
+structure for later use.
 
 Since the "step" function handles the "Xchg" effect, "step f" is a computation
 that does not perform the "Xchg" effect. It may however perform other effects.
@@ -241,7 +195,9 @@ A top-level "run" function defines the scheduler:
 \begin{caml_example*}{verbatim}
 (* A concurrent round-robin scheduler *)
 let run (main : unit -> unit) : unit =
-  let exchanger = ref None in (* waiting exchanger *)
+  let exchanger : (int * (int, unit) continuation) option ref =
+    ref None (* waiting exchanger *)
+  in
   let run_q = Queue.create () in (* scheduler queue *)
   let enqueue k v =
     let task () = continue k v in
@@ -255,25 +211,18 @@ let run (main : unit -> unit) : unit =
     end
   in
   let rec spawn (f : unit -> unit) : unit =
-    match_with f () {
-      retc = dequeue;
-      exnc = (fun e ->
+    match f () with
+    | () -> dequeue ()
+    | exception e ->
         print_endline (Printexc.to_string e);
-        dequeue ());
-      effc = fun (type a) (eff : a t) ->
-        match eff with
-        | Yield -> Some (fun (k : (a, unit) continuation) ->
-            enqueue k (); dequeue ())
-        | Fork f -> Some (fun (k : (a, unit) continuation) ->
-            enqueue k (); spawn f)
-        | Xchg n -> Some (fun (k : (int, unit) continuation) ->
-            begin match !exchanger with
-            | Some (n', k') ->
-                exchanger := None; enqueue k' n; continue k n'
-            | None -> exchanger := Some (n, k); dequeue ()
-            end)
-        | _ -> None
-    }
+        dequeue ()
+    | effect Yield, k -> enqueue k (); dequeue ()
+    | effect (Fork f), k -> enqueue k (); spawn f
+    | effect (Xchg n), k ->
+        begin match !exchanger with
+        | Some (n', k') -> exchanger := None; enqueue k' n; continue k n'
+        | None -> exchanger := Some (n, k); dequeue ()
+        end
   in
   spawn main
 \end{caml_example*}
@@ -286,10 +235,10 @@ exchange a value. At any time, there is either zero or one suspended task that
 is offering an exchange.
 
 The heavy lifting is done by the "spawn" function. The "spawn" function runs
-the given computation "f" in an effect handler. If "f" returns with a value
-(case "retc"), we dequeue and run the next task from the scheduler queue. If
-the computation "f" raises an exception (case "exnc"), we print the exception
-and run the next task from the scheduler.
+the given computation "f" in an effect handler. If "f" returns with unit value,
+we dequeue and run the next task from the scheduler queue. If the computation
+"f" raises any exception, we print the exception to the standard output and run
+the next task from the scheduler.
 
 The computation "f" may also perform effects. If "f" performs the "Yield"
 effect, the current task is suspended (inserted into the queue of ready tasks),
@@ -305,9 +254,6 @@ offered and immediately resume the current task with the value being offered.
 If not, we make the current task the waiting exchanger, and run the next task
 from the scheduler queue.
 
-Note that this scheduler code is not perfect -- it can leak resources. We shall
-explain and fix this in the next section~\ref{s:effects-discontinue}.
-
 Now we can write a concurrent program that utilises the newly defined
 operations:
 
@@ -429,14 +375,9 @@ let invert (type a) ~(iter : (a -> unit) -> unit) : a Seq.t =
     type _ Effect.t += Yield : a -> unit t
   end in
   let yield v = perform (M.Yield v) in
-  fun () -> match_with iter yield
-  { retc = (fun _ -> Seq.Nil);
-    exnc = raise;
-    effc = fun (type b) (eff : b Effect.t) ->
-      match eff with
-      | M.Yield v -> Some (fun (k: (b,_) continuation) ->
-          Seq.Cons (v, continue k))
-      | _ -> None }
+  fun () -> match iter yield with
+  | () -> Seq.Nil
+  | effect M.Yield v, k -> Seq.Cons (v, continue k)
 \end{caml_eval}
 
 The "invert" function takes an "iter" function (a producer that pushes elements
@@ -489,17 +430,11 @@ let invert (type a) ~(iter : (a -> unit) -> unit) : a Seq.t =
     type _ Effect.t += Yield : a -> unit t
   end in
   let yield v = perform (M.Yield v) in
-  fun () -> match_with iter yield
-  { retc = (fun _ -> Seq.Nil);
-    exnc = raise;
-    effc = fun (type b) (eff : b Effect.t) ->
-      match eff with
-      | M.Yield v -> Some (fun (k: (b,_) continuation) ->
-          Seq.Cons (v, continue k))
-      | _ -> None }
+  fun () -> match iter yield with
+  | () -> Seq.Nil
+  | effect M.Yield v, k -> Seq.Cons (v, continue k)
 \end{caml_example*}
 
-
 The "invert" function declares an effect "Yield" that takes the element to be
 yielded as a parameter. The "yield" function performs the "Yield" effect. The
 lambda abstraction "fun () -> ..." delays all action until the first element of
@@ -539,20 +474,12 @@ type _ Effect.t += E : int t
 let foo () = perform F
 
 let bar () =
-  try_with foo ()
-  { effc = fun (type a) (eff: a t) ->
-      match eff with
-      | E -> Some (fun (k: (a,_) continuation) ->
-          failwith "impossible")
-      | _ -> None }
+  try foo () with
+  | effect E, k -> failwith "impossible"
 
 let baz () =
-  try_with bar ()
-  { effc = fun (type a) (eff: a t) ->
-      match eff with
-      | F -> Some (fun (k: (a,_) continuation) ->
-          continue k "Hello, world!")
-      | _ -> None }
+  try bar () with
+  | effect F, k -> continue k "Hello, world!"
 \end{caml_example*}
 
 In this example, the computation "foo" performs "F", the inner handler handles
@@ -634,12 +561,8 @@ Attempting to use a continuation more than once raises a
 "Continuation_already_resumed" exception. For example:
 
 \begin{caml_example}{verbatim}
-try_with perform (Xchg 0)
-{ effc = fun (type a) (eff : a t) ->
-    match eff with
-    | Xchg n -> Some (fun (k: (a, _) continuation) ->
-        continue k 21 + continue k 21)
-    | _ -> None }
+try perform (Xchg 0) with
+| effect Xchg n, k -> continue k 21 + continue k 21
 \end{caml_example}
 
 The primary motivation for adding effect handlers to OCaml is to enable
@@ -678,6 +601,21 @@ finalisers is much more than the cost of capturing a continuation. Hence, it is
 recommended that the user take care of resuming the continuation exactly once
 rather than relying on the finaliser.
 
+\subsubsection{s:effects-limitations}{Limitations}
+
+OCaml's effects are \emph{synchronous}: It is not possible to perform
+an effect asynchronously from a signal handler, a finaliser, a memprof
+callback, or a GC alarm, and catch it from the main part of the code.
+Instead, this would result in an "Effect.Unhandled"
+exception (\ref{s:effects-unhandled}).
+
+Similarly, effects are incompatible with the use of callbacks from C
+to OCaml (section~\ref{s:c-callback}). It is not possible for an
+effect to cross a call to "caml_callback", this would instead result
+in an "Effect.Unhandled" exception. In particular, care must be taken
+when mixing libraries that use callbacks from C to OCaml and libraries
+that use effects.
+
 \subsection{s:effects-shallow}{Shallow handlers}
 
 The examples that we have seen so far have used \textit{deep} handlers. A deep
@@ -745,8 +683,13 @@ The "run" function executes the computation "comp" ensuring that it can only
 perform an alternating sequence of "Send" and "Recv" effects. The shallow
 handler uses a different set of primitives compared to the deep handler. The
 primitive "fiber" (on the last line) takes an "'a -> 'b" function and returns a
-"('a,'b) Effect.Shallow.continuation". The expression "continue_with k v h"
-resumes the continuation "k" with value "v" under the handler "h".
+"('a,'b) Effect.Shallow.continuation".
+
+Unlike deep handlers, OCaml does not provide syntax support for shallow
+handlers. The expression "continue_with k v h" resumes the continuation "k"
+with value "v" under the handler "h". The handler here is a record with three
+fields for the value case ("retc"), the exceptional case ("exnc") and the
+effect case ("effc").
 
 The mutually recursive functions "loop_send" and "loop_recv" resume the given
 continuation "k" with value "v" under different handlers. The "loop_send"
@@ -759,6 +702,16 @@ computation. Given that the continuation captured in the shallow handler do not
 include the handler, there is only ever one handler installed in the dynamic
 scope of the computation "comp".
 
+Note that unlike deep handlers with syntax support, explicit type annotations
+are necessary for the shallow handler. We must use a locally abstract type
+"(type b)" in the effect handler ("effc") and explicitly type annotate the
+effect argument "eff" and the continuation "k" in each of the effect cases.
+Another point to note is that the catch-all effect case “| _ -> None” is
+necessary. This case may be intuitively read as “forward the unhandled effects
+to the outer handler”. The standard library module \stdmoduleref{Effect} also
+provides a non-syntactic version of deep handlers, where similar annotations
+are necessary.
+
 The computation is initially executed by the "loop_send" function (see last
 line in the code above) which ensures that the first effect that the
 computation is allowed to perform is the "Send" effect. Note that the

diff --git a/manual/src/refman/lex.etex b/manual/src/refman/lex.etex
index 7972a9b5fbf775919e0835633943f578935128ae..823d2cc06188a918f260807b86336c21cd32ffd3 100644 (file)
--- a/manual/src/refman/lex.etex
+++ b/manual/src/refman/lex.etex
@@ -1,5 +1,12 @@
 \section{s:lexical-conventions}{Lexical conventions}
 %HEVEA\cutname{lex.html}
+
+\subsubsection*{sss:lex:text-encoding}{Source file encoding}
+
+OCaml source files are expected to be valid UTF-8 encoded Unicode text.
+The interpretation of source files which are not UTF-8 encoded is unspecified.
+Such source files may be rejected in the future.
+
 \subsubsection*{sss:lex:blanks}{Blanks}
 
 The following characters are considered as blanks: space,
@@ -31,21 +38,27 @@ let f = function
 
 \begin{syntax}
 ident: (letter || "_") { letter || "0"\ldots"9" || "_" || "'" } ;
-capitalized-ident: ("A"\ldots"Z") { letter || "0"\ldots"9" || "_" || "'" } ;
+capitalized-ident: uppercase-letter { letter || "0"\ldots"9" || "_" || "'" } ;
 lowercase-ident:
-   ("a"\ldots"z" || "_") { letter || "0"\ldots"9" || "_" || "'" } ;
-letter: "A"\ldots"Z" || "a"\ldots"z"
+   (lowercase-letter || "_") { letter || "0"\ldots"9" || "_" || "'" } ;
+letter: uppercase-letter || lowercase-letter ;
+lowercase-letter:
+"a"\ldots"z"  || 'U+00DF' \ldots 'U+00F6' || 'U+00F8' \dots 'U+00FF' || 'U+0153' || 'U+0161' || 'U+017E'  ;
+uppercase-letter:
+  "A"\ldots"Z" || 'U+00C0' \ldots 'U+00D6' || 'U+00D8' \ldots 'U+00DE' \\
+  || 'U+0152' || 'U+0160' || 'U+017D' || 'U+0178' || 'U+1E9E'
+ ;
 \end{syntax}
 
 Identifiers are sequences of letters, digits, "_" (the underscore
 character), and "'" (the single quote), starting with a
 letter or an underscore.
-Letters contain at least the 52 lowercase and uppercase
-letters from the ASCII set. The current implementation
-also recognizes as letters some characters from the ISO
-8859-1 set (characters 192--214 and 216--222 as uppercase letters;
-characters 223--246 and 248--255 as lowercase letters). This
-feature is deprecated and should be avoided for future compatibility.
+Letters contain the 52 lowercase and uppercase letters from the ASCII set,
+letters "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ" from
+the Latin-1 Supplement block, letters "ŠšŽžŒœŸ" from the Latin Extended-A block
+and upper case ẞ ("U+189E"). Any byte sequence which is equivalent to one of
+these Unicode characters under NFC\footnote{Normalization Form C} is supported
+too.
 
 All characters in an identifier are
 meaningful. The current implementation accepts identifiers up to
@@ -186,7 +199,7 @@ string-literal:
        |  '{' quoted-string-id '|' { newline | any-char } '|' quoted-string-id '}'
 ;
 quoted-string-id:
-     { 'a'...'z' || '_' }
+     { lowercase-letter || '_' }
 ;
 string-character:
           regular-string-char

diff --git a/manual/src/refman/modtypes.etex b/manual/src/refman/modtypes.etex
index 5fb03978a3eca406bece3d276c36ef58499097f8..2204c8510503410edb70baea3d9dbdb3f6222185 100644 (file)
--- a/manual/src/refman/modtypes.etex
+++ b/manual/src/refman/modtypes.etex
@@ -22,7 +22,7 @@ specify the general shape and type properties of modules.
 module-type:
           modtype-path
         | 'sig' { specification [';;'] } 'end'
-        | 'functor' '(' module-name ':' module-type ')' '->' module-type
+        | ['functor'] '(' module-name ':' module-type ')' '->' module-type
         | module-type '->' module-type
         | module-type 'with' mod-constraint { 'and' mod-constraint }
         | '(' module-type ')'
@@ -200,8 +200,8 @@ For specifying a module component that is a functor, one may write
 instead of
 \begin{center}
 @'module' module-name ':'
- 'functor' '(' name_1 ':' module-type_1 ')' '->' \ldots
-                                            '->' module-type@
+  '(' name_1 ':' module-type_1 ')' \ldots
+  '(' name_n ':' module-type_n ')' '->' module-type@
 \end{center}
 
 \subsubsection*{sss:mty-mty}{Module type specifications}
@@ -249,7 +249,7 @@ refer to a module type that is a signature, not a functor type.
 \ikwd{functor\@\texttt{functor}}
 
 The module type expression
-@'functor' '(' module-name ':' module-type_1 ')' '->' module-type_2@
+@['functor'] '(' module-name ':' module-type_1 ')' '->' module-type_2@
 is the type of functors (functions from modules to modules) that take
 as argument a module of type @module-type_1@ and return as result a
 module of type @module-type_2@. The module type @module-type_2@ can
@@ -264,13 +264,13 @@ particular, a functor may take another functor as argument
 
 When the result module type is itself a functor,
 \begin{center}
-@'functor' '(' name_1 ':' module-type_1 ')' '->' \ldots '->'
- 'functor' '(' name_n ':' module-type_n ')' '->' module-type@
+@'(' name_1 ':' module-type_1 ')' '->' \ldots '->'
+ '(' name_n ':' module-type_n ')' '->' module-type@
 \end{center}
 one may use the abbreviated form
 \begin{center}
-@'functor' '(' name_1 ':' module-type_1 ')' \ldots
-           '(' name_n ':' module-type_n ')' '->' module-type@
+@'(' name_1 ':' module-type_1 ')' \ldots
+ '(' name_n ':' module-type_n ')' '->' module-type@
 \end{center}
 
 \subsection{ss:mty-with}{The "with" operator}

diff --git a/manual/src/refman/patterns.etex b/manual/src/refman/patterns.etex
index 8475ce9ef764f52d6bc7da742bdb5c67e4fee348..a6a7ffe470c3b2276a9aaf13846b64dfea86c07e 100644 (file)
--- a/manual/src/refman/patterns.etex
+++ b/manual/src/refman/patterns.etex
@@ -29,8 +29,9 @@ pattern:
 \end{syntax}
 See also the following language extensions:
 \hyperref[s:first-class-modules]{first-class modules},
-\hyperref[s:attributes]{attributes} and
-\hyperref[s:extension-nodes]{extension nodes}.
+\hyperref[s:attributes]{attributes},
+\hyperref[s:extension-nodes]{extension nodes} and
+\hyperref[s:effect-handlers]{effect handlers}.
 
 The table below shows the relative precedences and associativity of
 operators and non-closed pattern constructions. The constructions with

diff --git a/manual/src/tutorials/gadtexamples.etex b/manual/src/tutorials/gadtexamples.etex
index 447268451779340a7f972f70de6ad39a1a2875c5..6e8d4e9148f3069521d3ee3b420534fc5abf410f 100644 (file)
--- a/manual/src/tutorials/gadtexamples.etex
+++ b/manual/src/tutorials/gadtexamples.etex
@@ -249,7 +249,7 @@ variable "'a" during typing:
 type ('arg,'result,'aux) fn =
   | Fun: ('a ->'b) -> ('a,'b,unit) fn
   | Mem1: ('a ->'b) * 'a * 'b -> ('a, 'b, 'a * 'b) fn
- let apply: ('arg,'result, _ ) fn -> 'arg -> 'result = fun f x ->
+let apply: ('arg,'result, _ ) fn -> 'arg -> 'result = fun f x ->
   match f with
   | Fun f -> f x
   | Mem1 (f,y,fy) -> if x = y then fy else f x
@@ -272,10 +272,23 @@ explicitly. For instance, the following code names the type of the argument of
 type _ closure = Closure : ('a -> 'b) * 'a -> 'b closure
 let eval = fun (Closure (type a) (f, x : (a -> _) * _)) -> f (x : a)
 \end{caml_example*}
-All existential type variables of the constructor must by introduced by
+All existential type variables of the constructor must be introduced by
 the ("type" ...) construct and bound by a type annotation on the
 outside of the constructor argument.
 
+One can additionally bind existentials that were freshly introduced
+by the refinement of another existential type, if they appear in the
+type of the arguments.
+\begin{caml_example*}{verbatim}
+type _ ty =
+  | Int : int ty
+  | Pair : 'b ty * 'c ty -> ('b * 'c) ty
+let rec default : type a. a ty -> a = function
+  | Int -> 0
+  | Pair (type b c) (b, c : b ty * c ty) ->
+      (default b : b), (default c : c)
+\end{caml_example*}
+
 \section{s:gadt-equation-nonlocal-abstract}{Equations on non-local abstract types}
 
 GADT pattern-matching may also add type equations to non-local

diff --git a/manual/src/tutorials/moduleexamples.etex b/manual/src/tutorials/moduleexamples.etex
index 45b8f7604f1c036c63ac43798d8a002d8c7393aa..c23cffb0a29979786b622a07c3bb054c3e211c06 100644 (file)
--- a/manual/src/tutorials/moduleexamples.etex
+++ b/manual/src/tutorials/moduleexamples.etex
@@ -227,7 +227,7 @@ their code. This can be achieved by restricting "Set" by a suitable
 functor signature:
 \begin{caml_example}{toplevel}
 module type SETFUNCTOR =
-  functor (Elt: ORDERED_TYPE) ->
+  (Elt: ORDERED_TYPE) ->
     sig
       type element = Elt.t      (* concrete *)
       type set                  (* abstract *)
@@ -252,7 +252,7 @@ module type SET =
     val add : element -> set -> set
     val member : element -> set -> bool
   end;;
-module WrongSet = (Set : functor(Elt: ORDERED_TYPE) -> SET);;
+module WrongSet = (Set : (Elt: ORDERED_TYPE) -> SET);;
 module WrongStringSet = WrongSet(OrderedString);;
 WrongStringSet.add "gee" WrongStringSet.empty [@@expect error];;
 \end{caml_example}
@@ -269,7 +269,7 @@ not exist. To overcome this difficulty, OCaml provides a
 with extra type equalities:
 \begin{caml_example}{toplevel}
 module AbstractSet2 =
-  (Set : functor(Elt: ORDERED_TYPE) -> (SET with type element = Elt.t));;
+  (Set : (Elt: ORDERED_TYPE) -> (SET with type element = Elt.t));;
 \end{caml_example}
 
 As in the case of simple structures, an alternate syntax is provided

diff --git a/manual/src/tutorials/objectexamples.etex b/manual/src/tutorials/objectexamples.etex
index 195d1b9177618ce516b6c46b2dab014ddf10f037..5b2a76cc6b8166f3de9016450c493dcba44a9d6b 100644 (file)
--- a/manual/src/tutorials/objectexamples.etex
+++ b/manual/src/tutorials/objectexamples.etex
@@ -418,7 +418,7 @@ let p' = new colored_point 5 "red";;
 p'#get_x, p'#color;;
 \end{caml_example}
 A point and a colored point have incompatible types, since a point has
-no method "color". However, the function "get_x" below is a generic
+no method "color". However, the function "get_succ_x" below is a generic
 function applying method "get_x" to any object "p" that has this
 method (and possibly some others, which are represented by an ellipsis
 in the type). Thus, it applies to both points and colored points.

diff --git a/manual/src/tutorials/parallelism.etex b/manual/src/tutorials/parallelism.etex
index a1db688727cbbff501ac44621aabd325c1303499..d2b30f9baffecd0661eb78fd5fc5cbae949669a0 100644 (file)
--- a/manual/src/tutorials/parallelism.etex
+++ b/manual/src/tutorials/parallelism.etex
@@ -2,23 +2,23 @@
 %HEVEA\cutname{parallelism.html}
 \label{c:parallelism}
 
-In this chapter, we shall look at the parallel programming facilities in OCaml.
+In this chapter we look at the parallel programming facilities in OCaml.
 The OCaml standard library exposes low-level primitives for parallel
-programming. We recommend the users to utilise higher-level parallel
+programming. We recommend that users make use of higher-level parallel
 programming libraries such as
 \href{https://github.com/ocaml-multicore/domainslib}{domainslib}. This
-tutorial will first cover the high-level parallel programming using domainslib
+tutorial will first cover high-level parallel programming using domainslib
 followed by low-level primitives exposed by the compiler.
 
-OCaml distinguishes concurrency and parallelism and provides distinct
-mechanisms for expressing them. Concurrency is overlapped execution of tasks
+OCaml distinguishes between concurrency and parallelism and provides distinct
+mechanisms for expressing them. Concurrency is interleaved execution of tasks
 (section \ref{s:effects-concurrency}) whereas parallelism is simultaneous
 execution of tasks. In particular, parallel tasks overlap in time but
 concurrent tasks may or may not overlap in time. Tasks may execute concurrently
 by yielding control to each other. While concurrency is a program structuring
 mechanism, parallelism is a mechanism to make your programs run faster. If you
 are interested in the concurrent programming mechanisms in OCaml, please refer
-to the section \ref{s:effect-handlers} on effect handlers and the chapter
+to section \ref{s:effect-handlers} on effect handlers and chapter
 \ref{c:threads} on the threads library.
 
 \section{s:par_domains}{Domains}
@@ -39,24 +39,24 @@ thread. Each domain also has its own runtime state, which includes domain-local
 structures for allocating memory. Hence, they are relatively expensive to
 create and tear down.
 
-\emph{\textbf{It is recommended that the programs do not spawn more domains
-than cores available}}.
+\emph{\textbf{It is recommended that programs do not spawn more domains
+than the number of available cores}}.
 
-In this tutorial, we shall be implementing, running and measuring the
+In this tutorial we will be implementing, running and measuring the
 performance of parallel programs. The results observed are dependent on the
-number of cores available on the target machine. This tutorial is being written
+number of cores available on the target machine. This tutorial was written
 on a 2.3 GHz Quad-Core Intel Core i7 MacBook Pro with 4 cores and 8 hardware
 threads. It is reasonable to expect roughly 4x performance on 4 domains for
 parallel programs with little coordination between the domains, and when the
 machine is not under load. Beyond 4 domains, the speedup is likely to be less
-than linear. We shall also use the command-line benchmarking tool
-\href{https://github.com/sharkdp/hyperfine}{hyperfine} for benchmarking our
+than linear. We will also use the command-line benchmarking tool
+\href{https://github.com/sharkdp/hyperfine}{hyperfine} to benchmark our
 programs.
 
 \subsection{s:par_join}{Joining domains}
 
-We shall use the program to compute the nth Fibonacci number using recursion as
-a running example. The sequential program for computing the nth Fibonacci
+We will write a program to compute the $n$th Fibonacci number using recursion as
+a running example. The sequential program for computing the $n$th Fibonacci
 number is given below.
 
 \begin{caml_example*}{verbatim}
@@ -72,7 +72,7 @@ let main () =
 let _ = main ()
 \end{caml_example*}
 
-The program can be compiled and benchmarked as follows.
+The program can be compiled and benchmarked as follows:
 
 \begin{verbatim}
 $ ocamlopt -o fib.exe fib.ml
@@ -88,7 +88,7 @@ We see that it takes around 1.2 seconds to compute the 42nd Fibonacci number.
 
 Spawned domains can be joined using the "join" function to get their results.
 The "join" function waits for target domain to terminate. The following program
-computes the nth Fibonacci number twice in parallel.
+computes the $n$th Fibonacci number twice in parallel.
 
 \begin{caml_example*}{verbatim}
 (* fib_twice.ml *)
@@ -107,7 +107,7 @@ let main () =
 let _ = main ()
 \end{caml_example*}
 
-The program spawns two domains which compute the nth Fibonacci number. The
+The program spawns two domains which compute the $n$th Fibonacci number. The
 "spawn" function returns a "Domain.t" value which can be joined to get the
 result of the parallel computation. The "join" function blocks until the
 computation runs to completion.
@@ -123,8 +123,8 @@ Benchmark 1: ./fib_twice.exe 42
   Range (min … max):    1.221 s …  1.290 s    10 runs
 \end{verbatim}
 
-As one can see that computing the nth Fibonacci number twice almost took the
-same time as computing it once thanks to parallelism.
+As one can see, computing the $n$th Fibonacci number twice takes almost the
+same time as computing it once, thanks to parallelism.
 
 \section{s:par_parfib}{Domainslib: A library for nested-parallel programming}
 
@@ -175,8 +175,9 @@ tutorial uses domainslib version 0.5.0.
 Domainslib provides an async/await mechanism for spawning parallel tasks and
 awaiting their results. On top of this mechanism, domainslib provides parallel
 iterators. At its core, domainslib has an efficient implementation of
-work-stealing queue in order to efficiently share tasks with other domains. A
-parallel implementation of the Fibonacci program is given below.
+\href{https://en.wikipedia.org/wiki/Work_stealing}{work-stealing queues} in
+order to efficiently share tasks with other domains. A parallel implementation
+of the Fibonacci program follows:
 
 \begin{verbatim}
 (* fib_par2.ml *)
@@ -223,9 +224,9 @@ For small inputs, the "fib_par" function simply calls the sequential Fibonacci
 function "fib". It is important to switch to sequential mode for small problem
 sizes. If not, the cost of parallelisation will outweigh the work available.
 
-For simplicity, we use "ocamlfind" to compile this program. It is recommended
-that the users use \href{https://github.com/ocaml/dune}{dune} to build their
-programs that utilise libraries installed through
+For simplicity, we use "ocamlfind" to compile this program. In general, it is
+recommended that users use \href{https://github.com/ocaml/dune}{dune} to build
+programs that use libraries installed through
 \href{https://opam.ocaml.org/}{opam}.
 
 \begin{verbatim}
@@ -362,7 +363,7 @@ let () =
 \end{verbatim}
 
 Observe that the "parallel_for" function is isomorphic to the for-loop in the
-sequential version. No other change is required except for the boiler plate
+sequential version. No other change is required except for the boilerplate
 code to set up and tear down the pools.
 
 \begin{verbatim}
@@ -418,8 +419,8 @@ allocated. Having domain-local pools avoids synchronisation for most major heap
 allocations. The major heap is collected by a concurrent mark-and-sweep
 algorithm that involves a few short stop-the-world pauses for each major cycle.
 
-Overall, the users should expect the garbage collector to scale well with
-increasing number of domains, with the latency remaining low. For more
+Overall, users should expect the garbage collector to scale well with as
+the number of domains increases, with latency remaining low. For more
 information on the design and evaluation of the garbage collector, please have
 a look at the ICFP 2020 paper on
 \href{https://arxiv.org/abs/2004.11663}{"Retrofitting Parallelism onto OCaml"}.
@@ -447,12 +448,12 @@ variables (section \ref{s:par_atomics}) and mutexes (section \ref{s:par_sync}).
 Importantly, \textbf{for data race free (DRF) programs, OCaml provides
 sequentially consistent (SC) semantics} -- the observed behaviour of such
 programs can be explained by the interleaving of operations from different
-domains. This property is known as DRF-SC guarantee. Moreover, in OCaml, DRF-SC
-guarantee is modular -- if a part of a program is data race free, then the
-OCaml memory model ensures that those parts have sequential consistency despite
-other parts of the program having data races. Even for programs with data
-races, OCaml provides strong guarantees. While the user may observe non
-sequentially consistent behaviours, there are no crashes.
+domains. This property is known as the DRF-SC guarantee. Moreover, in OCaml,
+the DRF-SC guarantee is modular -- if a part of a program is data race free,
+then the OCaml memory model ensures that those parts have sequential consistency
+despite other parts of the program having data races. Even for programs with
+data races, OCaml provides strong guarantees. While the user may observe
+non-sequentially consistent behaviours, there are no crashes.
 
 For more details on the relaxed behaviours in the presence of data races,
 please have a look at the chapter on the hard bits of the memory model
@@ -464,7 +465,7 @@ Domains may perform blocking synchronisation with the help of
 \stdmoduleref{Mutex}, \stdmoduleref{Condition} and \stdmoduleref{Semaphore}
 modules. These modules are the same as those used to synchronise threads
 created by the threads library (chapter \ref{c:threads}). For clarity, in the
-rest of this chapter, we shall call the threads created by the threads library
+rest of this chapter, we refer to the threads created by the threads library
 as \emph{systhreads}. The following program implements a concurrent stack using
 mutex and condition variables.
 
@@ -580,7 +581,7 @@ let _ = main ()
 \end{verbatim}
 
 \begin{verbatim}
-$ ocamlopt -I +threads unix.cmxa threads.cmxa -o dom_thr.exe dom_thr.ml
+$ ocamlopt -I +threads -I +unix unix.cmxa threads.cmxa -o dom_thr.exe dom_thr.ml
 $ ./dom_thr.exe
 Thread 1 running on domain 1 saw initial write
 Thread 0 running on domain 0 saw the write by thread 1
@@ -591,8 +592,8 @@ Thread 3 running on domain 0 saw the write by thread 2
 This program uses a shared reference cell protected by a mutex to communicate
 between the different systhreads running on two different domains. The
 systhread identifiers uniquely identify systhreads in the program. The initial
-domain gets the domain id and the thread id as 0. The newly spawned domain gets
-domain id as 1.
+domain gets the domain id 0 and thread id 0. The newly spawned domain gets
+the domain id 1.
 
 \section{s:par_c_bindings}{Interaction with C bindings}
 
@@ -606,7 +607,7 @@ domains.
 
 \section{s:par_atomics}{Atomics}
 
-Mutex, condition variables and semaphores are used to implement blocking
+Mutexes, condition variables and semaphores are used to implement blocking
 synchronisation between domains. For non-blocking synchronisation, OCaml
 provides \stdmoduleref{Atomic} variables. As the name suggests, non-blocking
 synchronisation does not provide mechanisms for suspending and waking up
@@ -668,9 +669,9 @@ the effect will be that of a single increment. On the other hand, the atomic
 counter performs the load and the store atomically with the help of hardware
 support for atomicity. The atomic counter returns the expected result.
 
-The atomic variables can be used for low-level synchronisation between the
-domains. The following example uses an atomic variable to exchange a message
-between two domains.
+Atomic variables can be used for low-level synchronisation between domains. The
+following example uses an atomic variable to exchange a message between two
+domains.
 
 \begin{caml_example}{verbatim}
 let r = Atomic.make None
@@ -691,7 +692,7 @@ let main () =
 let _ = main ()
 \end{caml_example}
 
-While the sender and the receiver compete to access "r", this is not a data
+Although the sender and the receiver compete to access "r", this is not a data
 race since "r" is an atomic reference.
 
 \subsection{s:par_lockfree_stack}{Lock-free stack}
@@ -737,5 +738,5 @@ If the "compare_and_set" fails, then some other domain is also attempting to
 update the atomic reference at the same time. In this case, the "push" and
 "pop" operations call "Domain.cpu_relax" to back off for a short duration
 allowing competing domains to make progress before retrying the failed
-operation. This lock-free stack implementation is also known as Treiber
-stack.
+operation. This lock-free stack implementation is called a 
+\href{https://en.wikipedia.org/wiki/Treiber_stack}{Treiber stack}.

diff --git a/manual/src/tutorials/polymorphism.etex b/manual/src/tutorials/polymorphism.etex
index 2b9b25a1ef0639d2940faa3609e6ba6c494523ec..5475adbf5172c7d0cacd77d2b0053900666c254c 100644 (file)
--- a/manual/src/tutorials/polymorphism.etex
+++ b/manual/src/tutorials/polymorphism.etex
@@ -280,18 +280,17 @@ With a regular polymorphic algebraic data type, the type parameters of
 the type constructor are constant within the definition of the type. For
 instance, we can look at arbitrarily nested list defined as:
 \begin{caml_example}{toplevel}
-  type 'a regular_nested = List of 'a list | Nested of 'a regular_nested list
-  let l = Nested[ List [1]; Nested [List[2;3]]; Nested[Nested[]] ];;
+type 'a regular_nested = List of 'a list | Nested of 'a regular_nested list;;
+let l = Nested[ List [1]; Nested [List[2;3]]; Nested[Nested[]] ];;
 \end{caml_example}
 Note that the type constructor "regular_nested" always appears as
 "'a regular_nested" in the definition above, with the same parameter
-"'a". Equipped with this type, one can compute a maximal depth with
+"'a". Equipped with this type, one can compute a depth with
 a classic recursive function
 \begin{caml_example}{toplevel}
-  let rec maximal_depth = function
+let rec regular_depth = function
   | List _ -> 1
-  | Nested [] -> 0
-  | Nested (a::q) -> 1 + max (maximal_depth a) (maximal_depth (Nested q));;
+  | Nested n -> 1 + List.fold_left max 1 (List.map regular_depth n);;
 \end{caml_example}
 
 Non-regular recursive algebraic data types correspond to polymorphic algebraic
@@ -299,11 +298,11 @@ data types whose parameter types vary between the left and right side of
 the type definition. For instance, it might be interesting to define a datatype
 that ensures that all lists are nested at the same depth:
 \begin{caml_example}{toplevel}
-  type 'a nested = List of 'a list | Nested of 'a list nested;;
+type 'a nested = List of 'a list | Nested of 'a list nested;;
 \end{caml_example}
 Intuitively, a value of type "'a nested" is a list of list \dots of list of
-elements "a" with "k" nested list. We can then adapt the "maximal_depth"
-function defined on "regular_depth" into a "depth" function that computes this
+elements "a" with "k" nested list. We can then adapt the "regular_depth"
+function defined on "regular_nested" into a "depth" function that computes this
 "k". As a first try, we may define
 \begin{caml_example}{toplevel}[error]
 let rec depth = function
@@ -350,13 +349,13 @@ Second, it also notifies the type checker that the type of the function should
 be polymorphic. Indeed, without explicit polymorphic type annotation, the
 following type annotation is perfectly valid
 \begin{caml_example}{toplevel}
-  let sum: 'a -> 'b -> 'c = fun x y -> x + y;;
+let sum: 'a -> 'b -> 'c = fun x y -> x + y;;
 \end{caml_example}
 since "'a","'b" and "'c" denote type variables that may or may not be
 polymorphic. Whereas, it is an error to unify an explicitly polymorphic type
 with a non-polymorphic type:
 \begin{caml_example}{toplevel}[error]
-  let sum: 'a 'b 'c. 'a -> 'b -> 'c = fun x y -> x + y;;
+let sum: 'a 'b 'c. 'a -> 'b -> 'c = fun x y -> x + y;;
 \end{caml_example}
 
 An important remark here is that it is not needed to explicit fully

diff --git a/manual/tests/Makefile b/manual/tests/Makefile
index 81e45dc974d272a56a7cead7c4486fdda8c1ffcb..ec11995b7512912455559b5baf2080cfa6c70bce 100644 (file)
--- a/manual/tests/Makefile
+++ b/manual/tests/Makefile
@@ -15,7 +15,7 @@ tools: cross-reference-checker
 
 cross-reference-checker: cross_reference_checker.ml
        $(OCAMLC) $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
-         -I $(ROOTDIR)/parsing -I $(ROOTDIR)/driver \
+         -I $(ROOTDIR)/utils -I $(ROOTDIR)/parsing -I $(ROOTDIR)/driver \
          $< -o $@
 
 # check cross-references between the manual and error messages

diff --git a/manual/tests/cross_reference_checker.ml b/manual/tests/cross_reference_checker.ml
index c11f40c24b64e2a7757606f5610a1d3da3e530c0..492488eb80e799f93747cc3f0976bed5ffd7a563 100644 (file)
--- a/manual/tests/cross_reference_checker.ml
+++ b/manual/tests/cross_reference_checker.ml
@@ -27,8 +27,8 @@ type error =
   | No_aux_file
   | Wrong_attribute_payload of Location.t
 
-let pp_ref ppf = Format.pp_print_list ~pp_sep:( fun ppf () ->
-    Format.pp_print_string ppf ".") Format.pp_print_int ppf
+let pp_ref ppf = Format_doc.pp_print_list ~pp_sep:( fun ppf () ->
+    Format_doc.pp_print_string ppf ".") Format_doc.pp_print_int ppf
 
 let print_error error =
   Location.print_report Format.std_formatter @@ match error with
@@ -144,7 +144,8 @@ module OCaml_refs = struct
     then None
     else begin match attr.attr_payload with
       | PStr [{pstr_desc= Pstr_eval
-                 ({ pexp_desc = Pexp_constant Pconst_string (s,_,_) },_) } ] ->
+                 ({ pexp_desc = Pexp_constant
+                        { pconst_desc = Pconst_string (s,_,_); _ } },_) } ] ->
           Some s
       | _ -> print_error (Wrong_attribute_payload attr.attr_loc);
           Some "" (* triggers an error *)
@@ -159,7 +160,8 @@ module OCaml_refs = struct
   let int e =
     let open Parsetree in
     match e.pexp_desc with
-    | Pexp_constant Pconst_integer (s, _ ) -> int_of_string s
+    | Pexp_constant { pconst_desc = Pconst_integer (s, _ ); _ } ->
+        int_of_string s
     | _ -> raise Exit
 
   let int_list l =
@@ -193,7 +195,7 @@ module OCaml_refs = struct
         | None -> tuple_expected (); []
         | Some pos -> pos
         end
-    | Parsetree.Pexp_constant Pconst_integer (n,_) ->
+    | Parsetree.Pexp_constant { pconst_desc = Pconst_integer (n,_); _ } ->
         [int_of_string n]
     | _ ->
         begin match list_expression e  with

diff --git a/manual/tools/transf.mll b/manual/tools/transf.mll
index a9cc26716c07b95292112dacb48a80319c241ed2..b960b65b995ff8eec6b6ee2b9820fb231dad96d1 100644 (file)
--- a/manual/tools/transf.mll
+++ b/manual/tools/transf.mll
@@ -6,7 +6,7 @@
   match c with
   | '\'' -> printf "{\\textquotesingle}"
   | '`' -> printf "{\\textasciigrave}"
-  | _ -> printf "\\char%d" (int_of_char c);
+  | _ -> printf "{\\char%d}" (int_of_char c);
   ;;
 }
 
@@ -83,6 +83,10 @@ and inquote = parse
   | '\'' {
       print_string "}";
       syntax lexbuf }
+  | ['\128' - '\255'] {
+      print_char (lexeme_char lexbuf 0);
+      inquote lexbuf
+    }
   | _ {
       print_char_repr (lexeme_char lexbuf 0);
       inquote lexbuf }
@@ -94,6 +98,10 @@ and indoublequote = parse
   | '"' {
       print_string "}";
       syntax lexbuf }
+  | ['\128' - '\255'] {
+      print_char (lexeme_char lexbuf 0);
+      indoublequote lexbuf
+    }
   | _ {
       print_char_repr (lexeme_char lexbuf 0);
       indoublequote lexbuf }

diff --git a/middle_end/backend_var.ml b/middle_end/backend_var.ml
index 5f95d155879cd55a579d85d5ebb5610c0bad28ea..08c0aef75feea55195f4c974a07bbbaac7b1c390 100644 (file)
--- a/middle_end/backend_var.ml
+++ b/middle_end/backend_var.ml
@@ -29,7 +29,7 @@ module Provenance = struct
     let printf fmt = Format.fprintf ppf fmt in
     printf "@[<hov 1>(";
     printf "@[<hov 1>(module_path@ %a)@]@ "
-      Path.print module_path;
+      (Format_doc.compat Path.print) module_path;
     if !Clflags.locations then
       printf "@[<hov 1>(location@ %a)@]@ "
         Debuginfo.print_compact location;

diff --git a/middle_end/clambda_primitives.ml b/middle_end/clambda_primitives.ml
index 7d8c97326b485e14249a3ff2433306165cf787c9..bddb01491722d464665cd99d666f727a372a7154 100644 (file)
--- a/middle_end/clambda_primitives.ml
+++ b/middle_end/clambda_primitives.ml
@@ -128,6 +128,8 @@ type primitive =
   | Popaque
   (* Fetch domain-local state *)
   | Pdls_get
+  (* Poll for runtime actions *)
+  | Ppoll
 
 and integer_comparison = Lambda.integer_comparison =
     Ceq | Cne | Clt | Cgt | Cle | Cge

diff --git a/middle_end/clambda_primitives.mli b/middle_end/clambda_primitives.mli
index f73277f8ac29ce33032250b900bbcaa1ef480777..50d5a212859b4f5e0dd7453c2351a4b1f895e171 100644 (file)
--- a/middle_end/clambda_primitives.mli
+++ b/middle_end/clambda_primitives.mli
@@ -131,7 +131,8 @@ type primitive =
   | Popaque
   (* Fetch domain-local state *)
   | Pdls_get
-
+  (* Poll for runtime actions *)
+  | Ppoll
 
 and integer_comparison = Lambda.integer_comparison =
     Ceq | Cne | Clt | Cgt | Cle | Cge

diff --git a/middle_end/compilenv.ml b/middle_end/compilenv.ml
index dff617f505a253740e1e484f5959fb3156bc314c..d975c1781ce6f93dc51f768a35bd50598350d886 100644 (file)
--- a/middle_end/compilenv.ml
+++ b/middle_end/compilenv.ml
@@ -452,32 +452,32 @@ let require_global global_ident =
 
 (* Error report *)
 
-open Format
+open Format_doc
 module Style = Misc.Style
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Not_a_unit_info filename ->
       fprintf ppf "%a@ is not a compilation unit description."
-        (Style.as_inline_code Location.print_filename) filename
+        Location.Doc.quoted_filename filename
   | Corrupted_unit_info filename ->
       fprintf ppf "Corrupted compilation unit description@ %a"
-        (Style.as_inline_code Location.print_filename) filename
+       Location.Doc.quoted_filename filename
   | Illegal_renaming(name, modname, filename) ->
       fprintf ppf "%a@ contains the description for unit\
                    @ %a when %a was expected"
-        (Style.as_inline_code Location.print_filename) filename
+        Location.Doc.quoted_filename filename
         Style.inline_code name
         Style.inline_code modname
   | Mismatching_for_pack(filename, pack_1, current_unit, None) ->
       fprintf ppf "%a@ was built with %a, but the \
                    @ current unit %a is not"
-        (Style.as_inline_code Location.print_filename) filename
+        Location.Doc.quoted_filename filename
         Style.inline_code ("-for-pack " ^ pack_1)
         Style.inline_code current_unit
   | Mismatching_for_pack(filename, pack_1, current_unit, Some pack_2) ->
       fprintf ppf "%a@ was built with %a, but the \
                    @ current unit %a is built with %a"
-        (Style.as_inline_code Location.print_filename) filename
+        Location.Doc.quoted_filename filename
         Style.inline_code ("-for-pack " ^ pack_1)
         Style.inline_code current_unit
         Style.inline_code ("-for-pack " ^ pack_2)
@@ -485,6 +485,8 @@ let report_error ppf = function
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/middle_end/compilenv.mli b/middle_end/compilenv.mli
index 941a8d40d083b8aff9c9692736947f2d49cc9ad1..2bcbca98b830b39f19e35f3a776c0d595209da29 100644 (file)
--- a/middle_end/compilenv.mli
+++ b/middle_end/compilenv.mli
@@ -158,4 +158,5 @@ type error =
 
 exception Error of error
 
-val report_error: Format.formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/middle_end/convert_primitives.ml b/middle_end/convert_primitives.ml
index 667465b7cbfd82dca398f253cfcc9e751780877b..aa6465132f0c6e9679be9cccd347d6ed677daf57 100644 (file)
--- a/middle_end/convert_primitives.ml
+++ b/middle_end/convert_primitives.ml
@@ -151,6 +151,7 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
   | Patomic_fetch_add -> Patomic_fetch_add
   | Popaque -> Popaque
   | Pdls_get -> Pdls_get
+  | Ppoll -> Ppoll
   | Pbytes_to_string
   | Pbytes_of_string
   | Pctconst _

diff --git a/middle_end/flambda/invariant_params.ml b/middle_end/flambda/invariant_params.ml
index 414d39310aabf36c9b0cdf53b5a558814a915710..dba63970fdccdb75b46f6ac37dc22213571ce020 100644 (file)
--- a/middle_end/flambda/invariant_params.ml
+++ b/middle_end/flambda/invariant_params.ml
@@ -65,47 +65,33 @@ let implies relation from to_ =
       relation
 
 let transitive_closure state =
-  let union s1 s2 =
-    match s1, s2 with
-    | Top, _ | _, Top -> Top
-    | Implication s1, Implication s2 ->
-      Implication (Variable.Pair.Set.union s1 s2)
+  (* Depth-first search for all implications for one argument.
+     Arguments are moved from candidate to frontier, assuming
+     they are newly added to the result. *)
+  let rec loop candidate frontier result =
+    match (candidate, frontier) with
+    | ([], []) -> Implication result
+    | ([], frontier::fs) ->
+      (* Obtain fresh candidate for the frontier argument. *)
+      (match Variable.Pair.Map.find frontier state with
+       | exception Not_found -> loop [] fs result
+       | Top -> Top
+       | Implication candidate ->
+         loop (Variable.Pair.Set.elements candidate) fs result)
+    | (candidate::cs, frontier) ->
+      let result' = Variable.Pair.Set.add candidate result in
+      if result' != result then
+        (* Result change means candidate becomes part of frontier. *)
+        loop cs (candidate :: frontier) result'
+      else
+        loop cs frontier result
   in
-  let equal s1 s2 =
-    match s1, s2 with
-    | Top, Implication _ | Implication _, Top -> false
-    | Top, Top -> true
-    | Implication s1, Implication s2 -> Variable.Pair.Set.equal s1 s2
-  in
-  let update arg state =
-    let original_set =
-      try Variable.Pair.Map.find arg state with
-      | Not_found -> Implication Variable.Pair.Set.empty
-    in
-    match original_set with
-    | Top -> state
-    | Implication arguments ->
-        let set =
-          Variable.Pair.Set.fold
-            (fun orig acc->
-               let set =
-                 try Variable.Pair.Map.find orig state with
-                 | Not_found -> Implication Variable.Pair.Set.empty in
-               union set acc)
-            arguments original_set
-        in
-        Variable.Pair.Map.add arg set state
-  in
-  let once state =
-    Variable.Pair.Map.fold (fun arg _ state -> update arg state) state state
-  in
-  let rec fp state =
-    let state' = once state in
-    if Variable.Pair.Map.equal equal state state'
-    then state
-    else fp state'
-  in
-  fp state
+    Variable.Pair.Map.map
+      (fun set ->
+         match set with
+         | Top -> Top
+         | Implication set -> loop [] (Variable.Pair.Set.elements set) set)
+      state
 
 (* CR-soon pchambart: to move to Flambda_utils and document
    mshinwell: I think this calculation is basically the same as

diff --git a/middle_end/flambda/lift_constants.ml b/middle_end/flambda/lift_constants.ml
index b8987ec64b79d5b441842663d41b7cdfb4a16299..307d5492d9d9b608db5bfded797cf7c1d87e3376 100644 (file)
--- a/middle_end/flambda/lift_constants.ml
+++ b/middle_end/flambda/lift_constants.ml
@@ -996,7 +996,7 @@ let lift_constants (program : Flambda.program) ~backend =
     constant_definitions
   in
   let effect_tbl =
-    Symbol.Tbl.map effect_tbl (fun (effect, dep) -> rewrite_expr effect, dep)
+    Symbol.Tbl.map effect_tbl (fun (eff, dep) -> rewrite_expr eff, dep)
   in
   let initialize_symbol_tbl =
     Symbol.Tbl.map initialize_symbol_tbl (fun (tag, fields, dep) ->

diff --git a/middle_end/flambda/lift_let_to_initialize_symbol.ml b/middle_end/flambda/lift_let_to_initialize_symbol.ml
index da53fdd7d73db515e0b6c6dd51b577604033455a..c86372c259ad535b1632f84fe84b4ef2d3258fc3 100644 (file)
--- a/middle_end/flambda/lift_let_to_initialize_symbol.ml
+++ b/middle_end/flambda/lift_let_to_initialize_symbol.ml
@@ -194,8 +194,8 @@ let add_extracted introduced program =
       match extracted with
       | Initialisation (symbol, tag, def) ->
         Flambda.Initialize_symbol (symbol, tag, def, program)
-      | Effect effect ->
-        Flambda.Effect (effect, program))
+      | Effect eff ->
+        Flambda.Effect (eff, program))
     introduced program
 
 let rec split_program (program : Flambda.program_body) : Flambda.program_body =

diff --git a/middle_end/flambda/remove_unused_program_constructs.ml b/middle_end/flambda/remove_unused_program_constructs.ml
index 059d68bcba77d797898314955e6bfa6a2db0984b..468223dcfa1140a8dbf5bebc51997ea546a829c5 100644 (file)
--- a/middle_end/flambda/remove_unused_program_constructs.ml
+++ b/middle_end/flambda/remove_unused_program_constructs.ml
@@ -94,14 +94,14 @@ let rec loop (program : Flambda.program_body)
              Flambda.Effect (field, program), dep)
         (program, dep) fields
     end
-  | Effect (effect, program) ->
+  | Effect (eff, program) ->
     let program, dep = loop program in
-    if Effect_analysis.no_effects effect then begin
+    if Effect_analysis.no_effects eff then begin
       program, dep
     end else begin
-      let new_dep = dependency effect in
+      let new_dep = dependency eff in
       let dep = Symbol.Set.union new_dep dep in
-      Effect (effect, program), dep
+      Effect (eff, program), dep
     end
   | End symbol -> program, Symbol.Set.singleton symbol
 

diff --git a/middle_end/internal_variable_names.ml b/middle_end/internal_variable_names.ml
index 55a1deee1487e11ead5201cf0b1baed2d8ea48a2..ca529ac25538cd187481686db56857ee01ca31e6 100644 (file)
--- a/middle_end/internal_variable_names.ml
+++ b/middle_end/internal_variable_names.ml
@@ -178,6 +178,7 @@ let pperform = "Pperform"
 let presume = "Presume"
 let preperform = "Preperform"
 let pdls_get = "Pdls_get"
+let ppoll = "Ppoll"
 
 let pabsfloat_arg = "Pabsfloat_arg"
 let paddbint_arg = "Paddbint_arg"
@@ -290,6 +291,7 @@ let pperform_arg = "Pperform_arg"
 let presume_arg = "Presume_arg"
 let preperform_arg = "Preperform_arg"
 let pdls_get_arg = "Pdls_get_arg"
+let ppoll_arg = "Ppoll_arg"
 
 let raise = "raise"
 let raise_arg = "raise_arg"
@@ -434,6 +436,7 @@ let of_primitive : Lambda.primitive -> string = function
   | Presume -> presume
   | Preperform -> preperform
   | Pdls_get -> pdls_get
+  | Ppoll -> ppoll
 
 let of_primitive_arg : Lambda.primitive -> string = function
   | Pbytes_of_string -> pbytes_of_string_arg
@@ -546,3 +549,4 @@ let of_primitive_arg : Lambda.primitive -> string = function
   | Presume -> presume_arg
   | Preperform -> preperform_arg
   | Pdls_get -> pdls_get_arg
+  | Ppoll -> ppoll_arg

diff --git a/middle_end/printclambda_primitives.ml b/middle_end/printclambda_primitives.ml
index c09afd7d24ecc4c4c02cb23b24eb503b4cbdb00e..3f54a255c9b2e603392504816e39e7d3c9839a22 100644 (file)
--- a/middle_end/printclambda_primitives.ml
+++ b/middle_end/printclambda_primitives.ml
@@ -222,3 +222,4 @@ let primitive ppf (prim:Clambda_primitives.primitive) =
   | Patomic_fetch_add -> fprintf ppf "atomic_fetch_add"
   | Popaque -> fprintf ppf "opaque"
   | Pdls_get -> fprintf ppf "dls_get"
+  | Ppoll -> fprintf ppf "poll"

diff --git a/middle_end/semantics_of_primitives.ml b/middle_end/semantics_of_primitives.ml
index d1c1b2cf39780a7028845beeb0557b75b1cfaff2..e921ee942655b15bb4c6f345853f5cf745ba4a50 100644 (file)
--- a/middle_end/semantics_of_primitives.ml
+++ b/middle_end/semantics_of_primitives.ml
@@ -133,7 +133,7 @@ let for_primitive (prim : Clambda_primitives.primitive) =
   | Pbswap16
   | Pbbswap _ -> No_effects, No_coeffects
   | Pint_as_pointer -> No_effects, No_coeffects
-  | Popaque -> Arbitrary_effects, Has_coeffects
+  | Popaque | Ppoll -> Arbitrary_effects, Has_coeffects
   | Psequand
   | Psequor ->
       (* Removed by [Closure_conversion] in the flambda pipeline. *)

diff --git a/ocaml-variants.install b/ocaml-variants.install
new file mode 100644 (file)
index 0000000..e9cdff1
--- /dev/null
+++ b/ocaml-variants.install
@@ -0,0 +1,4 @@
+share_root: [
+  "config.cache" {"ocaml/config.cache"}
+  "config.status" {"ocaml/config.status"}
+]

diff --git a/ocaml-variants.opam b/ocaml-variants.opam
index 120ef124f51ac35dd3e3fd141e17611b4f363607..c34a80880662c60b8dd7f7eb4030094e5732a8a4 100644 (file)
--- a/ocaml-variants.opam
+++ b/ocaml-variants.opam
@@ -1,7 +1,7 @@
 opam-version: "2.0"
-version: "5.2.1"
+version: "5.3.0"
 license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception"
-synopsis: "Official release of OCaml 5.2.1"
+synopsis: "Official release of OCaml 5.3.0"
 maintainer: "caml-list@inria.fr"
 authors: [
   "Xavier Leroy"
@@ -14,8 +14,8 @@ authors: [
 homepage: "https://github.com/ocaml/ocaml/"
 bug-reports: "https://github.com/ocaml/ocaml/issues"
 depends: [
-  # This is OCaml 5.2.1
-  "ocaml" {= "5.2.1" & post}
+  # This is OCaml 5.3.0
+  "ocaml" {= "5.3.0" & post}
 
   # General base- packages
   "base-unix" {post}
@@ -23,6 +23,7 @@ depends: [
   "base-threads" {post}
   "base-domains" {post}
   "base-nnp" {post}
+  "base-effects" {post}
 
   # Architecture (non-Windows)
   # opam-repository at present requires that ocaml-base-compiler is installed
@@ -41,12 +42,14 @@ depends: [
   "host-arch-unknown" {os != "win32" & arch != "arm32" & arch != "arm64" & arch != "ppc64" & arch != "riscv64" & arch != "s390x" & arch != "x86_32" & arch != "x86_64" & post}
 
   # Port selection (Windows)
-  # amd64 mingw-w64 only
+  # amd64 mingw-w64 / MSVC
   (("arch-x86_64" {os = "win32" & arch = "x86_64"} &
-     "system-mingw" & "mingw-w64-shims" {os-distribution = "cygwin" & build}) |
-  # i686 mingw-w64 only
+     (("system-mingw" & "mingw-w64-shims" {os-distribution = "cygwin" & build}) |
+      ("system-msvc" & "winpthreads" & "ocaml-option-no-compression" {os = "win32"}))) |
+  # i686 mingw-w64 / MSVC
    ("arch-x86_32" {os = "win32"} & "ocaml-option-bytecode-only" {os = "win32"} &
-     "system-mingw" & "mingw-w64-shims" {os-distribution = "cygwin" & build}) |
+     (("system-mingw" & "mingw-w64-shims" {os-distribution = "cygwin" & build}) |
+      ("system-msvc" & "winpthreads" & "ocaml-option-no-compression" {os = "win32"}))) |
   # Non-Windows systems
    "host-system-other" {os != "win32" & post})
 
@@ -66,11 +69,14 @@ build-env: [
 build: [
   [
     "./configure"
+    "--host=x86_64-pc-windows"  {system-msvc:installed & arch-x86_64:installed}
     "--host=x86_64-w64-mingw32" {os-distribution = "cygwin" & system-mingw:installed & arch-x86_64:installed}
+    "--host=i686-pc-windows"    {system-msvc:installed & arch-x86_32:installed}
     "--host=i686-w64-mingw32"   {os-distribution = "cygwin" & system-mingw:installed & arch-x86_32:installed}
     "--prefix=%{prefix}%"
     "--docdir=%{doc}%/ocaml"
     "--with-flexdll=%{flexdll:share}%" {os = "win32" & flexdll:installed}
+    "--with-winpthreads-msvc=%{winpthreads:share}%" {system-msvc:installed}
     "-C"
     "--with-afl" {ocaml-option-afl:installed}
     "--disable-native-compiler" {ocaml-option-bytecode-only:installed}
@@ -98,9 +104,6 @@ build: [
   [make "-j%{jobs}%"]
 ]
 install: [make "install"]
-conflicts: [
-  "system-msvc"
-]
 depopts: [
   "ocaml-option-32bit"
   "ocaml-option-afl"

diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml
index 64726819a469bd65e14b5b82984a5d6572b16fa6..3e782f5df0e020f079721bcdd2d468a60d1f035b 100644 (file)
--- a/ocamldoc/odoc_analyse.ml
+++ b/ocamldoc/odoc_analyse.ml
@@ -28,7 +28,7 @@ let init_path () = Compmisc.init_path ()
 
 (** Return the initial environment in which compilation proceeds. *)
 let initial_env () =
-  let current = Env.get_unit_name () in
+  let current = Env.get_current_unit_name () in
   let initial = !Odoc_global.initially_opened_module in
   let initially_opened_module =
     if initial = current then
@@ -66,14 +66,14 @@ let no_docstring f x =
   Lexer.handle_docstrings := true;
   result
 
-let unit_from_source source_file =
-    Unit_info.make ~check_modname:false ~source_file
+let unit_from_source source_file source_kind =
+    Unit_info.make ~check_modname:false ~source_file source_kind
       (Filename.remove_extension source_file)
 
 let process_implementation_file sourcefile =
   init_path ();
-  let source = unit_from_source sourcefile in
-  Env.set_unit_name (Unit_info.modname source);
+  let source = unit_from_source sourcefile Unit_info.Impl in
+  Env.set_current_unit source;
   let inputfile = preprocess sourcefile in
   let env = initial_env () in
   try
@@ -102,9 +102,8 @@ let process_implementation_file sourcefile =
    no error occurred, else None and an error message is printed.*)
 let process_interface_file sourcefile =
   init_path ();
-  let unit = unit_from_source sourcefile in
-  let modulename = Unit_info.modname unit in
-  Env.set_unit_name modulename;
+  let unit = unit_from_source sourcefile Unit_info.Intf in
+  Env.set_current_unit unit;
   let inputfile = preprocess sourcefile in
   let ast =
     Pparse.file ~tool_name inputfile
@@ -207,7 +206,7 @@ let process_file sourcefile =
   | Odoc_global.Text_file file ->
       Location.input_name := file;
       try
-        let mod_name = Unit_info.modname_from_source file in
+        let mod_name = Unit_info.lax_modname_from_source file in
         let txt =
           try Odoc_text.Texter.text_of_string (Odoc_misc.input_file_as_string file)
           with Odoc_text.Text_syntax (l, c, s) ->

diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index a2430502c659b5cbbbf60f218b283be101ed4c5a..3d70fe13f31000805c7e1662f31d5407ae68ef95 100644 (file)
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -77,7 +77,8 @@ module Typedtree_search =
           | 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.tyexn_constructor.ext_id)) tt
+          Hashtbl.add table (E (Name.from_ident ext.tyexn_constructor.ext_id))
+            tt
       | Typedtree.Tstr_type (rf, ident_type_decl_list) ->
           List.iter
             (fun td ->
@@ -1845,7 +1846,7 @@ module Analyser =
        let (tree_structure, _) = typedtree in
        prepare_file source_file input_file;
        (* We create the t_module for this file. *)
-       let mod_name = Unit_info.modname_from_source source_file in
+       let mod_name = Unit_info.lax_modname_from_source source_file in
        let len, info_opt = Sig.preamble !file_name !file
            (fun x -> x.Parsetree.pstr_loc) parsetree in
       let info_opt = analyze_toplevel_alerts info_opt parsetree in

diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
index 53d2c29bae369791cc5bf19d82b26c3b372da798..2ba946982429a7ed29396d48964b50fcfed261df 100644 (file)
--- a/ocamldoc/odoc_html.ml
+++ b/ocamldoc/odoc_html.ml
@@ -29,7 +29,7 @@ let css_style = ref None
 let index_only = ref false
 let colorize_code = ref false
 let html_short_functors = ref false
-let charset = ref "iso-8859-1"
+let charset = ref "UTF-8"
 let show_navbar = ref true
 
 

diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml
index 8a80224452f7f6b0b0ed07f15fda1b1464944487..6d2e82321539f152b0f3bb137f2640ceee5eedb1 100644 (file)
--- a/ocamldoc/odoc_info.ml
+++ b/ocamldoc/odoc_info.ml
@@ -129,7 +129,7 @@ let dump_modules = Odoc_analyse.dump_modules
 
 let load_modules = Odoc_analyse.load_modules
 
-let reset_type_names = Printtyp.reset
+let reset_type_names = Out_type.reset
 
 let string_of_variance t v = Odoc_str.string_of_variance t v
 

diff --git a/ocamldoc/odoc_latex_style.ml b/ocamldoc/odoc_latex_style.ml
index e3453e2e3971d667442e93f9b43e4f577682d8cc..cb3cfbabdca9f67480fee06c736fb5ea7041669d 100644 (file)
--- a/ocamldoc/odoc_latex_style.ml
+++ b/ocamldoc/odoc_latex_style.ml
@@ -15,79 +15,79 @@
 
 (** The content of the LaTeX style to generate when generating LaTeX code. *)
 
-let content ="\
-\n%% Support macros for LaTeX documentation generated by ocamldoc.\
-\n%% This file is in the public domain; do what you want with it.\
-\n\
-\n\\NeedsTeXFormat{LaTeX2e}\
-\n\\ProvidesPackage{ocamldoc}\
-\n              [2001/12/04 v1.0 ocamldoc support]\
-\n\
-\n\\newenvironment{ocamldoccode}{%\
-\n  \\bgroup\
-\n  \\leftskip\\@totalleftmargin\
-\n  \\rightskip\\z@skip\
-\n  \\parindent\\z@\
-\n  \\parfillskip\\@flushglue\
-\n  \\parskip\\z@skip\
-\n  %\\noindent\
-\n  \\@@par\\smallskip\
-\n  \\@tempswafalse\
-\n  \\def\\par{%\
-\n    \\if@tempswa\
-\n      \\leavevmode\\null\\@@par\\penalty\\interlinepenalty\
-\n  \\else\
-\n    \\@tempswatrue\
-\n    \\ifhmode\\@@par\\penalty\\interlinepenalty\\fi\
-\n  \\fi}\
-\n  \\obeylines\
-\n  \\verbatim@font\
-\n  \\let\\org@prime~%\
-\n  \\@noligs\
-\n  \\let\\org@dospecials\\dospecials\
-\n  \\g@remfrom@specials{\\\\}\
-\n  \\g@remfrom@specials{\\{}\
-\n  \\g@remfrom@specials{\\}}\
-\n  \\let\\do\\@makeother\
-\n  \\dospecials\
-\n  \\let\\dospecials\\org@dospecials\
-\n  \\frenchspacing\\@vobeyspaces\
-\n  \\everypar \\expandafter{\\the\\everypar \\unpenalty}}\
-\n{\\egroup\\par}\
-\n\
-\n\\def\\g@remfrom@specials#1{%\
-\n  \\def\\@new@specials{}\
-\n  \\def\\@remove##1{%\
-\n    \\ifx##1#1\\else\
-\n    \\g@addto@macro\\@new@specials{\\do ##1}\\fi}\
-\n  \\let\\do\\@remove\\dospecials\
-\n  \\let\\dospecials\\@new@specials\
-\n  }\
-\n\
-\n\\newenvironment{ocamldocdescription}\
-\n{\\list{}{\\rightmargin0pt \\topsep0pt}\\raggedright\\item\\noindent\\relax\\ignorespaces}\
-\n{\\endlist\\medskip}\
-\n\
-\n\\newenvironment{ocamldoccomment}\
-\n{\\list{}{\\leftmargin 2\\leftmargini \\rightmargin0pt \\topsep0pt}\\raggedright\\item\\noindent\\relax}\
-\n{\\endlist}\
-\n\
-\n\\let \\ocamldocparagraph \\paragraph\
-\n\\def \\paragraph #1{\\ocamldocparagraph {#1}\\noindent}\
-\n\\let \\ocamldocsubparagraph \\subparagraph\
-\n\\def \\subparagraph #1{\\ocamldocsubparagraph {#1}\\noindent}\
-\n\
-\n\\let\\ocamldocvspace\\vspace\
-\n\
-\n\\newenvironment{ocamldocindent}{\\list{}{}\\item\\relax}{\\endlist}\
-\n\\newenvironment{ocamldocsigend}\
-\n     {\\noindent\\quad\\texttt{sig}\\ocamldocindent}\
-\n     {\\endocamldocindent\\vskip -\\lastskip\
-\n      \\noindent\\quad\\texttt{end}\\medskip}\
-\n\\newenvironment{ocamldocobjectend}\
-\n     {\\noindent\\quad\\texttt{object}\\ocamldocindent}\
-\n     {\\endocamldocindent\\vskip -\\lastskip\
-\n      \\noindent\\quad\\texttt{end}\\medskip}\
-\n\
-\n\\endinput\
-\n"
+let content =
+{|%% Support macros for LaTeX documentation generated by ocamldoc.
+%% This file is in the public domain; do what you want with it.
+
+\NeedsTeXFormat{LaTeX2e}
+\ProvidesPackage{ocamldoc}
+              [2001/12/04 v1.0 ocamldoc support]
+
+\newenvironment{ocamldoccode}{%
+  \bgroup
+  \leftskip\@totalleftmargin
+  \rightskip\z@skip
+  \parindent\z@
+  \parfillskip\@flushglue
+  \parskip\z@skip
+  %\noindent
+  \@@par\smallskip
+  \@tempswafalse
+  \def\par{%
+    \if@tempswa
+      \leavevmode\null\@@par\penalty\interlinepenalty
+  \else
+    \@tempswatrue
+    \ifhmode\@@par\penalty\interlinepenalty\fi
+  \fi}
+  \obeylines
+  \verbatim@font
+  \let\org@prime~%
+  \@noligs
+  \let\org@dospecials\dospecials
+  \g@remfrom@specials{\\}
+  \g@remfrom@specials{\{}
+  \g@remfrom@specials{\}}
+  \let\do\@makeother
+  \dospecials
+  \let\dospecials\org@dospecials
+  \frenchspacing\@vobeyspaces
+  \everypar \expandafter{\the\everypar \unpenalty}}
+{\egroup\par}
+
+\def\g@remfrom@specials#1{%
+  \def\@new@specials{}
+  \def\@remove##1{%
+    \ifx##1#1\else
+    \g@addto@macro\@new@specials{\do ##1}\fi}
+  \let\do\@remove\dospecials
+  \let\dospecials\@new@specials
+  }
+
+\newenvironment{ocamldocdescription}
+{\list{}{\rightmargin0pt \topsep0pt}\raggedright\item\noindent\relax\ignorespaces}
+{\endlist\medskip}
+
+\newenvironment{ocamldoccomment}
+{\list{}{\leftmargin 2\leftmargini \rightmargin0pt \topsep0pt}\raggedright\item\noindent\relax}
+{\endlist}
+
+\let \ocamldocparagraph \paragraph
+\def \paragraph #1{\ocamldocparagraph {#1}\noindent}
+\let \ocamldocsubparagraph \subparagraph
+\def \subparagraph #1{\ocamldocsubparagraph {#1}\noindent}
+
+\let\ocamldocvspace\vspace
+
+\newenvironment{ocamldocindent}{\list{}{}\item\relax}{\endlist}
+\newenvironment{ocamldocsigend}
+     {\noindent\quad\texttt{sig}\ocamldocindent}
+     {\endocamldocindent\vskip -\lastskip
+      \noindent\quad\texttt{end}\medskip}
+\newenvironment{ocamldocobjectend}
+     {\noindent\quad\texttt{object}\ocamldocindent}
+     {\endocamldocindent\vskip -\lastskip
+      \noindent\quad\texttt{end}\medskip}
+
+\endinput
+|}

diff --git a/ocamldoc/odoc_lexer.mll b/ocamldoc/odoc_lexer.mll
index 1055e465932d4c346f9ef1672831097c40b23b71..ab1bd45a7f112fd4c76513d22e9896749ba51160 100644 (file)
--- a/ocamldoc/odoc_lexer.mll
+++ b/ocamldoc/odoc_lexer.mll
@@ -87,17 +87,38 @@ let remove_blanks s =
 (** Remove first blank characters of each line of a string, until the first '*' *)
 let remove_stars s =
   Str.global_replace (Str.regexp ("^"^blank^"*\\*")) "" s
+
+let validate_encoding raw_name =
+  match Misc.Utf8_lexeme.normalize raw_name with
+  | Error s -> failwith (Format.asprintf "Invalid encoding %s" s)
+  | Ok name -> name
+
+let validate_ident raw_name =
+  let name = validate_encoding raw_name in
+  match Misc.Utf8_lexeme.validate_identifier name with
+  | Misc.Utf8_lexeme.Valid -> name
+  | Misc.Utf8_lexeme.Invalid_character u ->
+    failwith (Format.asprintf "Invalid character U+%X" (Uchar.to_int u))
+  | Misc.Utf8_lexeme.Invalid_beginning u  ->
+    failwith (Format.asprintf "Invalid first character U+%X" (Uchar.to_int u))
+
+ let validate_exception_uident raw_name =
+    let name = validate_ident raw_name in
+    if Misc.Utf8_lexeme.is_capitalized name then name else
+      failwith (Format.asprintf "Invalid exception name: %s" name)
 }
 
 let blank = [ ' ' '\013' '\009' '\012']
 let nl_blank = blank | '\010'
 let notblank = [^ ' ' '\010' '\013' '\009' '\012']
-let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
-let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222']
-let identchar =
-  ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
 
-let modident = uppercase identchar* ('.' uppercase identchar* )*
+let lowercase = ['a'-'z' '_']
+let uppercase = ['A'-'Z']
+let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
+let utf8 = ['\192'-'\255'] ['\128'-'\191']*
+let identchar_ext = identchar | utf8
+let identstart_ext = lowercase | uppercase | utf8
+let ident_ext = identstart_ext identchar_ext*
 
 rule main = parse
     [' ' '\013' '\009' '\012'] +
@@ -301,10 +322,20 @@ and elements = parse
       }
 
   | "@param" nl_blank+ (identchar+ as id) nl_blank+ { T_PARAM id }
+  | "@param" nl_blank+ (identchar_ext+ as raw_id) nl_blank+ {
+     let id = validate_ident raw_id in
+     T_PARAM id
+     }
   | "@param" { failwith "usage: @param id description"}
-  | "@before" nl_blank+ (notblank+ as v) nl_blank+ { T_BEFORE v }
+  | "@before" nl_blank+ (notblank+ as v) nl_blank+ {
+     let v = validate_encoding v in
+     T_BEFORE v }
   | "@before" { failwith "usage: @before version description"}
-  | "@raise" nl_blank+ (modident as id) nl_blank+ { T_RAISES id }
+  | "@raise" nl_blank+ (ident_ext ('.' ident_ext)* as exn_path) nl_blank+
+    {  let raw_path = String.split_on_char '.' exn_path in
+       let path = List.map validate_exception_uident raw_path in
+       let id = String.concat "." path in
+       T_RAISES id }
   | "@raise" { failwith "usage: @raise Exception description"}
   | "@"lowercase+
       {

diff --git a/ocamldoc/odoc_ocamlhtml.mll b/ocamldoc/odoc_ocamlhtml.mll
index d808fef970a9bde583c6d8c0db034b45ba2fe60e..11333b0b608785e04790d89860b3c9f71961a404 100644 (file)
--- a/ocamldoc/odoc_ocamlhtml.mll
+++ b/ocamldoc/odoc_ocamlhtml.mll
@@ -204,13 +204,27 @@ let get_stored_string () =
 (** To store the position of the beginning of a string and comment *)
 let string_start_pos = ref 0
 let comment_start_pos = ref []
+
+(** Normalizing utf-8 *)
+let normalize raw_name =
+  (* we are printing documentation, it is too late to be strict *)
+  match Misc.Utf8_lexeme.normalize raw_name with
+  | Error s -> s
+  | Ok name -> name
+
 }
 
 let blank = [' ' '\010' '\013' '\009' '\012']
-let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
-let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222']
-let identchar =
-  ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
+
+let lowercase = ['a'-'z' '_']
+let uppercase = ['A'-'Z']
+let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
+let utf8 = ['\192'-'\255'] ['\128'-'\191']*
+let identstart_ext = uppercase | lowercase | utf8
+let identchar_ext = identchar | utf8
+let ident_ext = identstart_ext identchar_ext*
+
+
 let symbolchar =
   ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
 let decimal_literal = ['0'-'9']+
@@ -237,30 +251,31 @@ rule token = parse
   | "_"
       { print "_" ; token lexbuf }
   | "~"  { print "~" ; token lexbuf }
-  | "~" lowercase identchar * ':'
+  | "~" (ident_ext as raw_id ) ':'
       { let s = Lexing.lexeme lexbuf in
-        let name = String.sub s 1 (String.length s - 2) in
+        let name = normalize raw_id in
         if Hashtbl.mem keyword_table name then
           raise (Error(Keyword_as_label name, Lexing.lexeme_start lexbuf,
                        Lexing.lexeme_end lexbuf));
         print s ; token lexbuf }
   | "?"  { print "?" ; token lexbuf }
-  | "?" lowercase identchar * ':'
-      { let s = Lexing.lexeme lexbuf in
-        let name = String.sub s 1 (String.length s - 2) in
+  | "?" (ident_ext as raw_id)  ':'
+      {
+        let name = normalize raw_id in
         if Hashtbl.mem keyword_table name then
           raise (Error(Keyword_as_label name, Lexing.lexeme_start lexbuf,
                        Lexing.lexeme_end lexbuf));
-        print s ; token lexbuf }
-  | lowercase identchar *
-      { let s = Lexing.lexeme lexbuf in
-          try
+        print "?"; print name ; print ":"; token lexbuf }
+  | (ident_ext as raw_id)
+      {  let s = normalize raw_id in
+         if Misc.Utf8_lexeme.is_capitalized s then
+            (print_class constructor_class (Lexing.lexeme lexbuf);
+            token lexbuf)
+         else try
             let cl = Hashtbl.find keyword_table s in
             (print_class cl s ; token lexbuf )
           with Not_found ->
             (print s ; token lexbuf )}
-  | uppercase identchar *
-      { print_class constructor_class (Lexing.lexeme lexbuf) ; token lexbuf }       (* No capitalized keywords *)
   | decimal_literal | hex_literal | oct_literal | bin_literal
       { print (Lexing.lexeme lexbuf) ; token lexbuf }
   | float_literal

diff --git a/ocamldoc/odoc_print.ml b/ocamldoc/odoc_print.ml
index 918e588b05ca1fa5ae47294d114ab0acf9bb15cf..6a18cb884b54da7e03339ee48f424aa7e439dc70 100644 (file)
--- a/ocamldoc/odoc_print.ml
+++ b/ocamldoc/odoc_print.ml
@@ -14,7 +14,7 @@
 (**************************************************************************)
 
 open Format
-let () = Printtyp.Naming_context.enable false
+let () = Out_type.Ident_names.enable false
 
 let new_fmt () =
   let buf = Buffer.create 512 in

diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index acea5087e5b43f59601ca363f38b76c9c2d22190..27372d5ec13808033ac015d87ee5caa755251c5a 100644 (file)
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -121,7 +121,9 @@ module type Info_retriever =
 let alert_of_attribute attr =
   let open Parsetree in
   let load_constant_string = function
-    | { pexp_desc = Pexp_constant (Pconst_string (text, _, _)); _ } -> Some text
+    | { pexp_desc = Pexp_constant
+            { pconst_desc = Pconst_string (text, _, _); _ }; _ } ->
+        Some text
     | _ -> None
   in
   let load_alert_name name = Longident.last name.Location.txt in
@@ -1885,7 +1887,7 @@ module Analyser =
         (ast : Parsetree.signature) (signat : Types.signature) =
       prepare_file source_file input_file;
       (* We create the t_module for this file. *)
-      let mod_name = Unit_info.modname_from_source source_file in
+      let mod_name = Unit_info.lax_modname_from_source source_file in
       let len, info_opt = preamble !file_name !file
           (fun x -> x.Parsetree.psig_loc) ast in
       let info_opt = analyze_toplevel_alerts info_opt ast in

diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml
index 3d6cf8a57a95cef62adde3c527d1db3a8533880d..ce43a6575fa93b8d5d31c1ab269b005d60a542be 100644 (file)
--- a/ocamldoc/odoc_str.ml
+++ b/ocamldoc/odoc_str.ml
@@ -16,7 +16,7 @@
 (** The functions to get a string from different kinds of elements (types, modules, ...). *)
 
 module Name = Odoc_name
-let () = Printtyp.Naming_context.enable false
+let () = Out_type.Ident_names.enable false
 
 let string_of_variance t v =
   if ( t.Odoc_type.ty_kind = Odoc_type.Type_abstract ||
@@ -136,7 +136,7 @@ let string_of_class_params c =
           (
            match label with
              Asttypes.Nolabel -> ""
-           | s -> Printtyp.string_of_label s ^":"
+           | s -> Asttypes.string_of_label s ^":"
           )
           (if parent then "(" else "")
           (Odoc_print.string_of_type_expr

diff --git a/ocamltest/builtin_actions.ml b/ocamltest/builtin_actions.ml
index 1af3b0855919e41a63acc787543589c7b2a1fb81..0f06062f8b6cf0136493b22418f5e8060c7abaec 100644 (file)
--- a/ocamltest/builtin_actions.ml
+++ b/ocamltest/builtin_actions.ml
@@ -120,6 +120,13 @@ let not_windows = make
     "not running on Windows"
     "running on Windows")
 
+let not_msvc = make
+  ~name:"not-msvc"
+  ~description:"Pass if not using MSVC / clang-cl"
+  (Actions_helpers.pass_or_skip (Ocamltest_config.ccomptype <> "msvc")
+    "not using MSVC / clang-cl"
+    "using MSVC / clang-cl")
+
 let is_bsd_system s =
   match s with
   | "bsd_elf" | "netbsd" | "freebsd" | "openbsd" -> true
@@ -148,6 +155,16 @@ let macos = make
     "on a MacOS system"
     "not on a MacOS system")
 
+let not_macos_amd64_tsan = make
+  ~name:"not_macos_amd64_tsan"
+  ~description:"Pass if not running on a MacOS amd64 system with TSan enabled"
+  (Actions_helpers.pass_or_skip
+     (not ((Ocamltest_config.system = macos_system)
+           && (String.equal Ocamltest_config.arch "amd64")
+           && (Ocamltest_config.tsan)))
+     "not on a MacOS amd64 system with TSan enabled"
+     "on a MacOS amd64 system with TSan enabled")
+
 let arch32 = make
   ~name:"arch32"
   ~description:"Pass if running on a 32-bit architecture"
@@ -197,6 +214,20 @@ let arch_power = make
     "Target is POWER architecture"
     "Target is not POWER architecture")
 
+let arch_riscv64 = make
+  ~name:"arch_riscv64"
+  ~description:"Pass if target is a RiscV64 architecture"
+  (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "riscv64")
+     "Target is RiscV64 architecture"
+     "Target is not RiscV64 architecture")
+
+let arch_s390x = make
+  ~name:"arch_s390x"
+  ~description:"Pass if target is a S390x architecture"
+  (Actions_helpers.pass_or_skip (String.equal Ocamltest_config.arch "s390x")
+     "Target is S390x architecture"
+     "Target is not S390x architecture")
+
 let function_sections = make
   ~name:"function_sections"
   ~description:"Pass if target supports function sections"
@@ -340,9 +371,11 @@ let _ =
     libwin32unix;
     windows;
     not_windows;
+    not_msvc;
     bsd;
     not_bsd;
     macos;
+    not_macos_amd64_tsan;
     arch32;
     arch64;
     has_symlink;
@@ -356,6 +389,8 @@ let _ =
     arch_amd64;
     arch_i386;
     arch_power;
+    arch_riscv64;
+    arch_s390x;
     function_sections;
     frame_pointers;
     file_exists;

diff --git a/ocamltest/main.ml b/ocamltest/main.ml
index bc2a2c34adf5866a388dbae9153a2ca16ae02535..e6cb480078faac9ab2cb2f43bc9974243158417a 100644 (file)
--- a/ocamltest/main.ml
+++ b/ocamltest/main.ml
@@ -30,7 +30,7 @@ let announce_test_error test_filename error =
   Printf.printf " ... testing '%s' => unexpected error (%s)\n%!"
     (Filename.basename test_filename) error
 
-let print_exn loc e =
+let print_exn loc e bt =
   let open Printf in
   let locstring =
     if loc = Location.none then "" else begin
@@ -42,19 +42,19 @@ let print_exn loc e =
   let msg =
     match e with
     | Variables.Variable_already_registered v ->
-      sprintf "Variable \"%s\" is already in the environment." v
+      sprintf "Variable \"%s\" is already in the environment.\n" v
     | Variables.No_such_variable v ->
-      sprintf "Variable \"%s\" is not in the environment." v
+      sprintf "Variable \"%s\" is not in the environment.\n" v
     | Environments.Modifiers_name_not_found name ->
-      sprintf "Environment modifier \"%s\" does not exist." name
+      sprintf "Environment modifier \"%s\" does not exist.\n" name
     | Tsl_semantics.No_such_test_or_action name ->
-      sprintf "This is not the name of a test or an action: \"%s\"." name
+      sprintf "This is not the name of a test or an action: \"%s\".\n" name
     | Ocaml_actions.Cannot_compile_file_type t ->
-      sprintf "Cannot compile files of type %s." t
+      sprintf "Cannot compile files of type %s.\n" t
     | _ ->
-      sprintf "Unexpected exception: %s" (Printexc.to_string e)
+      sprintf "Unexpected exception: %s\n%s" (Printexc.to_string e) bt
   in
-  eprintf "\n%s%s\n%!" locstring msg
+  eprintf "\n%s%s%!" locstring msg
 
 exception Syntax_error of Lexing.position
 
@@ -84,8 +84,8 @@ let tsl_parse_file_safe test_filename =
 let print_usage () =
   Printf.printf "%s\n%!" Options.usage
 
-let report_error loc e =
-  print_exn loc e;
+let report_error loc e bt =
+  print_exn loc e bt;
   "=> error in test script"
 
 type result_summary = No_failure | Some_failure | All_skipped
@@ -104,16 +104,21 @@ let join_summaries sa sb =
   | All_skipped, All_skipped -> All_skipped
   | _ -> No_failure
 
-let rec run_test_tree log common_prefix behavior env summ ast =
+let string_of_summary = function
+  | No_failure -> "passed"
+  | Some_failure -> "failed"
+  | All_skipped -> "skipped"
+
+let rec run_test_tree log add_msg behavior env summ ast =
   match ast with
   | Ast (Environment_statement s :: stmts, subs) ->
     begin match interpret_environment_statement env s with
     | env ->
-      run_test_tree log common_prefix behavior env summ (Ast (stmts, subs))
+      run_test_tree log add_msg behavior env summ (Ast (stmts, subs))
     | exception e ->
+      let bt = Printexc.get_backtrace () in
       let line = s.loc.Location.loc_start.Lexing.pos_lnum in
-      Printf.printf "%s line %d %!" common_prefix line;
-      Printf.printf "%s\n%!" (report_error s.loc e);
+      Printf.ksprintf add_msg "line %d %s" line (report_error s.loc e bt);
       Some_failure
     end
   | Ast (Test (_, name, mods) :: stmts, subs) ->
@@ -123,7 +128,6 @@ let rec run_test_tree log common_prefix behavior env summ ast =
       else
         Printf.sprintf "line %d" name.loc.Location.loc_start.Lexing.pos_lnum
     in
-    Printf.printf "%s %s (%s) %!" common_prefix locstr name.node;
     let (msg, children_behavior, newenv, result) =
       match behavior with
       | Skip_all -> ("=> n/a", Skip_all, env, Result.skip)
@@ -135,16 +139,18 @@ let rec run_test_tree log common_prefix behavior env summ ast =
           let msg = Result.string_of_result result in
           let sub_behavior = if Result.is_pass result then Run else Skip_all in
           (msg, sub_behavior, newenv, result)
-        with e -> (report_error name.loc e, Skip_all, env, Result.fail)
+        with e ->
+          let bt = Printexc.get_backtrace () in
+          (report_error name.loc e bt, Skip_all, env, Result.fail)
         end
     in
-    Printf.printf "%s\n%!" msg;
+    Printf.ksprintf add_msg "%s (%s) %s" locstr name.node msg;
     let newsumm = join_result summ result in
     let newast = Ast (stmts, subs) in
-    run_test_tree log common_prefix children_behavior newenv newsumm newast
+    run_test_tree log add_msg children_behavior newenv newsumm newast
   | Ast ([], subs) ->
     List.fold_left join_summaries summ
-      (List.map (run_test_tree log common_prefix behavior env All_skipped) subs)
+      (List.map (run_test_tree log add_msg behavior env All_skipped) subs)
 
 let get_test_source_directory test_dirname =
   if (Filename.is_relative test_dirname) then
@@ -238,32 +244,43 @@ let test_file test_filename =
              Builtin_variables.promote, promote;
              Builtin_variables.timeout, default_timeout;
            ] in
-       let common_prefix = " ... testing '" ^ test_basename ^ "' with" in
        let initial_status = if skip_test then Skip_all else Run in
        let rootenv =
          Environments.initialize Environments.Pre log initial_environment
        in
-       let rootenv, initial_status =
+       let msgs = ref [] in
+       let add_msg s = msgs := s :: !msgs in
+       let rootenv, initial_status, initial_summary =
          let rec loop env stmts =
            match stmts with
-           | [] -> (env, initial_status)
+           | [] -> (env, initial_status, All_skipped)
            | s :: t ->
              begin match interpret_environment_statement env s with
              | env -> loop env t
              | exception e ->
+               let bt = Printexc.get_backtrace () in
                let line = s.loc.Location.loc_start.Lexing.pos_lnum in
-               Printf.printf "%s line %d %!" common_prefix line;
-               Printf.printf "%s\n%!" (report_error s.loc e);
-               (env, Skip_all)
+               Printf.ksprintf add_msg "line %d %s" line
+                 (report_error s.loc e bt);
+               (env, Skip_all, Some_failure)
              end
          in
          loop rootenv rootenv_statements
        in
        let rootenv = Environments.initialize Environments.Post log rootenv in
        let summary =
-         run_test_tree log common_prefix initial_status rootenv All_skipped
+         run_test_tree log add_msg initial_status rootenv initial_summary
            tsl_ast
        in
+       let common_prefix = " ... testing '" ^ test_basename ^ "'" in
+       Printf.printf "%s => %s%s\n%!" common_prefix (string_of_summary summary)
+         (if Options.show_timings && summary = No_failure then
+            let wall_clock_duration = Unix.gettimeofday () -. start in
+            Printf.sprintf " (wall clock: %.02fs)" wall_clock_duration
+          else "");
+       if summary = Some_failure then
+         List.iter (Printf.printf "%s with %s\n%!" common_prefix)
+           (List.rev !msgs);
        Actions.clear_all_hooks();
        summary
     ) in
@@ -275,11 +292,7 @@ let test_file test_filename =
   | No_failure | All_skipped ->
       if not Options.keep_test_dir_on_success then
         clean_test_build_directory ()
-  end;
-  if Options.show_timings && summary = No_failure then
-    let wall_clock_duration = Unix.gettimeofday () -. start in
-    Printf.eprintf "Wall clock: %s took %.02fs\n%!"
-                   test_filename wall_clock_duration
+  end
 
 let is_test filename =
   let input_channel = open_in filename in

diff --git a/ocamltest/ocaml_actions.ml b/ocamltest/ocaml_actions.ml
index 7a7237316679902ee846a1d4ce235f4e10ae89ea..4c261d93144fc5051987fa22dfaf0e5e91c6762c 100644 (file)
--- a/ocamltest/ocaml_actions.ml
+++ b/ocamltest/ocaml_actions.ml
@@ -189,23 +189,26 @@ let is_c_file (_filename, filetype) = filetype=Ocaml_filetypes.C
 
 let cmas_need_dynamic_loading directories libraries =
   let loads_c_code library =
-    let library = Misc.find_in_path directories library in
-    let ic = open_in_bin library in
-    try
-      let len_magic_number = String.length Config.cma_magic_number in
-      let magic_number = really_input_string ic len_magic_number in
-      if magic_number = Config.cma_magic_number then
-        let toc_pos = input_binary_int ic in
-        seek_in ic toc_pos;
-        let toc = (input_value ic : Cmo_format.library) in
-        close_in ic;
-        if toc.Cmo_format.lib_dllibs <> [] then Some (Ok ()) else None
-      else
-        raise End_of_file
-    with End_of_file
-       | Sys_error _ ->
-         begin try close_in ic with Sys_error _ -> () end;
-         Some (Error ("Corrupt or non-CMA file: " ^ library))
+    match Misc.find_in_path directories library with
+    | exception Not_found ->
+      Some (Error ("file not found in include path: " ^ library))
+    | library ->
+      let ic = open_in_bin library in
+      try
+        let len_magic_number = String.length Config.cma_magic_number in
+        let magic_number = really_input_string ic len_magic_number in
+        if magic_number = Config.cma_magic_number then
+          let toc_pos = input_binary_int ic in
+          seek_in ic toc_pos;
+          let toc = (input_value ic : Cmo_format.library) in
+          close_in ic;
+          if toc.Cmo_format.lib_dllibs <> [] then Some (Ok ()) else None
+        else
+          raise End_of_file
+      with End_of_file
+         | Sys_error _ ->
+           begin try close_in ic with Sys_error _ -> () end;
+           Some (Error ("Corrupt or non-CMA file: " ^ library))
   in
   List.find_map loads_c_code (String.words libraries)
 

diff --git a/ocamltest/ocamltest_config.ml.in b/ocamltest/ocamltest_config.ml.in
index 7bffd552d9e6e6d9edf2ca3da738bc26db099ddc..2c53e45ce39f3faf11885016a28ed3db4b96408b 100644 (file)
--- a/ocamltest/ocamltest_config.ml.in
+++ b/ocamltest/ocamltest_config.ml.in
@@ -25,11 +25,11 @@ let asm = {@QS@|@AS@|@QS@}
 
 let cpp = {@QS@|@ocamltest_CPP@|@QS@}
 
-let cppflags = {@QS@|@oc_cppflags@|@QS@}
+let cppflags = {@QS@|@common_cppflags@|@QS@}
 
 let cc = {@QS@|@CC@|@QS@}
 
-let cflags = {@QS@|@oc_cflags@|@QS@}
+let cflags = {@QS@|@common_cflags@|@QS@}
 
 let ccomptype = {@QS@|@ccomptype@|@QS@}
 

diff --git a/ocamltest/run_stubs.c b/ocamltest/run_stubs.c
index 29fa27456ff23a6009508832391f0d87013119b6..aa5c716becbb269ae06450357612167fd3de2203 100644 (file)
--- a/ocamltest/run_stubs.c
+++ b/ocamltest/run_stubs.c
@@ -36,11 +36,11 @@
 static array cstringvect(value arg)
 {
   array res;
-  mlsize_t size, i;
+  mlsize_t size;
 
   size = Wosize_val(arg);
   res = (array) caml_stat_alloc((size + 1) * sizeof(char_os *));
-  for (i = 0; i < size; i++)
+  for (mlsize_t i = 0; i < size; i++)
     res[i] = caml_stat_strdup_to_os(String_val(Field(arg, i)));
   res[size] = NULL;
   return res;
@@ -48,8 +48,7 @@ static array cstringvect(value arg)
 
 static void free_cstringvect(array v)
 {
-  char_os **p;
-  for (p = v; *p != NULL; p++)
+  for (char_os **p = v; *p != NULL; p++)
     caml_stat_free(*p);
   caml_stat_free(v);
 }

diff --git a/ocamltest/run_unix.c b/ocamltest/run_unix.c
index 60a0e5f9df595db0db2aab6d117f34511aa3ad5f..a800bd732aea12ca2cd59298d4b807e789ef3658 100644 (file)
--- a/ocamltest/run_unix.c
+++ b/ocamltest/run_unix.c
@@ -135,8 +135,7 @@ static int paths_same_file(
 
 static void update_environment(array local_env)
 {
-  array envp;
-  for (envp = local_env; *envp != NULL; envp++) {
+  for (array envp = local_env; *envp != NULL; envp++) {
     char *pos_eq = strchr(*envp, '=');
     if (pos_eq != NULL) {
       char *name, *value;

diff --git a/ocamltest/run_win32.c b/ocamltest/run_win32.c
index fc512a15175cadb046cad05eb5d7518b685c7881..5f5520623729b869b97b1acd952d4536fd7441c7 100644 (file)
--- a/ocamltest/run_win32.c
+++ b/ocamltest/run_win32.c
@@ -42,7 +42,7 @@ static void report_error(
 {
   WCHAR windows_error_message[1024];
   DWORD error = GetLastError();
-  char *caml_error_message, buf[256];
+  char *caml_error_message;
   if (FormatMessage(
     FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
     NULL, error, 0, windows_error_message,
@@ -111,7 +111,7 @@ static WCHAR *find_program(const WCHAR *program_name)
 
 static WCHAR *commandline_of_arguments(WCHAR **arguments)
 {
-  WCHAR *commandline = NULL, **arguments_p, *commandline_p;
+  WCHAR *commandline = NULL, *commandline_p;
   int args = 0; /* Number of arguments */
   int commandline_length = 0;
 
@@ -119,7 +119,7 @@ static WCHAR *commandline_of_arguments(WCHAR **arguments)
   /* From here we know there is at least one argument */
 
   /* First compute number of arguments and commandline length */
-  for (arguments_p = arguments; *arguments_p != NULL; arguments_p++)
+  for (WCHAR **arguments_p = arguments; *arguments_p != NULL; arguments_p++)
   {
     args++;
     commandline_length += wcslen(*arguments_p);
@@ -130,7 +130,7 @@ static WCHAR *commandline_of_arguments(WCHAR **arguments)
   commandline = malloc(commandline_length*sizeof(WCHAR));
   if (commandline == NULL) return NULL;
   commandline_p = commandline;
-  for (arguments_p = arguments; *arguments_p!=NULL; arguments_p++)
+  for (WCHAR **arguments_p = arguments; *arguments_p != NULL; arguments_p++)
   {
     int l = wcslen(*arguments_p);
     memcpy(commandline_p, *arguments_p, l*sizeof(WCHAR));
@@ -145,7 +145,6 @@ static WCHAR *commandline_of_arguments(WCHAR **arguments)
 static LPVOID prepare_environment(WCHAR **localenv)
 {
   LPTCH p, r, env, process_env = NULL;
-  WCHAR **q;
   int l, process_env_length, localenv_length, env_length;
 
   if (localenv == NULL) return NULL;
@@ -164,7 +163,7 @@ static LPVOID prepare_environment(WCHAR **localenv)
 
   /* Compute length of local environment */
   localenv_length = 0;
-  for (q = localenv; *q != NULL; q++) {
+  for (WCHAR **q = localenv; *q != NULL; q++) {
     localenv_length += wcslen(*q) + 1;
   }
 
@@ -184,7 +183,7 @@ static LPVOID prepare_environment(WCHAR **localenv)
     l = wcslen(p) + 1; /* also count terminating '\0' */
     /* Temporarily change the = to \0 for wcscmp */
     *pos_eq = L'\0';
-    for (q = localenv; *q != NULL; q++) {
+    for (WCHAR **q = localenv; *q != NULL; q++) {
       wchar_t *pos_eq2 = wcschr(*q, L'=');
       /* Compare this name in localenv with the current one in processenv */
       if (pos_eq2) *pos_eq2 = L'\0';
@@ -200,7 +199,7 @@ static LPVOID prepare_environment(WCHAR **localenv)
     p += l;
   }
   FreeEnvironmentStrings(process_env);
-  for (q = localenv; *q != NULL; q++) {
+  for (WCHAR **q = localenv; *q != NULL; q++) {
     /* A string in localenv without '=' signals deletion, which has been done */
     wchar_t *pos_eq = wcschr(*q, L'=');
     if (pos_eq) {
@@ -273,7 +272,6 @@ int run_command(const command_settings *settings)
   WCHAR *commandline = NULL;
 
   LPVOID environment = NULL;
-  LPCWSTR current_directory = NULL;
   STARTUPINFO startup_info;
   PROCESS_INFORMATION process_info;
   BOOL wait_result;

diff --git a/otherlibs/Makefile b/otherlibs/Makefile
index 5fe2d750cdfdff96195a3ca24c0688e2c17714c7..d76643bd297bc6bec2cd57314a559c007dc49557 100644 (file)
--- a/otherlibs/Makefile
+++ b/otherlibs/Makefile
@@ -16,17 +16,17 @@
 ROOTDIR=..
 include $(ROOTDIR)/Makefile.common
 
-# Also the OTHERLIBRARIES variable is defined in ../Makefile.config,
-#  its following conditional definition needs to be kept because,
+# Although the OTHERLIBS variable is defined in ../Makefile.config,
+# its following conditional definition needs to be kept because,
 # at the moment, the clean targets depend on this variable but
 # when they are invoked ../Makefile.config is not included, so that
-# OTHERLIBRARIES would be empty and the clean targets would thus not work.
-OTHERLIBRARIES ?= dynlink str systhreads unix runtime_events
+# OTHERLIBS would be empty and the clean target would thus not work.
+OTHERLIBS ?= str systhreads unix runtime_events
 
 # $1: target name to dispatch to all otherlibs/*/Makefile
 define dispatch_
 $1:
-       for lib in $$(OTHERLIBRARIES); do \
+       for lib in $$(OTHERLIBS); do \
          ($$(MAKE) -C $$$$lib $1) || exit $$$$?; \
        done
 endef

diff --git a/otherlibs/Makefile.otherlibs.common b/otherlibs/Makefile.otherlibs.common
index 53667c7954885701352b13b41ea0e6e1a100d89e..f08dd13ef8cc2d9114e2bc0840aba9fd130564c6 100644 (file)
--- a/otherlibs/Makefile.otherlibs.common
+++ b/otherlibs/Makefile.otherlibs.common
@@ -34,7 +34,7 @@ COMPFLAGS=-absname -w +a-4-9-41-42-44-45-48 -warn-error +A -bin-annot -g \
 ifeq "$(FLAMBDA)" "true"
 OPTCOMPFLAGS += -O3
 endif
-MKLIB=$(OCAMLRUN) $(ROOTDIR)/tools/ocamlmklib
+MKLIB=$(OCAMLRUN) $(ROOTDIR)/tools/ocamlmklib$(EXE)
 
 # Variables that must be defined by individual libraries:
 # LIBNAME
@@ -161,14 +161,14 @@ distclean:: clean
        $(V_OCAMLOPT)$(CAMLOPT) -c $(COMPFLAGS) $(OPTCOMPFLAGS) $<
 
 %.b.$(O): %.c $(REQUIRED_HEADERS)
-       $(V_CC)$(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
-         $(OUTPUTOBJ)$@ $<
+       $(V_CC)$(CC) $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
+         $(OUTPUTOBJ)$@ -c $<
 
 %.n.$(O): OC_CFLAGS += $(OC_NATIVE_CFLAGS)
 
 %.n.$(O): %.c $(REQUIRED_HEADERS)
-       $(V_CC)$(CC) -c $(OC_CFLAGS) $(CFLAGS) \
-         $(OC_CPPFLAGS) $(CPPFLAGS) $(OUTPUTOBJ)$@ $<
+       $(V_CC)$(CC) $(OC_CFLAGS) $(CFLAGS) \
+         $(OC_CPPFLAGS) $(CPPFLAGS) $(OUTPUTOBJ)$@ -c $<
 
 ifeq "$(COMPUTE_DEPS)" "true"
 ifneq "$(COBJS_BYTECODE)" ""

diff --git a/otherlibs/dynlink/.depend b/otherlibs/dynlink/.depend
deleted file mode 100644 (file)
index b55bcf5..0000000
--- a/otherlibs/dynlink/.depend
+++ /dev/null
@@ -1,36 +0,0 @@
-byte/dynlink.cmo : \
-    dynlink_types.cmi \
-    byte/dynlink_compilerlibs.cmi \
-    dynlink_common.cmi \
-    byte/dynlink.cmi
-dynlink.cmi :
-dynlink_common.cmo : \
-    dynlink_types.cmi \
-    dynlink_platform_intf.cmi \
-    byte/dynlink_compilerlibs.cmi \
-    dynlink_common.cmi
-dynlink_common.cmi : \
-    dynlink_platform_intf.cmi
-dynlink_platform_intf.cmo : \
-    dynlink_types.cmi \
-    dynlink_platform_intf.cmi
-dynlink_platform_intf.cmi : \
-    dynlink_types.cmi
-dynlink_types.cmo : \
-    dynlink_types.cmi
-dynlink_types.cmi :
-dynlink_common.cmx : \
-    dynlink_types.cmx \
-    dynlink_platform_intf.cmx \
-    native/dynlink_compilerlibs.cmx \
-    dynlink_common.cmi
-dynlink_platform_intf.cmx : \
-    dynlink_types.cmx \
-    dynlink_platform_intf.cmi
-dynlink_types.cmx : \
-    dynlink_types.cmi
-native/dynlink.cmx : \
-    dynlink_types.cmx \
-    native/dynlink_compilerlibs.cmx \
-    dynlink_common.cmx \
-    native/dynlink.cmi

diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile
deleted file mode 100644 (file)
index 9773e8b..0000000
--- a/otherlibs/dynlink/Makefile
+++ /dev/null
@@ -1,329 +0,0 @@
-#**************************************************************************
-#*                                                                        *
-#*                                 OCaml                                  *
-#*                                                                        *
-#*            Xavier Leroy, projet Cristal, INRIA Rocquencourt            *
-#*                     Mark Shinwell, Jane Street Europe                  *
-#*                                                                        *
-#*   Copyright 1999 Institut National de Recherche en Informatique et     *
-#*     en Automatique.                                                    *
-#*   Copyright 2018--2019 Jane Street Group LLC                           *
-#*                                                                        *
-#*   All rights reserved.  This file is distributed under the terms of    *
-#*   the GNU Lesser General Public License version 2.1, with the          *
-#*   special exception on linking described in the file LICENSE.          *
-#*                                                                        *
-#**************************************************************************
-
-# Makefile for the dynamic link library
-
-# FIXME reduce redundancy by including ../Makefile
-
-ROOTDIR = ../..
-
-include $(ROOTDIR)/Makefile.common
-include $(ROOTDIR)/Makefile.best_binaries
-
-OCAMLC=$(BEST_OCAMLC) $(STDLIBFLAGS) -g
-OCAMLOPT=$(BEST_OCAMLOPT) $(STDLIBFLAGS) -g
-
-# COMPFLAGS should be in sync with the toplevel Makefile's COMPFLAGS.
-COMPFLAGS=-strict-sequence -principal -absname \
-          -w +a-4-9-40-41-42-44-45-48 -warn-error +A \
-          -bin-annot -strict-formats
-ifeq "$(FLAMBDA)" "true"
-OPTCOMPFLAGS += -O3
-endif
-
-%.cmo: COMPFLAGS += -I byte
-%.cmi: COMPFLAGS += -I byte
-OPTCOMPFLAGS += -I native
-
-LOCAL_SRC=dynlink_compilerlibs
-
-OBJS=byte/dynlink_compilerlibs.cmo dynlink_types.cmo \
-  dynlink_platform_intf.cmo dynlink_common.cmo byte/dynlink.cmo
-
-NATOBJS=native/dynlink_compilerlibs.cmx dynlink_types.cmx \
-  dynlink_platform_intf.cmx dynlink_common.cmx native/dynlink.cmx
-
-# We need/desire access to compilerlibs for various reasons:
-# - The bytecode dynamic linker is in compilerlibs and has many dependencies
-#   from there.
-# - It stops duplication of code (e.g. magic numbers from [Config]).
-# - It allows future improvement by re-using various types.
-# We have to pack our own version of compilerlibs (even if compilerlibs
-# becomes packed in the future by default) otherwise problems will be caused
-# if a user tries to link dynlink.cm{x,}a with code either having modules
-# of the same names or code that is already linked against compilerlibs.
-#
-# The modules needed from compilerlibs have to be recompiled so that the
-# -for-pack option can be specified.  Packing without such option having been
-# specified, as used to be performed in this Makefile, is currently permitted
-# for bytecode (but may be disallowed in the future) but not native.
-
-# .mli files from compilerlibs that don't have a corresponding .ml file.
-COMPILERLIBS_INTFS=\
-  parsing/asttypes.mli \
-  parsing/parsetree.mli \
-  typing/outcometree.mli \
-  typing/value_rec_types.mli \
-  file_formats/cmo_format.mli \
-  file_formats/cmxs_format.mli
-
-# .ml files from compilerlibs that have corresponding .mli files.
-COMPILERLIBS_SOURCES=\
-  utils/binutils.ml \
-  utils/config.ml \
-  utils/build_path_prefix_map.ml \
-  utils/misc.ml \
-  utils/identifiable.ml \
-  utils/numbers.ml \
-  utils/arg_helper.ml \
-  utils/local_store.ml \
-  utils/load_path.ml \
-  utils/clflags.ml \
-  utils/profile.ml \
-  utils/consistbl.ml \
-  utils/terminfo.ml \
-  utils/warnings.ml \
-  utils/int_replace_polymorphic_compare.ml \
-  utils/lazy_backtrack.ml \
-  utils/compression.ml \
-  parsing/location.ml \
-  parsing/unit_info.ml \
-  parsing/longident.ml \
-  parsing/docstrings.ml \
-  parsing/syntaxerr.ml \
-  parsing/ast_helper.ml \
-  parsing/ast_iterator.ml \
-  parsing/builtin_attributes.ml \
-  parsing/ast_mapper.ml \
-  parsing/camlinternalMenhirLib.ml \
-  parsing/parser.ml \
-  parsing/lexer.ml \
-  parsing/attr_helper.ml \
-  typing/ident.ml \
-  typing/path.ml \
-  typing/primitive.ml \
-  typing/type_immediacy.ml \
-  typing/shape.ml \
-  typing/types.ml \
-  typing/btype.ml \
-  typing/subst.ml \
-  typing/predef.ml \
-  typing/datarepr.ml \
-  file_formats/cmi_format.ml \
-  typing/persistent_env.ml \
-  typing/env.ml \
-  typing/shape_reduce.ml \
-  typing/typedtree.ml \
-  lambda/debuginfo.ml \
-  lambda/lambda.ml \
-  lambda/runtimedef.ml \
-  bytecomp/instruct.ml \
-  bytecomp/opcodes.ml \
-  bytecomp/bytesections.ml \
-  bytecomp/dll.ml \
-  bytecomp/meta.ml \
-  bytecomp/symtable.ml
-
-# For the native-code version of this library, we need much fewer modules
-MINI_COMPILERLIBS_INTFS=\
-  file_formats/cmxs_format.mli
-
-MINI_COMPILERLIBS_SOURCES=\
-  utils/binutils.ml \
-  utils/config.ml \
-  utils/build_path_prefix_map.ml \
-  utils/misc.ml
-
-# Rules to make a local copy of the .ml and .mli files required.  We also
-# provide .ml files for .mli-only modules---without this, such modules do
-# not seem to be located by the type checker inside bytecode packs.
-# Note: .ml-only modules are not supported by the (.mli.cmi) rule below.
-
-$(LOCAL_SRC)/Makefile: $(LOCAL_SRC)/Makefile.copy-sources Makefile
-       $(V_GEN)cp -f $< $@ && \
-       for ml in $(COMPILERLIBS_SOURCES); do \
-          echo "$(LOCAL_SRC)/$$(basename $$ml): $(ROOTDIR)/$$ml" \
-            >> $@; \
-          echo "$(LOCAL_SRC)/$$(basename $$ml)i: $(ROOTDIR)/$${ml}i" \
-            >> $@; \
-        done && \
-       for mli in $(COMPILERLIBS_INTFS); do \
-          echo "$(LOCAL_SRC)/$$(basename $$mli): $(ROOTDIR)/$$mli" \
-            >> $@; \
-          echo \
-            "$(LOCAL_SRC)/$$(basename $$mli .mli).ml: $(ROOTDIR)/$$mli"\
-            >> $@; \
-        done
-
-# Rules to automatically generate dependencies for the local copy of the
-# compilerlibs sources.
-
-COMPILERLIBS_SOURCES_NO_DIRS=$(notdir $(COMPILERLIBS_SOURCES))
-
-COMPILERLIBS_INTFS_NO_DIRS=$(notdir $(COMPILERLIBS_INTFS))
-
-COMPILERLIBS_INTFS_BASE_NAMES=$(basename $(COMPILERLIBS_INTFS_NO_DIRS))
-
-COMPILERLIBS_INTFS_ML_NO_DIRS=$(addsuffix .ml, $(COMPILERLIBS_INTFS_BASE_NAMES))
-
-COMPILERLIBS_COPIED_INTFS=\
-  $(addprefix $(LOCAL_SRC)/, $(COMPILERLIBS_INTFS_ML_NO_DIRS))
-
-COMPILERLIBS_COPIED_SOURCES=\
-  $(addprefix $(LOCAL_SRC)/, $(COMPILERLIBS_SOURCES_NO_DIRS)) \
-  $(COMPILERLIBS_COPIED_INTFS)
-
-COMPILERLIBS_SOURCES_INTFS=\
-  $(addsuffix i, $(COMPILERLIBS_SOURCES))
-
-COMPILERLIBS_COPIED_SOURCES_INTFS=\
-  $(addsuffix i, $(COMPILERLIBS_COPIED_SOURCES))
-
-MINI_COMPILERLIBS_COPIED_SOURCES=\
-  $(addprefix $(LOCAL_SRC)/, $(notdir $(MINI_COMPILERLIBS_SOURCES))) \
-  $(addprefix $(LOCAL_SRC)/, $(notdir $(MINI_COMPILERLIBS_INTFS)))
-
-# $(LOCAL_SRC)/Makefile uses the variables above in dependencies, so must be
-# include'd after they've been defined.
--include $(LOCAL_SRC)/Makefile
-
-# Rules to build the local copy of the compilerlibs sources in such a way
-# that the resulting .cm{o,x} files can be packed.
-
-COMPILERLIBS_CMO=$(COMPILERLIBS_COPIED_SOURCES:.ml=.cmo)
-COMPILERLIBS_CMX=$(MINI_COMPILERLIBS_COPIED_SOURCES:.ml=.cmx)
-
-$(LOCAL_SRC)/%.cmi: $(LOCAL_SRC)/%.mli
-       $(V_OCAMLC)$(OCAMLC) -c -for-pack Dynlink_compilerlibs $(COMPFLAGS) \
-          -I $(LOCAL_SRC) -o $@ $(LOCAL_SRC)/$*.mli
-
-$(LOCAL_SRC)/%.cmo: $(LOCAL_SRC)/%.ml
-       $(V_OCAMLC)$(OCAMLC) -c -for-pack Dynlink_compilerlibs $(COMPFLAGS) \
-          -I $(LOCAL_SRC) -o $@ $(LOCAL_SRC)/$*.ml
-
-$(LOCAL_SRC)/%.cmx: $(LOCAL_SRC)/%.ml
-       $(V_OCAMLOPT)$(OCAMLOPT) -c -for-pack Dynlink_compilerlibs $(COMPFLAGS) \
-          $(OPTCOMPFLAGS) -I $(LOCAL_SRC) -o $@ $(LOCAL_SRC)/$*.ml
-
-# Rules for building the [Dynlink_compilerlibs] bytecode and native packs
-# from their components.
-
-# A multi-target pattern rule can tell GNU make that the recipe simultaneously
-# produces both the cmo and cmi file for Dynlink_compilerlibs. GNU make 4.3+
-# would be required to do the same thing with a static rule (with its grouped
-# targets feature).
-byt%/dynlink_compilerlibs.cmo byt%/dynlink_compilerlibs.cmi: $(COMPILERLIBS_CMO)
-       @$(if $(filter-out e,$*),\
-        $(error Should only build byte/dynlink_compilerlibs.cmo!))
-       $(V_OCAMLC)$(OCAMLC) $(COMPFLAGS) -pack -o byte/dynlink_compilerlibs.cmo $^
-
-native/dynlink_compilerlibs.cmx: $(COMPILERLIBS_CMX)
-       $(V_OCAMLOPT)$(OCAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -pack -o $@ $(COMPILERLIBS_CMX)
-
-%/dynlink.cmi: dynlink.cmi dynlink.mli
-       cp $^ $*/
-
-# Rules for building the interface of the [Dynlink_compilerlibs] packs.
-# To avoid falling foul of the problem described below, the .cmo and .cmx
-# files for the dynlink-specific compilerlibs packs generated here---and in
-# particular the corresponding .cmi files -- are kept in separate directories.
-
-# The main dynlink rules start here.
-
-all: dynlink.cma
-
-allopt: dynlink.cmxa
-
-dynlink.cma: $(OBJS)
-       $(V_LINKC)$(OCAMLC) $(COMPFLAGS) -ccopt "$(NATDYNLINKOPTS)" -a -I byte -o $@ $^
-
-dynlink.cmxa: $(NATOBJS)
-       $(V_LINKOPT)$(OCAMLOPT) $(COMPFLAGS) -ccopt "$(NATDYNLINKOPTS)" -a -I native \
-                   -o $@ $^
-# As for all other .cmxa files, ensure that the .cmx files are in the same
-# directory. If this were omitted, ocamldoc in particular will fail to build
-# with a -opaque warning. Note that installopt refers to $(NATOBJS) so doesn't
-# require this file to exist, hence its inclusion in the recipe for dynlink.cmxa
-# rather than as a dependency elsewhere.
-       cp native/dynlink.cmx dynlink.cmx
-
-# Since there is no .mli for [Dynlink_platform_intf], we need to be
-# careful that compilation of the .cmx file does not write the .cmi file again,
-# which would cause rebuilding of ocamlopt.  The easiest way to do this seems
-# to be to copy the .ml file, which is a valid .mli, to the .mli.
-dynlink_platform_intf.mli: dynlink_platform_intf.ml
-       cp $< $@
-
-INSTALL_LIBDIR_DYNLINK = $(INSTALL_LIBDIR)/dynlink
-
-install:
-# If installing over a previous OCaml version, ensure dynlink is removed from
-# the previous installation.
-       rm -f "$(INSTALL_LIBDIR)"/dynlink.cm* "$(INSTALL_LIBDIR)/dynlink.mli" \
-        "$(INSTALL_LIBDIR)/dynlink.$(A)" \
-        $(addprefix "$(INSTALL_LIBDIR)/", $(notdir $(NATOBJS)))
-       $(MKDIR) "$(INSTALL_LIBDIR_DYNLINK)"
-       $(INSTALL_DATA) \
-         dynlink.cmi dynlink.cma META \
-         "$(INSTALL_LIBDIR_DYNLINK)"
-ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
-       $(INSTALL_DATA) \
-         dynlink.cmti dynlink.mli \
-         "$(INSTALL_LIBDIR_DYNLINK)"
-endif
-
-installopt:
-ifeq "$(strip $(NATDYNLINK))" "true"
-       $(INSTALL_DATA) \
-         $(NATOBJS) dynlink.cmxa dynlink.$(A) \
-         "$(INSTALL_LIBDIR_DYNLINK)"
-endif
-
-partialclean:
-       rm -f *.cm[ioaxt] *.cmti *.cmxa \
-             byte/*.cm[iot] byte/*.cmti \
-             native/*.cm[ixt] native/*.cmti native/*.o native/*.obj \
-             $(LOCAL_SRC)/*.cm[ioaxt] $(LOCAL_SRC)/*.cmti \
-        $(LOCAL_SRC)/*.o $(LOCAL_SRC)/*.obj
-
-clean: partialclean
-       rm -f *.a *.lib *.o *.obj *.so *.dll dynlink_platform_intf.mli \
-             $(LOCAL_SRC)/*.ml $(LOCAL_SRC)/*.mli $(LOCAL_SRC)/Makefile \
-             $(LOCAL_SRC)/.depend byte/dynlink.mli native/dynlink.mli
-
-.PHONY: distclean
-distclean: clean
-       rm -f META
-
-.PHONY: beforedepend
-beforedepend: dynlink_platform_intf.mli
-
-.PHONY: depend
-DEPEND_DUMMY_FILES=\
-  native/dynlink_compilerlibs.ml \
-  byte/dynlink_compilerlibs.mli \
-  byte/dynlink.mli \
-  native/dynlink.mli
-
-depend: beforedepend
-       $(V_GEN)touch $(DEPEND_DUMMY_FILES) && \
-       $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
-         -I byte -bytecode *.mli *.ml byte/dynlink.ml > .depend && \
-       $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
-         -I native -native *.ml native/dynlink.ml >> .depend && \
-       rm -f $(DEPEND_DUMMY_FILES)
-
-include .depend
-
-%.cmi: %.mli
-       $(V_OCAMLC)$(OCAMLC) -c $(COMPFLAGS) $<
-
-%.cmo: %.ml
-       $(V_OCAMLC)$(OCAMLC) -c $(COMPFLAGS) $<
-
-%.cmx: %.ml
-       $(V_OCAMLOPT)$(OCAMLOPT) -c $(COMPFLAGS) $(OPTCOMPFLAGS) $<

diff --git a/otherlibs/dynlink/byte/dynlink.ml b/otherlibs/dynlink/byte/dynlink.ml
index 9d695676a62942b2388a48b19793bab7da863718..0f315d3ab0d037a8a957887a9c52abea2268472d 100644 (file)
--- a/otherlibs/dynlink/byte/dynlink.ml
+++ b/otherlibs/dynlink/byte/dynlink.ml
@@ -15,16 +15,25 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open! Dynlink_compilerlibs
+module Symtable = Dynlink_symtable
+module Config = Dynlink_config
+open Dynlink_cmo_format
 
 module DC = Dynlink_common
 module DT = Dynlink_types
 
+module Compression = struct (* Borrowed from utils/compression.ml *)
+  external zstd_initialize: unit -> bool = "caml_zstd_initialize"
+  let input_value = Stdlib.input_value
+end
+
+let _compression_supported = Compression.zstd_initialize ()
+
 module Bytecode = struct
   type filename = string
 
   module Unit_header = struct
-    type t = Cmo_format.compilation_unit
+    type t = compilation_unit
 
     let name (t : t) = Symtable.Compunit.name t.cu_name
     let crc _t = None
@@ -41,11 +50,11 @@ module Bytecode = struct
           required
       in
       List.map
-        (fun (Cmo_format.Compunit cu) -> cu, None)
+        (fun (Compunit cu) -> cu, None)
         required
 
     let defined_symbols (t : t) =
-      List.map (fun (Cmo_format.Compunit cu) -> cu)
+      List.map (fun (Compunit cu) -> cu)
         (Symtable.initialized_compunits t.cu_reloc)
 
     let unsafe_module (t : t) = t.cu_primitives <> []
@@ -73,7 +82,7 @@ module Bytecode = struct
   let fold_initial_units ~init ~f =
     List.fold_left (fun acc (compunit, interface) ->
         let global =
-          Symtable.Global.Glob_compunit (Cmo_format.Compunit compunit)
+          Symtable.Global.Glob_compunit (Compunit compunit)
         in
         let defined =
           Symtable.is_defined_in_global_map !default_global_map global
@@ -102,10 +111,17 @@ module Bytecode = struct
       | None -> raise End_of_file
       | Some () -> ()
 
+  type instruct_debug_event
+  external reify_bytecode :
+    (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t ->
+    instruct_debug_event list array -> string option ->
+    Obj.t * (unit -> Obj.t)
+    = "caml_reify_bytecode"
+
   let run lock (ic, file_name, file_digest) ~unit_header ~priv =
     let clos = with_lock lock (fun () ->
         let old_state = Symtable.current_state () in
-        let compunit : Cmo_format.compilation_unit = unit_header in
+        let compunit : compilation_unit = unit_header in
         seek_in ic compunit.cu_pos;
         let code =
           Bigarray.Array1.create Bigarray.Char Bigarray.c_layout
@@ -120,8 +136,8 @@ module Bytecode = struct
           let new_error : DT.linking_error =
             match error with
             | Symtable.Undefined_global global ->
-              Undefined_global
-                (Format.asprintf "%a" Symtable.Global.description global)
+              let desc = Symtable.Global.description in
+              Undefined_global (Format.asprintf "%a" desc global)
             | Symtable.Unavailable_primitive s -> Unavailable_primitive s
             | Symtable.Uninitialized_global global ->
               Uninitialized_global (Symtable.Global.name global)
@@ -139,10 +155,10 @@ module Bytecode = struct
           if compunit.cu_debug = 0 then [| |]
           else begin
             seek_in ic compunit.cu_debug;
-            [| (Compression.input_value ic : Instruct.debug_event list) |]
+            [| (Compression.input_value ic : instruct_debug_event list) |]
           end in
         if priv then Symtable.hide_additions old_state;
-        let _, clos = Meta.reify_bytecode code events (Some digest) in
+        let _, clos = reify_bytecode code events (Some digest) in
         clos
       )
     in
@@ -171,15 +187,14 @@ module Bytecode = struct
       if buffer = Config.cmo_magic_number then begin
         let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
         seek_in ic compunit_pos;
-        let cu = (input_value ic : Cmo_format.compilation_unit) in
+        let cu = (input_value ic : compilation_unit) in
         handle, [cu]
       end else
       if buffer = Config.cma_magic_number then begin
         let toc_pos = input_binary_int ic in  (* Go to table of contents *)
         seek_in ic toc_pos;
-        let lib = (input_value ic : Cmo_format.library) in
-        Dll.open_dlls Dll.For_execution
-          (List.map Dll.extract_dll_name lib.lib_dllibs);
+        let lib = (input_value ic : library) in
+        Symtable.open_dlls lib.lib_dllibs;
         handle, lib.lib_units
       end else begin
         raise (DT.Error (Not_a_bytecode_file file_name))
@@ -198,7 +213,7 @@ module Bytecode = struct
 
   let unsafe_get_global_value ~bytecode_or_asm_symbol =
     let global =
-      Symtable.Global.Glob_compunit (Cmo_format.Compunit bytecode_or_asm_symbol)
+      Symtable.Global.Glob_compunit (Compunit bytecode_or_asm_symbol)
     in
     match Symtable.get_global_value global with
     | exception _ -> None

diff --git a/otherlibs/dynlink/byte/dynlink_symtable.ml b/otherlibs/dynlink/byte/dynlink_symtable.ml
new file mode 100644 (file)
index 0000000..e275a28
--- /dev/null
+++ b/otherlibs/dynlink/byte/dynlink_symtable.ml
@@ -0,0 +1,331 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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 Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* To assign numbers to globals and primitives *)
+
+open Dynlink_cmo_format
+module Config = Dynlink_config
+
+module Style = struct
+  let inline_code = Format.pp_print_string
+end
+
+#25 "bytecomp/symtable.ml"
+module Compunit = struct
+  type t = compunit
+  let name (Compunit cu_name) = cu_name
+  let is_packed (Compunit name) = String.contains name '.'
+#32 "bytecomp/symtable.ml"
+end
+#42 "bytecomp/symtable.ml"
+module Global = struct
+  type t =
+    | Glob_compunit of compunit
+    | Glob_predef of predef
+
+  let name = function
+    | Glob_compunit (Compunit cu) -> cu
+    | Glob_predef (Predef_exn exn) -> exn
+
+  let quote s = "`" ^ s ^ "'"
+
+  let description ppf g =
+#46 "otherlibs/dynlink/byte/dynlink_symtable.ml"
+    let open Format in
+#55 "bytecomp/symtable.ml"
+    match g with
+    | Glob_compunit (Compunit cu) ->
+        fprintf ppf "compilation unit %a"
+          Style.inline_code (quote cu)
+    | Glob_predef (Predef_exn exn) ->
+        fprintf ppf "predefined exception %a"
+          Style.inline_code (quote exn)
+#72 "bytecomp/symtable.ml"
+  module Map = Map.Make(struct type nonrec t = t let compare = compare end)
+end
+#77 "bytecomp/symtable.ml"
+type error =
+    Undefined_global of Global.t
+  | Unavailable_primitive of string
+  | Wrong_vm of string
+  | Uninitialized_global of Global.t
+
+exception Error of error
+#67 "otherlibs/dynlink/byte/dynlink_symtable.ml"
+module Dll = struct
+#18 "bytecomp/dll.ml"
+type dll_handle
+type dll_address
+#22 "bytecomp/dll.ml"
+external dll_open: string -> dll_handle = "caml_dynlink_open_lib"
+#24 "bytecomp/dll.ml"
+external dll_sym: dll_handle -> string -> dll_address
+                = "caml_dynlink_lookup_symbol"
+         (* returned dll_address may be Val_unit *)
+external add_primitive: dll_address -> int = "caml_dynlink_add_primitive"
+external get_current_dlls: unit -> dll_handle array
+                                           = "caml_dynlink_get_current_libs"
+
+(* Current search path for DLLs *)
+let search_path = ref ([] : string list)
+#42 "bytecomp/dll.ml"
+(* DLLs currently opened *)
+#86 "otherlibs/dynlink/byte/dynlink_symtable.ml"
+let opened_dlls = ref ([] : (string * dll_handle) list)
+(* Each known primitive and its ID number *)
+let primitives : (string, int) Hashtbl.t = Hashtbl.create 100
+#52 "bytecomp/dll.ml"
+(* Extract the name of a DLLs from its external name (xxx.so or -lxxx) *)
+
+let extract_dll_name file =
+  if Filename.check_suffix file Config.ext_dll then
+    Filename.chop_suffix file Config.ext_dll
+  else if String.length file >= 2 && String.sub file 0 2 = "-l" then
+    "dll" ^ String.sub file 2 (String.length file - 2)
+  else
+    file (* will cause error later *)
+#100 "otherlibs/dynlink/byte/dynlink_symtable.ml"
+(* Specialized version of [Dll.{open_dll,open_dlls,find_primitive}] for the
+    execution mode. *)
+let open_dll name =
+  let name = (extract_dll_name name) ^ Config.ext_dll in
+  let fullname =
+    if Filename.is_implicit name then
+      !search_path
+      |> List.find_map (fun dir ->
+        let fullname = Filename.concat dir name in
+        let fullname =
+          if Filename.is_implicit fullname then
+            Filename.concat Filename.current_dir_name fullname
+          else fullname
+        in
+        if Sys.file_exists fullname then Some fullname else None)
+      |> Option.value ~default:name
+    else
+      name
+  in
+  match List.assoc_opt fullname !opened_dlls with
+  | Some _ -> ()
+  | None ->
+      begin match dll_open fullname with
+      | dll ->
+          opened_dlls := (fullname, dll) :: !opened_dlls
+      | exception Failure msg ->
+          failwith (fullname ^ ": " ^ msg)
+      end
+
+(* Open a list of DLLs, adding them to opened_dlls.
+   Raise [Failure msg] in case of error. *)
+
+let open_dlls names =
+  List.iter open_dll names
+
+let find_primitive prim_name =
+  try Hashtbl.find primitives prim_name
+  with Not_found ->
+    let rec find seen = function
+      [] ->
+        raise (Error (Unavailable_primitive prim_name))
+    | (_, dll) as curr :: rem ->
+        let addr = dll_sym dll prim_name in
+        if addr == Obj.magic () then find (curr :: seen) rem else begin
+          if seen <> [] then opened_dlls := curr :: List.rev_append seen rem;
+          let n = add_primitive addr in
+          assert (n = Hashtbl.length primitives);
+          Hashtbl.add primitives prim_name n;
+          n
+        end
+    in
+    find [] !opened_dlls
+(* Adapted from Dll.init_toplevel *)
+let init ~dllpaths ~prims =
+  search_path := dllpaths;
+  opened_dlls :=
+    List.map (fun dll -> "", dll)
+      (Array.to_list (get_current_dlls ()));
+  List.iteri (fun n p -> Hashtbl.add primitives p n) prims
+end
+let of_prim = Dll.find_primitive
+let open_dlls = Dll.open_dlls
+(* Adapted from "bytecomp/symtable.ml"*)
+module GlobalMap = struct
+
+  type t = {
+    cnt: int; (* The next number *)
+    tbl: int Global.Map.t ; (* The table of already numbered objects *)
+  }
+
+  let empty = { cnt = 0; tbl = Global.Map.empty }
+
+  let find nt key =
+    Global.Map.find key nt.tbl
+
+  let enter nt key =
+    let n = !nt.cnt in
+    nt := { cnt = n + 1; tbl = Global.Map.add key n !nt.tbl };
+    n
+
+  let incr nt =
+    let n = !nt.cnt in
+    nt := { cnt = n + 1; tbl = !nt.tbl };
+    n
+
+end
+#111 "bytecomp/symtable.ml"
+(* Global variables *)
+
+let global_table = ref GlobalMap.empty
+and literal_table = ref([] : (int * Obj.t) list)
+#119 "bytecomp/symtable.ml"
+let slot_for_getglobal global =
+  try
+    GlobalMap.find !global_table global
+  with Not_found ->
+    raise(Error (Undefined_global global))
+
+let slot_for_setglobal global =
+  GlobalMap.enter global_table global
+
+let slot_for_literal cst =
+  let n = GlobalMap.incr global_table in
+  literal_table := (n, cst) :: !literal_table;
+  n
+#283 "bytecomp/symtable.ml"
+(* Relocate a block of object bytecode *)
+
+let patch_int buff pos n =
+  let open Bigarray.Array1 in
+  set buff pos (Char.unsafe_chr n);
+  set buff (pos + 1) (Char.unsafe_chr (n asr 8));
+  set buff (pos + 2) (Char.unsafe_chr (n asr 16));
+  set buff (pos + 3) (Char.unsafe_chr (n asr 24))
+
+let patch_object buff patchlist =
+  List.iter
+    (function
+        (Reloc_literal sc, pos) ->
+          patch_int buff pos (slot_for_literal sc)
+      | (Reloc_getcompunit cu, pos) ->
+          let global = Global.Glob_compunit cu in
+          patch_int buff pos (slot_for_getglobal global)
+      | (Reloc_getpredef pd, pos) ->
+          let global = Global.Glob_predef pd in
+          patch_int buff pos (slot_for_getglobal global)
+      | (Reloc_setcompunit cu, pos) ->
+          let global = Global.Glob_compunit cu in
+          patch_int buff pos (slot_for_setglobal global)
+      | (Reloc_primitive name, pos) ->
+          patch_int buff pos (of_prim name))
+    patchlist
+#328 "bytecomp/symtable.ml"
+(* Functions for toplevel use *)
+
+(* Update the in-core table of globals *)
+#237 "otherlibs/dynlink/byte/dynlink_symtable.ml"
+module Meta = struct
+#16 "bytecomp/meta.ml"
+external global_data : unit -> Obj.t array = "caml_get_global_data"
+external realloc_global_data : int -> unit = "caml_realloc_global"
+#242 "otherlibs/dynlink/byte/dynlink_symtable.ml"
+end
+#332 "bytecomp/symtable.ml"
+let update_global_table () =
+  let ng = !global_table.cnt in
+  if ng > Array.length(Meta.global_data()) then Meta.realloc_global_data ng;
+  let glob = Meta.global_data() in
+  List.iter
+    (fun (slot, cst) -> glob.(slot) <- cst)
+    !literal_table;
+  literal_table := []
+
+type bytecode_sections =
+  { symb: GlobalMap.t;
+    crcs: (string * Digest.t option) list;
+    prim: string list;
+    dlpt: string list }
+
+external get_bytecode_sections : unit -> bytecode_sections =
+  "caml_dynlink_get_bytecode_sections"
+
+(* Initialize the linker for toplevel use *)
+
+let init_toplevel () =
+  let sect = get_bytecode_sections () in
+  global_table := sect.symb;
+#268 "otherlibs/dynlink/byte/dynlink_symtable.ml"
+  Dll.init ~dllpaths:sect.dlpt ~prims:sect.prim;
+#358 "bytecomp/symtable.ml"
+  sect.crcs
+
+(* Find the value of a global identifier *)
+#364 "bytecomp/symtable.ml"
+let get_global_value global =
+  (Meta.global_data()).(slot_for_getglobal global)
+#369 "bytecomp/symtable.ml"
+(* Check that all compilation units referenced in the given patch list
+   have already been initialized *)
+
+let initialized_compunits patchlist =
+  List.fold_left (fun compunits rel ->
+      match fst rel with
+      | Reloc_setcompunit compunit -> compunit :: compunits
+      | Reloc_literal _ | Reloc_getcompunit _ | Reloc_getpredef _
+      | Reloc_primitive _ -> compunits)
+    []
+    patchlist
+
+let required_compunits patchlist =
+  List.fold_left (fun compunits rel ->
+      match fst rel with
+      | Reloc_getcompunit compunit -> compunit :: compunits
+      | Reloc_literal _ | Reloc_getpredef _ | Reloc_setcompunit _
+      | Reloc_primitive _ -> compunits)
+    []
+    patchlist
+
+let check_global_initialized patchlist =
+  (* First determine the compilation units we will define *)
+  let initialized_compunits = initialized_compunits patchlist in
+  (* Then check that all referenced, not defined comp units have a value *)
+  let check_reference (rel, _) = match rel with
+      Reloc_getcompunit compunit ->
+        let global = Global.Glob_compunit compunit in
+        if not (List.mem compunit initialized_compunits)
+        && Obj.is_int (get_global_value global)
+        then raise (Error(Uninitialized_global global))
+    | Reloc_literal _ | Reloc_getpredef _ | Reloc_setcompunit _
+    | Reloc_primitive _ -> () in
+  List.iter check_reference patchlist
+
+(* Save and restore the current state *)
+
+type global_map = GlobalMap.t
+
+let current_state () = !global_table
+#412 "bytecomp/symtable.ml"
+let hide_additions (st : global_map) =
+  if st.cnt > !global_table.cnt then
+#321 "otherlibs/dynlink/byte/dynlink_symtable.ml"
+    failwith "Symtable.hide_additions";
+#415 "bytecomp/symtable.ml"
+  global_table :=
+    {GlobalMap.
+      cnt = !global_table.cnt;
+      tbl = st.tbl }
+#434 "bytecomp/symtable.ml"
+let is_defined_in_global_map (gmap : global_map) global =
+  Global.Map.mem global gmap.tbl
+
+let empty_global_map = GlobalMap.empty

diff --git a/otherlibs/dynlink/byte/dynlink_symtable.mli b/otherlibs/dynlink/byte/dynlink_symtable.mli
new file mode 100644 (file)
index 0000000..686cb4c
--- /dev/null
+++ b/otherlibs/dynlink/byte/dynlink_symtable.mli
@@ -0,0 +1,62 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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 Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Assign locations and numbers to globals and primitives *)
+
+open Dynlink_cmo_format
+
+module Compunit : sig
+  type t = compunit
+  val name : t -> string
+  val is_packed : compunit -> bool
+end
+
+module Global : sig
+  type t =
+    | Glob_compunit of compunit
+    | Glob_predef of predef
+  val name: t -> string
+  val description: Format.formatter -> t -> unit
+end
+
+val open_dlls : string list -> unit
+
+val patch_object:
+  (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t ->
+  (reloc_info * int) list -> unit
+
+val init_toplevel: unit -> (string * Digest.t option) list
+val update_global_table: unit -> unit
+val get_global_value: Global.t -> Obj.t
+val check_global_initialized: (reloc_info * int) list -> unit
+val initialized_compunits: (reloc_info * int) list -> compunit list
+val required_compunits: (reloc_info * int) list -> compunit list
+
+type global_map
+
+val empty_global_map: global_map
+val current_state: unit -> global_map
+val hide_additions: global_map -> unit
+val is_defined_in_global_map: global_map -> Global.t -> bool
+
+(* Error report *)
+
+type error =
+    Undefined_global of Global.t
+  | Unavailable_primitive of string
+  | Wrong_vm of string
+  | Uninitialized_global of Global.t
+
+exception Error of error

diff --git a/otherlibs/dynlink/dune b/otherlibs/dynlink/dune
index 32a84264a04f1447a56f14b490ff7b03b077a3ea..4e69e55d0e2adbf5f68941c47cb081a98d94f5e0 100644 (file)
--- a/otherlibs/dynlink/dune
+++ b/otherlibs/dynlink/dune
@@ -18,14 +18,9 @@
 ; (library
 ;   (name dynlink)
 ;   (wrapped false)
-;   (modules dynlink dynlink_compilerlibs dynlink_common dynlink_types
+;   (modules dynlink dynlink_common dynlink_types
 ;      dynlink_platform_intf)
 ;   ; the -33 is specific to the hackery done with dune.
 ;   (flags (:standard -nostdlib -w -33))
 ;   (modules_without_implementation dynlink)
 ;   (libraries ocamlcommon stdlib))
-;
-; (rule
-;  (targets dynlink_compilerlibs.ml)
-;  (action (write-file %{targets}
-;            "(* empty because we are linking with ocamlcommon *)")))

diff --git a/otherlibs/dynlink/dynlink_common.ml b/otherlibs/dynlink/dynlink_common.ml
index a37a386345a1d29be2fa763e0c633da618169642..2d2aa94542c184e8a7da26009722a0cb3ba7d978 100644 (file)
--- a/otherlibs/dynlink/dynlink_common.ml
+++ b/otherlibs/dynlink/dynlink_common.ml
@@ -15,13 +15,11 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open! Dynlink_compilerlibs
-
 module String = struct
-  include Misc.Stdlib.String
-
+  include String
+  module Set = Set.Make (String)
   module Map = struct
-    include Map
+    include Map.Make (String)
 
     let keys t =
       fold (fun key _data keys -> Set.add key keys) t Set.empty

diff --git a/otherlibs/dynlink/dynlink_compilerlibs/Makefile.copy-sources b/otherlibs/dynlink/dynlink_compilerlibs/Makefile.copy-sources
deleted file mode 100644 (file)
index 9b73883..0000000
--- a/otherlibs/dynlink/dynlink_compilerlibs/Makefile.copy-sources
+++ /dev/null
@@ -1,29 +0,0 @@
-#**************************************************************************
-#*                                                                        *
-#*                                 OCaml                                  *
-#*                                                                        *
-#*                     Mark Shinwell, Jane Street Europe                  *
-#*                                                                        *
-#*   Copyright 1999 Institut National de Recherche en Informatique et     *
-#*     en Automatique.                                                    *
-#*   Copyright 2018--2019 Jane Street Group LLC                           *
-#*                                                                        *
-#*   All rights reserved.  This file is distributed under the terms of    *
-#*   the GNU Lesser General Public License version 2.1, with the          *
-#*   special exception on linking described in the file LICENSE.          *
-#*                                                                        *
-#**************************************************************************
-
-$(LOCAL_SRC)/.depend: $(COMPILERLIBS_COPIED_SOURCES) \
-  $(COMPILERLIBS_COPIED_SOURCES_INTFS) $(LOCAL_SRC)/Makefile
-       $(V_OCAMLDEP)$(OCAMLDEP_CMD) -I $(LOCAL_SRC) $(COMPILERLIBS_COPIED_SOURCES) \
-       $(COMPILERLIBS_COPIED_SOURCES_INTFS) \
-        > $(LOCAL_SRC)/.depend
-
--include $(LOCAL_SRC)/.depend
-
-$(LOCAL_SRC)/%.ml:
-       cp $< $@
-
-$(LOCAL_SRC)/%.mli:
-       cp $< $@

diff --git a/otherlibs/dynlink/dynlink_config.ml.in b/otherlibs/dynlink/dynlink_config.ml.in
new file mode 100644 (file)
index 0000000..60132fe
--- /dev/null
+++ b/otherlibs/dynlink/dynlink_config.ml.in
@@ -0,0 +1,26 @@
+(* @configure_input@ *)
+#3 "otherlibs/dynlink/dynlink_config.ml.in"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                     Sebastien Hinderer, Tarides                        *)
+(*                                                                        *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Configuration values needed by the dynlink library *)
+
+(* Length of magic numbers *)
+let magic_length = @MAGIC_LENGTH@
+
+let ext_dll = "." ^ {@QS@|@SO@|@QS@}
+and cmo_magic_number = {@QS@|@CMO_MAGIC_NUMBER@|@QS@}
+and cma_magic_number = {@QS@|@CMA_MAGIC_NUMBER@|@QS@}
+and cmxs_magic_number = {@QS@|@CMXS_MAGIC_NUMBER@|@QS@}

diff --git a/otherlibs/dynlink/dynlink_config.mli b/otherlibs/dynlink/dynlink_config.mli
new file mode 100644 (file)
index 0000000..ad44848
--- /dev/null
+++ b/otherlibs/dynlink/dynlink_config.mli
@@ -0,0 +1,23 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                     Sebastien Hinderer, Tarides                        *)
+(*                                                                        *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Configuration values needed by the dynlink library *)
+
+val magic_length : int
+
+val ext_dll: string
+val cmo_magic_number: string
+val cma_magic_number: string
+val cmxs_magic_number: string

diff --git a/otherlibs/dynlink/native/dynlink.ml b/otherlibs/dynlink/native/dynlink.ml
index 050bb69e550d2562a14ab43c26f01a8c77d3ca7f..8d8d2dc4ff2f22a21dbc2a71e6eaa2bc2203fdb2 100644 (file)
--- a/otherlibs/dynlink/native/dynlink.ml
+++ b/otherlibs/dynlink/native/dynlink.ml
@@ -17,7 +17,9 @@
 
 (* Dynamic loading of .cmx files *)
 
-open! Dynlink_compilerlibs
+module Config = Dynlink_config
+
+open Dynlink_cmxs_format
 
 module DC = Dynlink_common
 module DT = Dynlink_types
@@ -32,7 +34,7 @@ type global_map = {
 module Native = struct
   type handle
 
-  external ndl_open : string -> bool -> handle * Cmxs_format.dynheader
+  external ndl_open : string -> bool -> handle * dynheader
     = "caml_natdynlink_open"
   external ndl_register : handle -> string array -> unit
     = "caml_natdynlink_register"
@@ -42,7 +44,7 @@ module Native = struct
   external ndl_loadsym : string -> Obj.t = "caml_natdynlink_loadsym"
 
   module Unit_header = struct
-    type t = Cmxs_format.dynunit
+    type t = dynunit
 
     let name (t : t) = t.dynu_name
     let crc (t : t) = Some t.dynu_crc

diff --git a/otherlibs/runtime_events/caml/runtime_events_consumer.h b/otherlibs/runtime_events/caml/runtime_events_consumer.h
index 6821c4d10476c714a494bf4129153ef6473a7f08..b7bde28dce515ac024c9ab19f6b81e19db3061fb 100644 (file)
--- a/otherlibs/runtime_events/caml/runtime_events_consumer.h
+++ b/otherlibs/runtime_events/caml/runtime_events_consumer.h
@@ -21,6 +21,10 @@
 
 #include "caml/runtime_events.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 /* Create a cursor to read events from an runtime_events. Cursors can be created
    for runtime_events in and out of process. An runtime_events may have
    multiple cursors reading from it at any point in time and a program may have
@@ -95,4 +99,8 @@ CAMLextern runtime_events_error caml_runtime_events_read_poll(
     void *callback_data,
     uintnat max_events, uintnat *events_consumed);
 
+#ifdef __cplusplus
+}
 #endif
+
+#endif /* CAML_RUNTIME_EVENTS_CONSUMER_H */

diff --git a/otherlibs/runtime_events/runtime_events.ml b/otherlibs/runtime_events/runtime_events.ml
index ede9c02f63b55ee8a8dc3f20b33dcd465812c4c5..61709ef3b86bbba953a3f500ef4c5d237a916822 100644 (file)
--- a/otherlibs/runtime_events/runtime_events.ml
+++ b/otherlibs/runtime_events/runtime_events.ml
@@ -33,6 +33,15 @@ type runtime_counter =
 | EV_C_MAJOR_HEAP_POOL_FRAG_WORDS
 | EV_C_MAJOR_HEAP_POOL_LIVE_BLOCKS
 | EV_C_MAJOR_HEAP_LARGE_BLOCKS
+| EV_C_MAJOR_HEAP_WORDS
+| EV_C_MAJOR_ALLOCATED_WORDS
+| EV_C_MAJOR_ALLOCATED_WORK
+| EV_C_MAJOR_DEPENDENT_WORK
+| EV_C_MAJOR_EXTRA_WORK
+| EV_C_MAJOR_WORK_COUNTER
+| EV_C_MAJOR_ALLOC_COUNTER
+| EV_C_MAJOR_SLICE_TARGET
+| EV_C_MAJOR_SLICE_BUDGET
 
 type runtime_phase =
 | EV_EXPLICIT_GC_SET
@@ -44,9 +53,12 @@ type runtime_phase =
 | EV_MAJOR
 | EV_MAJOR_SWEEP
 | EV_MAJOR_MARK_ROOTS
+| EV_MAJOR_MEMPROF_ROOTS
 | EV_MAJOR_MARK
 | EV_MINOR
 | EV_MINOR_LOCAL_ROOTS
+| EV_MINOR_MEMPROF_ROOTS
+| EV_MINOR_MEMPROF_CLEAN
 | EV_MINOR_FINALIZED
 | EV_EXPLICIT_GC_MAJOR_SLICE
 | EV_FINALISE_UPDATE_FIRST
@@ -69,6 +81,7 @@ type runtime_phase =
 | EV_STW_HANDLER
 | EV_STW_LEADER
 | EV_MAJOR_FINISH_SWEEPING
+| EV_MAJOR_MEMPROF_CLEAN
 | EV_MINOR_FINALIZERS_ADMIN
 | EV_MINOR_REMEMBERED_SET
 | EV_MINOR_REMEMBERED_SET_PROMOTE
@@ -117,6 +130,25 @@ let runtime_counter_name counter =
       "major_heap_pool_live_blocks"
   | EV_C_MAJOR_HEAP_LARGE_BLOCKS ->
       "major_heap_large_blocks"
+  | EV_C_MAJOR_HEAP_WORDS ->
+      "major_heap_words"
+  | EV_C_MAJOR_ALLOCATED_WORDS ->
+      "major_allocated_words"
+  | EV_C_MAJOR_ALLOCATED_WORK ->
+      "major_allocated_work"
+  | EV_C_MAJOR_DEPENDENT_WORK ->
+      "major_dependent_work"
+  | EV_C_MAJOR_EXTRA_WORK ->
+      "major_extra_work"
+  | EV_C_MAJOR_WORK_COUNTER ->
+      "major_work_counter"
+  | EV_C_MAJOR_ALLOC_COUNTER ->
+      "major_alloc_counter"
+  | EV_C_MAJOR_SLICE_TARGET ->
+      "major_slice_target"
+  | EV_C_MAJOR_SLICE_BUDGET ->
+      "major_slice_budget"
+
 
 let runtime_phase_name phase =
   match phase with
@@ -129,9 +161,12 @@ let runtime_phase_name phase =
   | EV_MAJOR -> "major"
     | EV_MAJOR_SWEEP -> "major_sweep"
   | EV_MAJOR_MARK_ROOTS -> "major_mark_roots"
+  | EV_MAJOR_MEMPROF_ROOTS -> "major_memprof_roots"
   | EV_MAJOR_MARK -> "major_mark"
   | EV_MINOR -> "minor"
   | EV_MINOR_LOCAL_ROOTS -> "minor_local_roots"
+  | EV_MINOR_MEMPROF_ROOTS -> "minor_memprof_roots"
+  | EV_MINOR_MEMPROF_CLEAN -> "minor_memprof_clean"
   | EV_MINOR_FINALIZED -> "minor_finalized"
   | EV_EXPLICIT_GC_MAJOR_SLICE -> "explicit_gc_major_slice"
   | EV_FINALISE_UPDATE_FIRST -> "finalise_update_first"
@@ -153,6 +188,7 @@ let runtime_phase_name phase =
   | EV_STW_HANDLER -> "stw_handler"
   | EV_STW_LEADER -> "stw_leader"
   | EV_MAJOR_FINISH_SWEEPING -> "major_finish_sweeping"
+  | EV_MAJOR_MEMPROF_CLEAN -> "major_memprof_clean"
   | EV_MINOR_FINALIZERS_ADMIN -> "minor_finalizers_admin"
   | EV_MINOR_REMEMBERED_SET -> "minor_remembered_set"
   | EV_MINOR_REMEMBERED_SET_PROMOTE -> "minor_remembered_set_promote"
@@ -209,11 +245,11 @@ module Type = struct
 
   let int = Int
 
-  let next_id = ref 3
+  let next_id = Atomic.make 3
 
   let register ~encode ~decode =
-    incr next_id;
-    Custom { serialize = encode; deserialize = decode; id = !next_id - 1}
+    let id = Atomic.fetch_and_add next_id 1 in
+    Custom { serialize = encode; deserialize = decode; id; }
 
   let id: type a. a t -> int = function
     | Unit -> 0
@@ -252,7 +288,7 @@ module User = struct
        the write buffer across calls.
 
        To be safe for multi-domain programs, we use domain-local
-       storage for the write buffer. To accomodate for multi-threaded
+       storage for the write buffer. To accommodate for multi-threaded
        programs (without depending on the Thread module), we store
        a list of caches for each domain. This might leak a bit of
        memory: the number of buffers for a domain is equal to the
@@ -365,6 +401,7 @@ end
 external start : unit -> unit = "caml_ml_runtime_events_start"
 external pause : unit -> unit = "caml_ml_runtime_events_pause"
 external resume : unit -> unit = "caml_ml_runtime_events_resume"
+external path : unit -> string option = "caml_ml_runtime_events_path"
 
 external create_cursor : (string * int) option -> cursor
                                         = "caml_ml_runtime_events_create_cursor"

diff --git a/otherlibs/runtime_events/runtime_events.mli b/otherlibs/runtime_events/runtime_events.mli
index b5b3c193d0d7d5811457d7f2c888f6541cca3d13..c10e10c81fec0cb03420fe4820310780ca7e02f6 100644 (file)
--- a/otherlibs/runtime_events/runtime_events.mli
+++ b/otherlibs/runtime_events/runtime_events.mli
@@ -46,19 +46,66 @@
     very short running programs.
 *)
 
-(** The type for counter events emitted by the runtime. *)
+(** The type for counter events emitted by the runtime. Counter events are used
+  to measure a quantity at a point in time or record the occurence of an event.
+  In the latter case their value will be one. *)
 type runtime_counter =
 | EV_C_FORCE_MINOR_ALLOC_SMALL
+(**
+Triggering of a minor collection due to a full minor heap.
+@since 5.0
+*)
 | EV_C_FORCE_MINOR_MAKE_VECT
+(**
+Triggering of a minor collection due to Array.make.
+@since 5.0
+*)
 | EV_C_FORCE_MINOR_SET_MINOR_HEAP_SIZE
+(**
+Triggering of a minor collection due to Gc.minor_heap_size.
+@since 5.0
+*)
 | EV_C_FORCE_MINOR_MEMPROF
+(**
+Triggering of a minor collection during memprof young sampling.
+@since 5.3
+*)
 | EV_C_MINOR_PROMOTED
+(**
+Total words promoted from the minor heap to the major in the last minor
+collection.
+@since 5.0
+*)
 | EV_C_MINOR_ALLOCATED
+(**
+Total {b bytes} allocated in the minor heap in the last minor collection.
+@since 5.0
+*)
 | EV_C_REQUEST_MAJOR_ALLOC_SHR
+(**
+Major slice requested due to allocation in major heap.
+@since 5.0
+*)
 | EV_C_REQUEST_MAJOR_ADJUST_GC_SPEED
+(**
+Major slice requested by [caml_adjust_gc_speed].
+@since 5.0
+*)
 | EV_C_REQUEST_MINOR_REALLOC_REF_TABLE
+(**
+Triggering of a minor collection due to ref table reallocation.
+@since 5.0
+*)
 | EV_C_REQUEST_MINOR_REALLOC_EPHE_REF_TABLE
+(**
+Triggering of a minor collection due to ephe_ref table reallocation.
+@since 5.0
+*)
 | EV_C_REQUEST_MINOR_REALLOC_CUSTOM_TABLE
+(**
+Triggering of a minor collection due to custom table reallocation.
+@since 5.0
+*)
 | EV_C_MAJOR_HEAP_POOL_WORDS
 (**
 Total words in a Domain's major heap pools. This is the sum of unallocated and
@@ -87,64 +134,369 @@ Live blocks of a Domain's major heap pools.
 (**
 Live blocks of a Domain's major heap large allocations.
 @since 5.1 *)
+| EV_C_MAJOR_HEAP_WORDS
+(**
+Major heap size in words of a Domain.
+@since 5.3 *)
+| EV_C_MAJOR_ALLOCATED_WORDS
+(**
+Allocations to the major heap of this Domain in words, since the last major
+slice.
+@since 5.3
+*)
+| EV_C_MAJOR_ALLOCATED_WORK
+(**
+The amount of major GC 'work' needing to be done as a result of allocations to
+the major heap of this Domain in words, since the last major slice.
+@since 5.3
+*)
+| EV_C_MAJOR_DEPENDENT_WORK
+(**
+The amount of major GC 'work' needing to be done as a result of dependent
+allocations to the major heap of this Domain in words, since the last major
+slice. Dependent memory is non-heap memory that depends on heap memory being
+collected in order to be freed.
+@since 5.3
+*)
+| EV_C_MAJOR_EXTRA_WORK
+(**
+The amount of major GC 'work' needing to be done as a result of extra
+non-memory resources that are dependent on heap memory being collected in order
+to be freed.
+@since 5.3
+*)
+| EV_C_MAJOR_WORK_COUNTER
+(**
+The global amount of major GC 'work' done by all domains since the program
+began.
+@since 5.3
+*)
+| EV_C_MAJOR_ALLOC_COUNTER
+(**
+The global words of major GC allocations done by all domains since the program
+began.
+@since 5.3
+*)
+| EV_C_MAJOR_SLICE_TARGET
+(**
+The target amount of global 'work' that should be done by all domains at the
+end of the major slice (see EV_C_MAJOR_SLICE_COUNTER).
+@since 5.3
+*)
+| EV_C_MAJOR_SLICE_BUDGET
+(**
+The budget in 'work' that a domain has to do during the major slice.
+@since 5.3
+*)
 
 (** The type for span events emitted by the runtime. *)
 type runtime_phase =
 | EV_EXPLICIT_GC_SET
+(**
+Event spanning a call to Gc.set.
+@since 5.0
+*)
 | EV_EXPLICIT_GC_STAT
+(**
+Event spanning a call to Gc.stat.
+@since 5.0
+*)
 | EV_EXPLICIT_GC_MINOR
+(**
+Event spanning a call to Gc.minor, which forces a minor collection.
+@since 5.0
+*)
 | EV_EXPLICIT_GC_MAJOR
+(**
+Event spanning a call to Gc.major, which forces a major collection.
+@since 5.0
+*)
 | EV_EXPLICIT_GC_FULL_MAJOR
+(**
+Event spanning a call to Gc.full_major, which forces a full major collection.
+@since 5.0
+*)
 | EV_EXPLICIT_GC_COMPACT
+(**
+Event spanning a call to Gc.compact, which triggers a compaction.
+@since 5.0
+*)
 | EV_MAJOR
+(**
+Event spanning any major GC work.
+@since 5.0
+*)
 | EV_MAJOR_SWEEP
+(**
+Event spanning the sweeping work of a major GC.
+@since 5.0
+*)
 | EV_MAJOR_MARK_ROOTS
+(**
+Event spanning the marking of roots in a major GC.
+@since 5.0
+*)
+| EV_MAJOR_MEMPROF_ROOTS
+(**
+Event spanning the marking of memprof roots in a major GC.
+@since 5.3
+*)
 | EV_MAJOR_MARK
+(**
+Event spanning the marking of the heap in a major GC.
+@since 5.0
+*)
 | EV_MINOR
+(**
+Event spanning any minor GC work.
+@since 5.0
+*)
 | EV_MINOR_LOCAL_ROOTS
+(**
+Event spanning the scanning and major allocation of local roots during a minor
+GC.
+@since 5.0
+*)
+| EV_MINOR_MEMPROF_ROOTS
+(**
+Event spanning the scanning and promotion of memprof roots in a minor GC.
+@since 5.3
+*)
+| EV_MINOR_MEMPROF_CLEAN
+(**
+Event spanning cleaning and updating of memprof structures at the end of a
+minor GC.
+@since 5.3
+*)
 | EV_MINOR_FINALIZED
+(**
+Event spanning the running of finalisers for dead custom blocks at the end of a
+minor GC.
+@since 5.0
+*)
 | EV_EXPLICIT_GC_MAJOR_SLICE
+(**
+Event spanning a call to Gc.major_slice.
+@since 5.0
+*)
 | EV_FINALISE_UPDATE_FIRST
+(**
+Event spanning time spent in the first phase of finalisation at the end of a
+major GC cycle.
+@since 5.0
+*)
 | EV_FINALISE_UPDATE_LAST
+(**
+Event spanning time spent in the last phase of finalisation at the end of a
+major GC cycle.
+@since 5.0
+*)
 | EV_INTERRUPT_REMOTE
+(**
+Event spanning work triggered by an interrupt from another domain. This is
+usually a stop-the-world request.
+@since 5.0
+*)
 | EV_MAJOR_EPHE_MARK
+(**
+Event spanning the marking of ephemeron tables in a major GC.
+@since 5.0
+*)
 | EV_MAJOR_EPHE_SWEEP
+(**
+Event spanning the sweeping of ephemeron tables in a major GC.
+@since 5.0
+*)
 | EV_MAJOR_FINISH_MARKING
+(**
+Event spanning work done at the end of marking in a major GC.
+@since 5.0
+*)
 | EV_MAJOR_GC_CYCLE_DOMAINS
+(**
+Event spanning work done at the end of a major GC cycle. This includes a
+minor collection.
+@since 5.0
+*)
 | EV_MAJOR_GC_PHASE_CHANGE
+(**
+Event spanning the change of phase in the major GC which involves a global
+barrier.
+@since 5.0
+*)
 | EV_MAJOR_GC_STW
+(**
+Event spanning the stop-the-world phase done at the end of a major GC cycle.
+@since 5.0
+*)
 | EV_MAJOR_MARK_OPPORTUNISTIC
+(**
+Event spanning the work done during opportunistic marking in a major GC.
+@since 5.0
+*)
 | EV_MAJOR_SLICE
+(**
+Event spanning the work done during a major slice in a major GC.
+@since 5.0
+*)
 | EV_MAJOR_FINISH_CYCLE
+(**
+Event spanning attempts to drive all domains to the end of a major GC cycle.
+@since 5.0
+*)
 | EV_MINOR_CLEAR
+(**
+Event spanning the cleaning of the minor heap and supporting structures at the
+end of a minor GC.
+@since 5.0
+*)
 | EV_MINOR_FINALIZERS_OLDIFY
+(**
+Event spanning the promotion of finalisers during a minor GC.
+@since 5.0
+*)
 | EV_MINOR_GLOBAL_ROOTS
+(**
+Event spanning the scanning and major allocation of global roots during a minor
+GC.
+@since 5.0
+*)
 | EV_MINOR_LEAVE_BARRIER
+(**
+Event spanning the time spent in the barrier at the end of a minor GC, waiting
+for all domains to finish their work.
+@since 5.0
+*)
 | EV_STW_API_BARRIER
+(**
+Event spanning the time spent waiting for all other domains to reach the
+stop-the-world entry barrier.
+@since 5.0
+*)
 | EV_STW_HANDLER
+(**
+Event spanning the time spent in the stop-the-world handler, including time
+spent in the stop-the-world callback itself.
+@since 5.0
+*)
 | EV_STW_LEADER
+(**
+Event spanning the time spent as the leader of a stop-the-world.
+@since 5.0
+*)
 | EV_MAJOR_FINISH_SWEEPING
+(**
+Event spanning the time spent finishing sweeping when forced to as part of
+domain termination.
+@since 5.0
+*)
+| EV_MAJOR_MEMPROF_CLEAN
+(**
+Event spanning the time spent cleaning memprof structures at the end of a major
+GC.
+@since 5.3
+*)
 | EV_MINOR_FINALIZERS_ADMIN
+(**
+Event spanning finalisers book-keeping at the end of a minor GC.
+@since 5.0
+*)
 | EV_MINOR_REMEMBERED_SET
+(**
+Event spanning the scanning and major allocation of remembered sets during a
+minor GC.
+@since 5.0
+*)
 | EV_MINOR_REMEMBERED_SET_PROMOTE
+(**
+Event spanning the promotion of blocks in the remembered set and global roots
+during a minor GC.
+@since 5.0
+*)
 | EV_MINOR_LOCAL_ROOTS_PROMOTE
+(**
+Event spanning the promotion of local roots during a minor GC.
+@since 5.0
+*)
 | EV_DOMAIN_CONDITION_WAIT
+(**
+Event spanning waiting in Condition.wait.
+@since 5.0
+*)
 | EV_DOMAIN_RESIZE_HEAP_RESERVATION
+(**
+Event spanning resizing the domain heap reservation, as a result of minor heap
+size changes.
+@since 5.0
+*)
 | EV_COMPACT
+(**
+Event spanning compaction of the heap during a call to Gc.compact.
+@since 5.2
+*)
 | EV_COMPACT_EVACUATE
+(**
+Event spanning evacuating major GC pools during a compaction.
+@since 5.2
+*)
 | EV_COMPACT_FORWARD
+(**
+Event spanning the walking of the heap to update changed pointers after an
+evacuation during a compaction.
+@since 5.2
+*)
 | EV_COMPACT_RELEASE
+(**
+Event spanning releasing the evacuated pools at the end of a compaction.
+@since 5.2
+*)
 
-(** Lifecycle events for the ring itself. *)
+(** Lifecycle events for Runtime_events and domains. *)
 type lifecycle =
   EV_RING_START
+(**
+Event indicating that the Runtime_events ring buffer has been started. Includes
+the PID of the process as an argument.
+@since 5.0
+*)
 | EV_RING_STOP
+(**
+Event indicating that the Runtime_events ring buffer has been stopped.
+@since 5.0
+*)
 | EV_RING_PAUSE
+(**
+Event indicating that the Runtime_events ring buffer has been paused.
+@since 5.0
+*)
 | EV_RING_RESUME
+(**
+Event indicating that the Runtime_events ring buffer has been resumed.
+@since 5.0
+*)
 | EV_FORK_PARENT
+(**
+Event indicating that a fork has occurred and the current domain is the parent.
+Includes the PID of the child as an argument.
+@since 5.0
+*)
 | EV_FORK_CHILD
+(**
+Event indicating that a fork has occurred and the current domain is the child.
+@since 5.0
+*)
 | EV_DOMAIN_SPAWN
+(**
+Event indicating that a new domain has been spawned. Includes the PID of the
+new domain as an argument.
+@since 5.0
+*)
 | EV_DOMAIN_TERMINATE
+(**
+Event indicating that a domain has terminated. Includes the PID of the domain
+as an argument.
+@since 5.0
+*)
 
 val lifecycle_name : lifecycle -> string
 (** Return a string representation of a given lifecycle event type. *)
@@ -265,6 +617,10 @@ val start : unit -> unit
   a set of callbacks to be called for each type of event.
 *)
 
+val path : unit -> string option
+(** If runtime events are being collected, [path ()] returns [Some p] where [p]
+  is a path to the runtime events file. Otherwise, it returns None. *)
+
 val pause : unit -> unit
 (** [pause ()] will pause the collection of events in the runtime.
    Traces are collected if the program has called [Runtime_events.start ()] or

diff --git a/otherlibs/runtime_events/runtime_events_consumer.c b/otherlibs/runtime_events/runtime_events_consumer.c
index 1771df70f508de1579507327cd316365dca0cdbc..3ffc261bfcd21fa581694b12d363e3c0fab2cf29 100644 (file)
--- a/otherlibs/runtime_events/runtime_events_consumer.c
+++ b/otherlibs/runtime_events/runtime_events_consumer.c
@@ -53,7 +53,8 @@
 struct caml_runtime_events_cursor {
   int cursor_open;                  /* has this cursor been opened? */
   atomic_uintnat cursor_in_poll;    /* cursor is inside a read_poll() */
-  struct runtime_events_metadata_header *metadata; /* ptr to ring metadata */
+  void *map;
+  struct runtime_events_metadata_header metadata; /* copy of ring metadata */
   uint64_t *current_positions;      /* positions in the rings for each domain */
   size_t ring_file_size_bytes; /* size of the runtime_events file in bytes */
   int next_read_domain;        /* the next domain to read from */
@@ -88,106 +89,102 @@ struct caml_runtime_events_cursor {
 
 /* C-API for reading from an runtime_events */
 
-runtime_events_error
-caml_runtime_events_create_cursor(const char_os* runtime_events_path, int pid,
-                             struct caml_runtime_events_cursor **cursor_res) {
+/** Creates a new string with the path of the ring file. Returns a
+ * value from the runtime_events_error enum */
+static int format_runtime_ring_file(
+  const char_os *input_path, int input_pid,
+  char_os **out_ring_file
+) {
+  char_os *ring_file;
   int ret;
 
-#ifndef _WIN32
-  int ring_fd;
-  struct stat tmp_stat;
-#endif
-
-  struct caml_runtime_events_cursor *cursor =
-      caml_stat_alloc_noexc(sizeof(struct caml_runtime_events_cursor));
-  char_os *runtime_events_loc;
-
-  if (cursor == NULL) {
-    return E_ALLOC_FAIL;
-  }
-
-  runtime_events_loc = caml_stat_alloc_noexc(RING_FILE_NAME_MAX_LEN);
-
-  if (runtime_events_loc == NULL) {
-    caml_stat_free(cursor);
-    return E_ALLOC_FAIL;
-  }
-
-  /* If pid < 0 then we create a cursor for the current process */
-  if (pid < 0) {
-    runtime_events_loc = caml_runtime_events_current_location();
-
-    if( runtime_events_loc == NULL ) {
-      caml_stat_free(cursor);
-      return E_NO_CURRENT_RING;
+  if (input_pid < 0) {
+    /* Attaching to this process' ring, if it exists */
+    ring_file = caml_runtime_events_current_location();
+    if (ring_file == NULL) {
+      ret = E_NO_CURRENT_RING; /* could also be allocation failure */
+      goto fail_current_file;
     }
   } else {
-  /* In this case we are reading the ring for a different process */
-    if (runtime_events_path) {
-      char* path_u8 = caml_stat_strdup_of_os(runtime_events_path);
-      ret = snprintf_os(runtime_events_loc, RING_FILE_NAME_MAX_LEN,
-                      T("%s/%d.events"), path_u8, pid);
-      caml_stat_free(path_u8);
-    } else {
-      ret =
-          snprintf_os(runtime_events_loc, RING_FILE_NAME_MAX_LEN,
-                      T("%d.events"), pid);
+    /* Attaching to a process by directory and PID */
+    int err;
+    ring_file = caml_stat_alloc_noexc(RING_FILE_NAME_MAX_LEN);
+    if (ring_file == NULL) {
+      ret = E_ALLOC_FAIL;
+      goto fail_alloc_file;
     }
 
-    if (ret < 0) {
-      caml_stat_free(cursor);
-      caml_stat_free(runtime_events_loc);
-      return E_PATH_FAILURE;
+    if (input_path) {
+      err = snprintf_os(ring_file, RING_FILE_NAME_MAX_LEN,
+                        T("%s/%d.events"), input_path, input_pid);
+    } else {
+      err = snprintf_os(ring_file, RING_FILE_NAME_MAX_LEN,
+                        T("%d.events"), input_pid);
+    }
+    if (err < 0) {
+      ret = E_PATH_FAILURE;
+      goto fail_snprintf;
     }
   }
 
+  *out_ring_file = ring_file;
+  return E_SUCCESS;
+
+ fail_snprintf:
+  caml_stat_free(ring_file);
+ fail_alloc_file:
+ fail_current_file:
+  return ret;
+}
+
+/* Creates and maps the ring file. Returns a value from the
+ * runtime_events_error enum */
+
+static int
+cursor_map_ring_file(struct caml_runtime_events_cursor *cursor,
+                     char_os *ring_file)
+{
+  int ret = 0;
 #ifdef _WIN32
-  cursor->ring_file_handle = CreateFile(
-    runtime_events_loc,
-    GENERIC_READ | GENERIC_WRITE,
-    FILE_SHARE_READ | FILE_SHARE_WRITE,
-    NULL,
-    OPEN_EXISTING,
-    FILE_ATTRIBUTE_NORMAL,
-    NULL
-  );
-
-  if (cursor->ring_file_handle == INVALID_HANDLE_VALUE) {
-    caml_stat_free(cursor);
-    caml_stat_free(runtime_events_loc);
-    return E_OPEN_FAILURE;
+  HANDLE ring_file_handle = CreateFile(ring_file,
+                                       GENERIC_READ | GENERIC_WRITE,
+                                       FILE_SHARE_READ | FILE_SHARE_WRITE,
+                                       NULL,
+                                       OPEN_EXISTING,
+                                       FILE_ATTRIBUTE_NORMAL,
+                                       NULL);
+  if (ring_file_handle == INVALID_HANDLE_VALUE) {
+    ret = E_OPEN_FAILURE;
+    goto fail_create_file;
   }
 
-  cursor->ring_handle = CreateFileMapping(
-    cursor->ring_file_handle,
-    NULL,
-    PAGE_READWRITE,
-    0,
-    0,
-    NULL
-  );
-
-  if (cursor->ring_handle == INVALID_HANDLE_VALUE) {
-    caml_stat_free(cursor);
-    caml_stat_free(runtime_events_loc);
-    return E_MAP_FAILURE;
+  HANDLE ring_handle = CreateFileMapping(ring_file_handle, NULL,
+                                         PAGE_READWRITE, 0, 0, NULL);
+  if (ring_handle == INVALID_HANDLE_VALUE) {
+    ret = E_MAP_FAILURE;
+    goto fail_create_mapping;
   }
 
-  cursor->metadata = MapViewOfFile(
-    cursor->ring_handle,
-    FILE_MAP_ALL_ACCESS,
-    0,
-    0,
-    0
-  );
+  void *map = MapViewOfFile(ring_handle, FILE_MAP_ALL_ACCESS,
+                            0, 0, 0);
 
-  if( cursor->metadata == NULL ) {
-    caml_stat_free(cursor);
-    caml_stat_free(runtime_events_loc);
-    return E_MAP_FAILURE;
+  if( map == NULL ) {
+    ret = E_MAP_FAILURE;
+    goto fail_map_view;
   }
 
+  cursor->ring_file_handle = ring_file_handle;
+  cursor->ring_handle = ring_handle;
+  cursor->map = map;
   cursor->ring_file_size_bytes = GetFileSize(cursor->ring_file_handle, NULL);
+  return E_SUCCESS;
+
+ fail_map_view:
+  CloseHandle(ring_handle);
+ fail_create_mapping:
+  CloseHandle(ring_file_handle);
+ fail_create_file:
+  return ret;
 #else
 #if defined(__ARM_ARCH) && __ARM_ARCH <= 5
   /* Atomic 64-bit load requires RW memory on Debian armel.  See:
@@ -198,61 +195,117 @@ caml_runtime_events_create_cursor(const char_os* runtime_events_path, int pid,
   const int open_flags = O_RDONLY;
   const int mmap_prot = PROT_READ;
 #endif
-  ring_fd = open(runtime_events_loc, open_flags, 0);
-
-  if( ring_fd == -1 ) {
-    caml_stat_free(cursor);
-    caml_stat_free(runtime_events_loc);
-    return E_OPEN_FAILURE;
+  int ring_fd = open(ring_file, open_flags, 0);
+  if(ring_fd == -1) {
+    ret = E_OPEN_FAILURE;
+    goto fail_open;
   }
 
+  struct stat tmp_stat;
   ret = fstat(ring_fd, &tmp_stat);
-
   if (ret < 0) {
-    caml_stat_free(cursor);
-    caml_stat_free(runtime_events_loc);
-    return E_OPEN_FAILURE;
+    ret = E_OPEN_FAILURE;
+    goto fail_fstat;
   }
-
-  cursor->ring_file_size_bytes = tmp_stat.st_size;
+  size_t ring_file_size_bytes = tmp_stat.st_size;
 
   /* This cast is necessary for compatibility with Illumos' non-POSIX
     mmap/munmap */
-  cursor->metadata = (struct runtime_events_metadata_header *)
-                      mmap(NULL, cursor->ring_file_size_bytes, mmap_prot,
-                          MAP_SHARED, ring_fd, 0);
+  void *map = (void*) mmap(NULL, ring_file_size_bytes, mmap_prot,
+                           MAP_SHARED, ring_fd, 0);
 
-  if( cursor->metadata == MAP_FAILED ) {
-    caml_stat_free(cursor);
-    caml_stat_free(runtime_events_loc);
-    return E_MAP_FAILURE;
+  if( map == MAP_FAILED ) {
+    ret = E_MAP_FAILURE;
+    goto fail_map;
   }
+
+  (void)close(ring_fd);
+  cursor->map = map;
+  cursor->ring_file_size_bytes = ring_file_size_bytes;
+  return E_SUCCESS;
+
+ fail_map:
+ fail_fstat:
+  (void)close(ring_fd);
+ fail_open:
+  return ret;
+#endif
+}
+
+/* unmaps the ring file from a cursor */
+static void cursor_unmap_ring_file(struct caml_runtime_events_cursor *cursor)
+{
+#ifdef _WIN32
+  UnmapViewOfFile(cursor->map);
+  CloseHandle(cursor->ring_file_handle);
+  CloseHandle(cursor->ring_handle);
+#else
+  munmap(cursor->map, cursor->ring_file_size_bytes);
 #endif
+}
+
+runtime_events_error caml_runtime_events_create_cursor(
+  const char_os* runtime_events_path, int pid,
+  struct caml_runtime_events_cursor **cursor_res
+) {
+  int ret = E_SUCCESS;
+
+  struct caml_runtime_events_cursor *cursor =
+    caml_stat_alloc_noexc(sizeof(struct caml_runtime_events_cursor));
+  if (cursor == NULL) {
+    ret = E_ALLOC_FAIL;
+    goto fail_alloc_cursor;
+  }
+  /* zero out all fields, notably the callbacks */
+  memset(cursor, 0, sizeof(*cursor));
+
+  char_os *ring_file;
+  ret = format_runtime_ring_file(runtime_events_path, pid,
+                                 &ring_file);
+  if (ret != E_SUCCESS) {
+    goto fail_format_file;
+  }
+
+  ret = cursor_map_ring_file(cursor, ring_file);
+  if (ret != E_SUCCESS) {
+    goto fail_map_ring_file;
+  }
+
+  cursor->metadata = *(struct runtime_events_metadata_header*)cursor->map;
+
+  if (cursor->metadata.max_domains > Max_domains_max) {
+    ret = E_CORRUPT_STREAM;
+    goto fail_metadata_corrupt;
+  }
 
   cursor->current_positions =
-      caml_stat_alloc(cursor->metadata->max_domains * sizeof(uint64_t));
+      caml_stat_alloc_noexc(cursor->metadata.max_domains * sizeof(uint64_t));
+  if (cursor->current_positions == NULL) {
+    ret = E_ALLOC_FAIL;
+    goto fail_current_pos;
+  }
 
-  for (int j = 0; j < cursor->metadata->max_domains; j++) {
+  for (int j = 0; j < cursor->metadata.max_domains; j++) {
     cursor->current_positions[j] = 0;
   }
+
   cursor->cursor_open = 1;
   atomic_store(&cursor->cursor_in_poll, 0);
   cursor->next_read_domain = 0;
-
-  cursor->runtime_begin = NULL;
-  cursor->runtime_end = NULL;
-  cursor->runtime_counter = NULL;
-  cursor->alloc = NULL;
-  cursor->lifecycle = NULL;
-  cursor->lost_events = NULL;
-  cursor->user_unit = NULL;
-  cursor->user_int = NULL;
-  cursor->user_span = NULL;
-  cursor->user_custom = NULL;
-
   *cursor_res = cursor;
+  caml_stat_free(ring_file);
 
   return E_SUCCESS;
+
+ fail_current_pos:
+ fail_metadata_corrupt:
+  cursor_unmap_ring_file(cursor);
+ fail_map_ring_file:
+  caml_stat_free(ring_file);
+ fail_format_file:
+  caml_stat_free(cursor);
+ fail_alloc_cursor:
+  return ret;
 }
 
 void caml_runtime_events_set_runtime_begin(
@@ -346,20 +399,24 @@ void caml_runtime_events_set_user_custom(
 void caml_runtime_events_free_cursor(struct caml_runtime_events_cursor *cursor){
   if (cursor->cursor_open) {
     cursor->cursor_open = 0;
-#ifdef _WIN32
-    UnmapViewOfFile(cursor->metadata);
-    CloseHandle(cursor->ring_file_handle);
-    CloseHandle(cursor->ring_handle);
-#else
-    /* This cast is necessary for compatibility with Illumos' non-POSIX
-      mmap/munmap */
-    munmap((void*)cursor->metadata, cursor->ring_file_size_bytes);
-#endif
+    cursor_unmap_ring_file(cursor);
     caml_stat_free(cursor->current_positions);
     caml_stat_free(cursor);
   }
 }
 
+static char* get_map_offset(struct caml_runtime_events_cursor *cursor,
+                            uint64_t offset, int domain_num, uint64_t len)
+{
+  uint64_t limit = cursor->ring_file_size_bytes;
+  if (offset >= limit)
+    return NULL;
+  offset += domain_num * len;
+  if (offset >= limit || len > limit - offset)
+    return NULL;
+  return (char*)cursor->map + offset;
+}
+
 runtime_events_error
 caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
                          void *callback_data, uintnat max_events,
@@ -381,28 +438,51 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
     return E_CURSOR_POLL_BUSY;
   }
 
+  if (cursor->metadata.headers_offset > cursor->ring_file_size_bytes
+      || !cursor->metadata.ring_size_elements
+      || cursor->metadata.ring_size_elements * sizeof(uint64_t)
+         != cursor->metadata.ring_size_bytes
+      || cursor->metadata.ring_size_elements
+         > cursor->metadata.ring_size_bytes) {
+        atomic_store(&cursor->cursor_in_poll, 0);
+        return E_CORRUPT_STREAM;
+  }
+
   /* this loop looks a bit odd because we're iterating from the last domain
      that we read from on the last read_poll call and then looping around.
      This is necessary because in the case where the consumer can't keep up
      with message production (i.e max_events is hit each time) it ensures that
      messages are read from all domains, rather than just the first. */
-  for (int i = 0; i < cursor->metadata->max_domains && !early_exit; i++) {
-    int domain_num = (start_domain + i) % cursor->metadata->max_domains;
+  for (int i = 0; i < cursor->metadata.max_domains && !early_exit; i++) {
+    int domain_num = (start_domain + i) % cursor->metadata.max_domains;
+    uint64_t offset =
+          cursor->metadata.headers_offset +
+          domain_num * cursor->metadata.ring_header_size_bytes;
+    if (offset >= cursor->ring_file_size_bytes
+        || offset + cursor->metadata.ring_header_size_bytes
+           > cursor->ring_file_size_bytes) {
+        atomic_store(&cursor->cursor_in_poll, 0);
+        return E_CORRUPT_STREAM;
+    }
 
     struct runtime_events_buffer_header *runtime_events_buffer_header =
         (struct runtime_events_buffer_header *)(
-          (char*)cursor->metadata +
-          cursor->metadata->headers_offset +
-          domain_num * cursor->metadata->ring_header_size_bytes
+          get_map_offset(cursor, cursor->metadata.headers_offset,
+                         domain_num,
+                         cursor->metadata.ring_header_size_bytes)
         );
 
-    uint64_t *ring_ptr = (uint64_t *)((char*)cursor->metadata +
-                                      cursor->metadata->data_offset +
-                                domain_num * cursor->metadata->ring_size_bytes);
+    uint64_t *ring_ptr =
+      (uint64_t*)get_map_offset(cursor, cursor->metadata.data_offset,
+                                domain_num, cursor->metadata.ring_size_bytes);
+    if (!runtime_events_buffer_header || !ring_ptr) {
+        atomic_store(&cursor->cursor_in_poll, 0);
+        return E_CORRUPT_STREAM;
+    }
 
     do {
       uint64_t buf[RUNTIME_EVENTS_MAX_MSG_LENGTH];
-      uint64_t ring_mask, header, msg_length;
+      uint64_t ring_mask, header, msg_length, ring_masked_pos;
       ring_head = atomic_load_acquire(&runtime_events_buffer_header->ring_head);
       ring_tail = atomic_load_acquire(&runtime_events_buffer_header->ring_tail);
 
@@ -422,17 +502,20 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
         break;
       }
 
-      ring_mask = cursor->metadata->ring_size_elements - 1;
-      header = ring_ptr[cursor->current_positions[domain_num] & ring_mask];
+      ring_mask = cursor->metadata.ring_size_elements - 1;
+      ring_masked_pos = cursor->current_positions[domain_num] & ring_mask;
+      header = ring_ptr[ring_masked_pos];
       msg_length = RUNTIME_EVENTS_ITEM_LENGTH(header);
 
-      if (msg_length > RUNTIME_EVENTS_MAX_MSG_LENGTH) {
+      if (msg_length > RUNTIME_EVENTS_MAX_MSG_LENGTH
+          || ring_masked_pos + msg_length
+             > cursor->metadata.ring_size_elements) {
         atomic_store(&cursor->cursor_in_poll, 0);
         return E_CORRUPT_STREAM;
       }
 
       memcpy(buf,
-             ring_ptr + (cursor->current_positions[domain_num] & ring_mask),
+             ring_ptr + ring_masked_pos,
              msg_length * sizeof(uint64_t));
 
       atomic_thread_fence(memory_order_seq_cst);
@@ -455,6 +538,13 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
         continue;
       }
 
+      if (!msg_length
+          || (msg_length < 2
+              && RUNTIME_EVENTS_ITEM_TYPE(header) != EV_INTERNAL)) {
+        atomic_store(&cursor->cursor_in_poll, 0);
+        return E_CORRUPT_STREAM;
+      }
+
       if (RUNTIME_EVENTS_ITEM_IS_RUNTIME(header)) {
         switch (RUNTIME_EVENTS_ITEM_TYPE(header)) {
         case EV_BEGIN:
@@ -477,6 +567,10 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
           break;
         case EV_COUNTER:
           if (cursor->runtime_counter) {
+            if (msg_length < 3) {
+              atomic_store(&cursor->cursor_in_poll, 0);
+              return E_CORRUPT_STREAM;
+            }
             if( !cursor->runtime_counter(domain_num, callback_data, buf[1],
                                         RUNTIME_EVENTS_ITEM_ID(header), buf[2]
                                         ) ) {
@@ -487,6 +581,10 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
           break;
         case EV_ALLOC:
           if (cursor->alloc) {
+            if (msg_length < 3) {
+              atomic_store(&cursor->cursor_in_poll, 0);
+              return E_CORRUPT_STREAM;
+            }
             if( !cursor->alloc(domain_num, callback_data, buf[1], &buf[2])) {
               early_exit = 1;
               continue;
@@ -495,8 +593,11 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
           break;
         case EV_LIFECYCLE:
           if (cursor->lifecycle) {
+            /* EV_RING_STOP genuinely has msg_length = 2,
+               buf[2] is unused in that case */
+            int64_t data = msg_length > 2 ? buf[2] : 0;
             if( !cursor->lifecycle(domain_num, callback_data, buf[1],
-                                    RUNTIME_EVENTS_ITEM_ID(header), buf[2]) ) {
+                                    RUNTIME_EVENTS_ITEM_ID(header), data) ) {
                                       early_exit = 1;
                                       continue;
                                     }
@@ -506,9 +607,17 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
         // User events
         uintnat event_id = RUNTIME_EVENTS_ITEM_ID(header);
 
+        if (cursor->metadata.custom_events_offset > cursor->ring_file_size_bytes
+            || cursor->metadata.custom_events_offset
+               + (event_id+1) * sizeof(struct runtime_events_custom_event)
+               > cursor->ring_file_size_bytes) {
+          atomic_store(&cursor->cursor_in_poll, 0);
+          return E_CORRUPT_STREAM;
+        }
+
         struct runtime_events_custom_event *custom_event =
           &((struct runtime_events_custom_event *)
-            ((char *)cursor->metadata + cursor->metadata->custom_events_offset))
+            ((char *)cursor->map + cursor->metadata.custom_events_offset))
             [event_id];
         char* event_name = custom_event->name;
         ev_user_message_type event_type = RUNTIME_EVENTS_ITEM_TYPE(header);
@@ -542,6 +651,10 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
             break;
           case EV_USER_MSG_TYPE_INT:
             if (cursor->user_int) {
+              if (msg_length < 3) {
+                atomic_store(&cursor->cursor_in_poll, 0);
+                return E_CORRUPT_STREAM;
+              }
               if( !cursor->user_int(domain_num, callback_data, buf[1],
                                       event_id, event_name, buf[2]) ) {
                                         early_exit = 1;
@@ -551,6 +664,7 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
             break;
           default: // custom
             if (cursor->user_custom) {
+              /* msg_length could be genuinely 2 here */
               if( !cursor->user_custom(domain_num, callback_data, buf[1],
                                       event_id, event_name,
                                       msg_length - 2, &buf[2]) ) {
@@ -575,7 +689,7 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
     /* next domain to read from (saved in the cursor so we can resume from it
        if need be in the next poll of the cursor). */
     cursor->next_read_domain =
-      (domain_num + 1 == cursor->metadata->max_domains) ? 0 : domain_num + 1;
+      (domain_num + 1 == cursor->metadata.max_domains) ? 0 : domain_num + 1;
   }
 
   if (events_consumed != NULL) {
@@ -700,12 +814,10 @@ static int ml_alloc(int domain_id, void *callback_data, uint64_t timestamp,
 
   tmp_callback = Field(callbacks_root, 3); /* ev_alloc */
   if (Is_some(tmp_callback)) {
-    int i;
-
     ts_val = caml_copy_int64(timestamp);
     misc_val = caml_alloc(RUNTIME_EVENTS_NUM_ALLOC_BUCKETS, 0);
 
-    for (i = 0; i < RUNTIME_EVENTS_NUM_ALLOC_BUCKETS; i++) {
+    for (int i = 0; i < RUNTIME_EVENTS_NUM_ALLOC_BUCKETS; i++) {
       Store_field(misc_val, i, Val_long(sz[i]));
     }
 
@@ -1118,11 +1230,11 @@ CAMLprim value caml_ml_runtime_events_create_cursor(value path_pid_option) {
 
   res = caml_runtime_events_create_cursor(path, pid, &cursor);
 
-  if (res != E_SUCCESS) {
-    if( path != NULL ) {
-      caml_stat_free(path);
-    }
+  if( path != NULL ) {
+    caml_stat_free(path);
+  }
 
+  if (res != E_SUCCESS) {
     switch(res) {
       case E_PATH_FAILURE:
         caml_failwith(
@@ -1155,10 +1267,6 @@ CAMLprim value caml_ml_runtime_events_create_cursor(value path_pid_option) {
 
   Cursor_val(wrapper) = cursor;
 
-  if( path != NULL ) {
-    caml_stat_free(path);
-  }
-
   // 3 words block:
   //  - cursor
   //  - custom event read buffer: bytes
@@ -1229,4 +1337,4 @@ CAMLprim value caml_ml_runtime_events_read_poll(value wrapper,
   }
 
   CAMLreturn(Val_int(events_consumed));
-};
+}

diff --git a/otherlibs/str/strstubs.c b/otherlibs/str/strstubs.c
index f528189fa4c6c51bfeca77e465af113970665fae..c88ede27d07d42e192a4248acdde27eb539d46bc 100644 (file)
--- a/otherlibs/str/strstubs.c
+++ b/otherlibs/str/strstubs.c
@@ -129,11 +129,10 @@ static value re_alloc_groups(value re, unsigned char * starttxt,
 {
   value res;
   int n = Numgroups(re);
-  int i;
   struct re_group * group;
 
   res = caml_alloc(n * 2, 0);
-  for (i = 0; i < n; i++) {
+  for (int i = 0; i < n; i++) {
     group = &(groups[i]);
     if (group->start == NULL || group->end == NULL) {
       Field(res, i * 2) = Val_int(-1);
@@ -281,9 +280,8 @@ static value re_match(value re,
     case REFGROUP: {
       int group_no = Arg(instr);
       struct re_group * group = &(groups[group_no]);
-      unsigned char * s;
       if (group->start == NULL || group->end == NULL) goto backtrack;
-      for (s = group->start; s < group->end; s++) {
+      for (unsigned char *s = group->start; s < group->end; s++) {
         if (txt == endtxt) goto prefix_match;
         if (*s != *txt) goto backtrack;
         txt++;

diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile
index c77bf56fb85657f359f5abba7dd26ab6d66d95ac..64d41cc19d66aac7a6a1bcae027ab5cf125c173b 100644 (file)
--- a/otherlibs/systhreads/Makefile
+++ b/otherlibs/systhreads/Makefile
@@ -18,11 +18,8 @@ ROOTDIR=../..
 include $(ROOTDIR)/Makefile.common
 include $(ROOTDIR)/Makefile.best_binaries
 
-ifneq "$(CCOMPTYPE)" "msvc"
-OC_CFLAGS += -g
-endif
-
-OC_CFLAGS += $(SHAREDLIB_CFLAGS)
+OC_BYTECODE_CFLAGS += $(SHAREDLIB_CFLAGS)
+OC_NATIVE_CFLAGS += $(SHAREDLIB_CFLAGS)
 
 LIBS = $(STDLIBFLAGS) -I $(ROOTDIR)/otherlibs/unix
 
@@ -58,10 +55,12 @@ all: lib$(LIBNAME).$(A) $(LIBNAME).cma $(CMIFILES)
 
 allopt: lib$(LIBNAME)nat.$(A) $(LIBNAME).cmxa $(CMIFILES)
 
+lib$(LIBNAME).$(A): OC_CFLAGS = $(OC_BYTECODE_CFLAGS)
+
 lib$(LIBNAME).$(A): $(BYTECODE_C_OBJS)
        $(V_OCAMLMKLIB)$(MKLIB) -o $(LIBNAME) $(BYTECODE_C_OBJS)
 
-lib$(LIBNAME)nat.$(A): OC_CFLAGS += $(OC_NATIVE_CFLAGS)
+lib$(LIBNAME)nat.$(A): OC_CFLAGS = $(OC_NATIVE_CFLAGS)
 
 lib$(LIBNAME)nat.$(A): $(NATIVECODE_C_OBJS)
        $(V_OCAMLMKLIB)$(MKLIB) -o $(LIBNAME)nat $^
@@ -82,8 +81,8 @@ st_stubs.%.$(O): st_stubs.c
 else
 st_stubs.%.$(O): st_stubs.c $(RUNTIME_HEADERS) $(wildcard *.h)
 endif
-       $(V_CC)$(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
-         $(OUTPUTOBJ)$@ $<
+       $(V_CC)$(CC) $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
+         $(OUTPUTOBJ)$@ -c $<
 
 .PHONY: partialclean
 partialclean:
@@ -141,8 +140,9 @@ ifeq "$(COMPUTE_DEPS)" "true"
 include $(addprefix $(DEPDIR)/, $(DEP_FILES))
 endif
 
-%.n.$(O): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
-%.n.$(D): OC_CPPFLAGS += $(OC_NATIVE_CPPFLAGS)
+%.b.$(D): OC_CPPFLAGS = $(OC_BYTECODE_CPPFLAGS)
+%.n.$(O): OC_CPPFLAGS = $(OC_NATIVE_CPPFLAGS)
+%.n.$(D): OC_CPPFLAGS = $(OC_NATIVE_CPPFLAGS)
 
 define GEN_RULE
 $(DEPDIR)/%.$(1).$(D): %.c | $(DEPDIR)

diff --git a/otherlibs/systhreads/st_posix.h b/otherlibs/systhreads/st_posix.h
index 1ed25fdef357b745ca496cf2f7b04983a57f92f3..31b367afc9679ad97a274180fa06e89a30018a4e 100644 (file)
--- a/otherlibs/systhreads/st_posix.h
+++ b/otherlibs/systhreads/st_posix.h
@@ -46,11 +46,10 @@ static value st_encode_sigset(sigset_t * set)
 {
   CAMLparam0();
   CAMLlocal1(res);
-  int i;
 
   res = Val_emptylist;
 
-  for (i = 1; i < NSIG; i++)
+  for (int i = 1; i < NSIG; i++)
     if (sigismember(set, i) > 0) {
       res = caml_alloc_2(Tag_cons,
                          Val_int(caml_rev_convert_signal_number(i)), res);

diff --git a/otherlibs/systhreads/st_pthreads.h b/otherlibs/systhreads/st_pthreads.h
index f461988b541862012910573ac12c636156df79eb..16991acfef28c34696200d8b6cc573aa9f3c7fd3 100644 (file)
--- a/otherlibs/systhreads/st_pthreads.h
+++ b/otherlibs/systhreads/st_pthreads.h
@@ -28,23 +28,16 @@
 
 typedef int st_retcode;
 
-/* Variables used to stop "tick" threads */
-static atomic_uintnat tick_thread_stop[Max_domains];
-#define Tick_thread_stop tick_thread_stop[Caml_state->id]
-
 /* OS-specific initialization */
-
 static int st_initialize(void)
 {
-  atomic_store_release(&Tick_thread_stop, 0);
   return 0;
 }
 
-/* Thread creation.  Created in detached mode if [res] is NULL. */
-
 typedef pthread_t st_thread_id;
 
 
+/* Thread creation. Created in detached mode if [res] is NULL. */
 static int st_thread_create(st_thread_id * res,
                             void * (*fn)(void *), void * arg)
 {
@@ -292,16 +285,24 @@ static int st_event_wait(st_event e)
   return rc;
 }
 
-/* The tick thread: interrupt the domain periodically to force preemption  */
+struct caml_thread_tick_args {
+  int domain_id;
+  atomic_uintnat* stop;
+};
 
+/* The tick thread: interrupt the domain periodically to force preemption  */
 static void * caml_thread_tick(void * arg)
 {
-  int *domain_id = (int *) arg;
+  struct caml_thread_tick_args* tick_thread_args =
+    (struct caml_thread_tick_args*) arg;
+  int domain_id = tick_thread_args->domain_id;
+  atomic_uintnat* stop = tick_thread_args->stop;
+  caml_stat_free(tick_thread_args);
 
-  caml_init_domain_self(*domain_id);
+  caml_init_domain_self(domain_id);
   caml_domain_state *domain = Caml_state;
 
-  while(! atomic_load_acquire(&Tick_thread_stop)) {
+  while(! atomic_load_acquire(stop)) {
     st_msleep(Thread_timeout);
 
     atomic_store_release(&domain->requested_external_interrupt, 1);

diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c
index 5d08ea03c070f726c2fc08a651b3ec1074a241ad..fdb432540daeab857a2d7d14ce31df52621d8c16 100644 (file)
--- a/otherlibs/systhreads/st_stubs.c
+++ b/otherlibs/systhreads/st_stubs.c
@@ -15,13 +15,16 @@
 
 #define CAML_INTERNALS
 
-#if defined(_WIN32) && !defined(NATIVE_CODE)
+#if defined(_WIN32) && !defined(NATIVE_CODE) && !defined(_MSC_VER)
 /* Ensure that pthread.h marks symbols __declspec(dllimport) so that they can be
    picked up from the runtime (which will have linked winpthreads statically).
    mingw-w64 11.0.0 introduced WINPTHREADS_USE_DLLIMPORT to do this explicitly;
    prior versions co-opted this on the internal DLL_EXPORT, but this is ignored
    in 11.0 and later unless IN_WINPTHREAD is also defined, so we can safely
-   define both to support both versions. */
+   define both to support both versions.
+   When compiling with MSVC, we currently link directly the winpthreads objects
+   into our runtime, so we do not want to mark its symbols with
+   __declspec(dllimport). */
 #define WINPTHREADS_USE_DLLIMPORT
 #define DLL_EXPORT
 #endif
@@ -44,6 +47,7 @@
 #include "caml/printexc.h"
 #include "caml/roots.h"
 #include "caml/signals.h"
+#include "caml/startup_aux.h"
 #include "caml/sync.h"
 #include "caml/sys.h"
 #include "caml/memprof.h"
@@ -115,10 +119,11 @@ struct caml_thread_table {
   st_masterlock thread_lock;
   int tick_thread_running;
   st_thread_id tick_thread_id;
+  atomic_uintnat tick_thread_stop;
 };
 
-/* thread_table instance, up to Max_domains */
-static struct caml_thread_table thread_table[Max_domains];
+/* thread_table instance, up to caml_params->max_domains */
+static struct caml_thread_table* thread_table;
 
 #define Thread_lock(dom_id) &thread_table[dom_id].thread_lock
 
@@ -132,6 +137,9 @@ static void thread_lock_release(int dom_id)
   st_masterlock_release(Thread_lock(dom_id));
 }
 
+/* Used to signal that the "tick" thread for this domain should be stopped. */
+#define Tick_thread_stop thread_table[Caml_state->id].tick_thread_stop
+
 /* The remaining fields are accessed while holding the domain lock */
 
 /* The descriptor for the currently executing thread for this domain;
@@ -414,7 +422,6 @@ static void caml_thread_reinitialize(void)
      are hopeless.)
   */
 
-  struct channel * chan;
   caml_thread_t th, next;
 
   th = Active_thread->next;
@@ -443,7 +450,7 @@ static void caml_thread_reinitialize(void)
   /* Reinitialize IO mutexes, in case the fork happened while another thread
      had locked the channel. If so, we're likely in an inconsistent state,
      but we may be able to proceed anyway. */
-  for (chan = caml_all_opened_channels;
+  for (struct channel *chan = caml_all_opened_channels;
        chan != NULL;
        chan = chan->next) {
     caml_plat_mutex_init(&chan->mutex);
@@ -484,9 +491,9 @@ static void caml_thread_domain_stop_hook(void) {
    yet. */
 static void caml_thread_domain_initialize_hook(void)
 {
-
   caml_thread_t new_thread;
 
+  atomic_store_release(&Tick_thread_stop, 0);
   /* OS-specific initialization */
   st_initialize();
 
@@ -502,6 +509,7 @@ static void caml_thread_domain_initialize_hook(void)
   new_thread->prev = new_thread;
   new_thread->backtrace_last_exn = Val_unit;
   new_thread->memprof = caml_memprof_main_thread(Caml_state);
+  new_thread->signal_stack = NULL;
 
   st_tls_set(caml_thread_key, new_thread);
 
@@ -542,6 +550,12 @@ CAMLprim value caml_thread_initialize(value unit)
     caml_failwith("caml_thread_initialize: cannot initialize Thread "
                   "while several domains are running.");
 
+  thread_table = caml_stat_calloc_noexc(caml_params->max_domains,
+                                        sizeof(struct caml_thread_table));
+  if (thread_table == NULL)
+    caml_fatal_error("caml_thread_initialize: failed to allocate thread"
+                     " table");
+
   /* Initialize the key to the [caml_thread_t] structure */
   st_tls_newkey(&caml_thread_key);
 
@@ -649,8 +663,16 @@ static st_retcode create_tick_thread(void)
   pthread_sigmask(SIG_BLOCK, &mask, &old_mask);
 #endif
 
+  struct caml_thread_tick_args* tick_thread_args =
+    caml_stat_alloc_noexc(sizeof(struct caml_thread_tick_args));
+  if (tick_thread_args == NULL)
+    caml_fatal_error("create_tick_thread: failed to allocate thread args");
+
+  tick_thread_args->domain_id = Caml_state->id;
+  tick_thread_args->stop = &Tick_thread_stop;
+
   st_retcode err = st_thread_create(&Tick_thread_id, caml_thread_tick,
-                         (void *) &Caml_state->id);
+                                    (void *)tick_thread_args);
 
 #ifdef POSIX_SIGNALS
   pthread_sigmask(SIG_SETMASK, &old_mask, NULL);

diff --git a/otherlibs/unix/access.c b/otherlibs/unix/access.c
index 723cff1f88bbf4cf2b6bce9eb1bf05949c3feb7c..3e5ab2a4a90f71f95f6540a0a729cefe2eb2ae72 100644 (file)
--- a/otherlibs/unix/access.c
+++ b/otherlibs/unix/access.c
@@ -24,7 +24,9 @@
 #ifdef HAS_UNISTD
 # include <unistd.h>
 #else
-# ifndef _WIN32
+# ifdef _WIN32
+#  include <io.h>
+# else
 #  include <sys/file.h>
 # endif
 # ifndef R_OK

diff --git a/otherlibs/unix/channels_win32.c b/otherlibs/unix/channels_win32.c
index fa7de1a195a761c886f56baa3a9d3a8de3dba2da..c493807f9a1e57ccc766db179127bac2f0e6704d 100644 (file)
--- a/otherlibs/unix/channels_win32.c
+++ b/otherlibs/unix/channels_win32.c
@@ -19,6 +19,7 @@
 #include <caml/alloc.h>
 #include <caml/io.h>
 #include <caml/memory.h>
+#include <caml/platform.h>
 #include "caml/unixsupport.h"
 #include <fcntl.h>
 #include <io.h>
@@ -101,7 +102,6 @@ CAMLprim value caml_unix_inchannel_of_filedescr(value handle)
   CAMLlocal1(vchan);
   int flags = 0;
   int fd;
-  struct channel * chan;
   DWORD err;
 
   err = check_stream_semantics(handle);
@@ -122,7 +122,6 @@ CAMLprim value caml_unix_outchannel_of_filedescr(value handle)
   CAMLlocal1(vchan);
   int fd;
   int flags = 0;
-  struct channel * chan;
   DWORD err;
 
   err = check_stream_semantics(handle);

diff --git a/otherlibs/unix/chmod.c b/otherlibs/unix/chmod.c
index ebcc28b4b280cfe9b70faa8131f0f263ebb34fa7..ef6bb455a2f290d3140adeb9ad245029cb0a053d 100644 (file)
--- a/otherlibs/unix/chmod.c
+++ b/otherlibs/unix/chmod.c
@@ -17,6 +17,9 @@
 
 #include <sys/types.h>
 #include <sys/stat.h>
+#ifdef _WIN32
+#include <io.h>
+#endif
 #include <caml/mlvalues.h>
 #include <caml/memory.h>
 #include <caml/signals.h>

diff --git a/otherlibs/unix/close_win32.c b/otherlibs/unix/close_win32.c
index 6328bbd8dd9f465ad9b8bb58aa69bf7e67fa5dd3..3123fc366789a079626cf4e3834ba9897aca5fe6 100644 (file)
--- a/otherlibs/unix/close_win32.c
+++ b/otherlibs/unix/close_win32.c
@@ -13,6 +13,7 @@
 /*                                                                        */
 /**************************************************************************/
 
+#include <io.h>
 #include <caml/mlvalues.h>
 #include "caml/unixsupport.h"
 #include <caml/io.h>

diff --git a/otherlibs/unix/createprocess.c b/otherlibs/unix/createprocess.c
index a876d1f0ec8c61e8927ec4a8608048abbeb4c1eb..10ccf9b6d977b3bb49cc41336141350ffd492599 100644 (file)
--- a/otherlibs/unix/createprocess.c
+++ b/otherlibs/unix/createprocess.c
@@ -154,8 +154,7 @@ CAMLprim value caml_unix_create_process(value * argv, int argn)
 
 static int has_console(void)
 {
-  HANDLE h, log;
-  int i;
+  HANDLE h;
 
   h = CreateFile(L"CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
                  OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);

diff --git a/otherlibs/unix/cst2constr.c b/otherlibs/unix/cst2constr.c
index 7bade04709dac1579b915d99d54cd0ace5095d92..6cd6c73a0c59bbed389e8e4b954b48596413d00a 100644 (file)
--- a/otherlibs/unix/cst2constr.c
+++ b/otherlibs/unix/cst2constr.c
@@ -19,8 +19,7 @@
 
 value caml_unix_cst_to_constr(int n, const int *tbl, int size, int deflt)
 {
-  int i;
-  for (i = 0; i < size; i++)
+  for (int i = 0; i < size; i++)
     if (n == tbl[i]) return Val_int(i);
   return Val_int(deflt);
 }

diff --git a/otherlibs/unix/cstringv.c b/otherlibs/unix/cstringv.c
index f41045d54a47db3bcc04600b2efdc0c3042d6985..572b9d4a684df52b63bad7a35493c102d2362c14 100644 (file)
--- a/otherlibs/unix/cstringv.c
+++ b/otherlibs/unix/cstringv.c
@@ -24,14 +24,14 @@
 char_os ** caml_unix_cstringvect(value arg, char * cmdname)
 {
   char_os ** res;
-  mlsize_t size, i;
+  mlsize_t size;
 
   size = Wosize_val(arg);
-  for (i = 0; i < size; i++)
+  for (mlsize_t i = 0; i < size; i++)
     if (! caml_string_is_c_safe(Field(arg, i)))
       caml_unix_error(EINVAL, cmdname, Field(arg, i));
   res = (char_os **) caml_stat_alloc((size + 1) * sizeof(char_os *));
-  for (i = 0; i < size; i++)
+  for (mlsize_t i = 0; i < size; i++)
     res[i] = caml_stat_strdup_to_os(String_val(Field(arg, i)));
   res[size] = NULL;
   return res;

diff --git a/otherlibs/unix/dup_win32.c b/otherlibs/unix/dup_win32.c
index 02a472f4feb0bd49f1400bd579f69d0bc52ccdc9..84395a5e3bc586ab5eec330c9f387dca788e2209 100644 (file)
--- a/otherlibs/unix/dup_win32.c
+++ b/otherlibs/unix/dup_win32.c
@@ -20,6 +20,7 @@
 
 #define _WIN32_LEAN_AND_MEAN
 #include <winsock2.h>
+#include <io.h>
 
 static HANDLE duplicate_handle(BOOL inherit, HANDLE oldh)
 {

diff --git a/otherlibs/unix/execvp.c b/otherlibs/unix/execvp.c
index 02a908ad80f1f46a4bc8a0b6eba274fd5762a530..b9052d186221521cf7612e269c3d73d292e755b6 100644 (file)
--- a/otherlibs/unix/execvp.c
+++ b/otherlibs/unix/execvp.c
@@ -15,12 +15,12 @@
 
 #define _GNU_SOURCE  /* helps to find execvpe() */
 #include <string.h>
+#include <errno.h>
 #include <caml/mlvalues.h>
 #include <caml/memory.h>
 #define CAML_INTERNALS
 #include <caml/osdeps.h>
 #include "caml/unixsupport.h"
-#include "errno.h"
 
 CAMLprim value caml_unix_execvp(value path, value args)
 {
@@ -73,7 +73,7 @@ static int caml_unix_execve_script(const char * path,
                               char * const argv[],
                               char * const envp[])
 {
-  size_t argc, i;
+  size_t argc;
   char ** new_argv;
 
   /* Try executing directly.  Will not return if it succeeds. */
@@ -87,7 +87,7 @@ static int caml_unix_execve_script(const char * path,
   if (new_argv == NULL) return ENOMEM;
   new_argv[0] = "/bin/sh";
   new_argv[1] = (char *) path;
-  for (i = 1; i < argc; i++) new_argv[i + 1] = argv[i];
+  for (size_t i = 1; i < argc; i++) new_argv[i + 1] = argv[i];
   new_argv[argc + 1] = NULL;
   /* Execute the shell with the new argument vector.
      Will not return if it succeeds. */

diff --git a/otherlibs/unix/getaddrinfo.c b/otherlibs/unix/getaddrinfo.c
index 91cbe69d910430c299a6fbb604e0cdbe808ace49..a7a164353e94dbbc46fbdff4350b661601038383 100644 (file)
--- a/otherlibs/unix/getaddrinfo.c
+++ b/otherlibs/unix/getaddrinfo.c
@@ -31,8 +31,8 @@
 #include <netdb.h>
 #endif
 
-extern int caml_unix_socket_domain_table[]; /* from socket.c */
-extern int caml_unix_socket_type_table[];   /* from socket.c */
+extern const int caml_unix_socket_domain_table[]; /* from socket.c */
+extern const int caml_unix_socket_type_table[];   /* from socket.c */
 
 static value convert_addrinfo(struct addrinfo * a)
 {
@@ -63,7 +63,7 @@ CAMLprim value caml_unix_getaddrinfo(value vnode, value vserv, value vopts)
   CAMLlocal3(vres, v, e);
   char * node, * serv;
   struct addrinfo hints;
-  struct addrinfo * res, * r;
+  struct addrinfo * res;
   int retcode;
 
   if (! (caml_string_is_c_safe(vnode) && caml_string_is_c_safe(vserv)))
@@ -117,7 +117,7 @@ CAMLprim value caml_unix_getaddrinfo(value vnode, value vserv, value vopts)
   /* Convert result */
   vres = Val_emptylist;
   if (retcode == 0) {
-    for (r = res; r != NULL; r = r->ai_next) {
+    for (struct addrinfo *r = res; r != NULL; r = r->ai_next) {
       e = convert_addrinfo(r);
       v = caml_alloc_small(2, Tag_cons);
       Field(v, 0) = e;

diff --git a/otherlibs/unix/getgroups.c b/otherlibs/unix/getgroups.c
index 5f44329fbcd5dca960320d79bd5c6137c86d4cbf..22d13ad025fbeacc2151c9716df206310ddf3c8d 100644 (file)
--- a/otherlibs/unix/getgroups.c
+++ b/otherlibs/unix/getgroups.c
@@ -31,12 +31,11 @@ CAMLprim value caml_unix_getgroups(value unit)
   gid_t gidset[NGROUPS_MAX];
   int n;
   value res;
-  int i;
 
   n = getgroups(NGROUPS_MAX, gidset);
   if (n == -1) caml_uerror("getgroups", Nothing);
   res = caml_alloc_tuple(n);
-  for (i = 0; i < n; i++)
+  for (int i = 0; i < n; i++)
     Field(res, i) = Val_int(gidset[i]);
   return res;
 }

diff --git a/otherlibs/unix/gethost.c b/otherlibs/unix/gethost.c
index a4d44d1c17757066a774649677031df5e2474e00..728b3d6440a0325545acd72199599e57bd95654c 100644 (file)
--- a/otherlibs/unix/gethost.c
+++ b/otherlibs/unix/gethost.c
@@ -13,6 +13,8 @@
 /*                                                                        */
 /**************************************************************************/
 
+#define _WINSOCK_DEPRECATED_NO_WARNINGS /* gethostbyaddr, gethostbyname */
+
 #include <string.h>
 #include <caml/mlvalues.h>
 #include <caml/alloc.h>

diff --git a/otherlibs/unix/gettimeofday_win32.c b/otherlibs/unix/gettimeofday_win32.c
index f953a0149506ef9c7cd4df7b6c9d57a4cea568e1..8689b4d0f52efa93078e512f206524234c621047 100644 (file)
--- a/otherlibs/unix/gettimeofday_win32.c
+++ b/otherlibs/unix/gettimeofday_win32.c
@@ -25,7 +25,7 @@
 double caml_unix_gettimeofday_unboxed(value unit)
 {
   CAML_ULONGLONG_FILETIME utime;
-  double tm;
+  ULONGLONG tm;
   GetSystemTimeAsFileTime(&utime.ft);
   tm = utime.ul - CAML_NT_EPOCH_100ns_TICKS;
   return (tm * 1e-7);  /* tm is in 100ns */

diff --git a/otherlibs/unix/lseek_win32.c b/otherlibs/unix/lseek_win32.c
index b38982a3c5e48c8b7e0ccf8e76d2c0fcba3c8440..10903f3dfa0c18d6e3a797c37137175e3326d6f3 100644 (file)
--- a/otherlibs/unix/lseek_win32.c
+++ b/otherlibs/unix/lseek_win32.c
@@ -26,7 +26,7 @@
 #define SEEK_END 2
 #endif
 
-static DWORD seek_command_table[] = {
+static const DWORD seek_command_table[] = {
   FILE_BEGIN, FILE_CURRENT, FILE_END
 };
 

diff --git a/otherlibs/unix/mmap_ba.c b/otherlibs/unix/mmap_ba.c
index 35348097ff9a6d9b1baf073c090076d459d4681a..df832e9b7f8663a59f01f5ba852e2f812b70de7a 100644 (file)
--- a/otherlibs/unix/mmap_ba.c
+++ b/otherlibs/unix/mmap_ba.c
@@ -61,14 +61,14 @@ CAMLexport value
 caml_unix_mapped_alloc(int flags, int num_dims, void * data, intnat * dim)
 {
   uintnat asize;
-  int i;
   value res;
   struct caml_ba_array * b;
   intnat dimcopy[CAML_BA_MAX_NUM_DIMS];
 
-  CAMLassert(num_dims >= 0 && num_dims <= CAML_BA_MAX_NUM_DIMS);
+  CAMLassert(0 <= num_dims);
+  CAMLassert(num_dims <= CAML_BA_MAX_NUM_DIMS);
   CAMLassert((flags & CAML_BA_KIND_MASK) < CAML_BA_FIRST_UNIMPLEMENTED_KIND);
-  for (i = 0; i < num_dims; i++) dimcopy[i] = dim[i];
+  for (int i = 0; i < num_dims; i++) dimcopy[i] = dim[i];
   asize = SIZEOF_BA_ARRAY + num_dims * sizeof(intnat);
   res = caml_alloc_custom(&caml_ba_mapped_ops, asize, 0, 1);
   b = Caml_ba_array_val(res);
@@ -76,6 +76,6 @@ caml_unix_mapped_alloc(int flags, int num_dims, void * data, intnat * dim)
   b->num_dims = num_dims;
   b->flags = flags | CAML_BA_MAPPED_FILE;
   b->proxy = NULL;
-  for (i = 0; i < num_dims; i++) b->dim[i] = dimcopy[i];
+  for (int i = 0; i < num_dims; i++) b->dim[i] = dimcopy[i];
   return res;
 }

diff --git a/otherlibs/unix/mmap_unix.c b/otherlibs/unix/mmap_unix.c
index 56a837ca2366e61c62963926801b38d540f0de01..b61448ac0cff7fd331ddfa19659acf21c0576d26 100644 (file)
--- a/otherlibs/unix/mmap_unix.c
+++ b/otherlibs/unix/mmap_unix.c
@@ -97,7 +97,7 @@ CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
                                   value vshared, value vdim, value vstart)
 {
   int fd, flags, major_dim, shared;
-  intnat num_dims, i;
+  intnat num_dims;
   intnat dim[CAML_BA_MAX_NUM_DIMS];
   file_offset startpos, file_size, data_size;
   struct stat st;
@@ -113,7 +113,7 @@ CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
   num_dims = Wosize_val(vdim);
   if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
     caml_invalid_argument("Unix.map_file: bad number of dimensions");
-  for (i = 0; i < num_dims; i++) {
+  for (intnat i = 0; i < num_dims; i++) {
     dim[i] = Long_val(Field(vdim, i));
     if (dim[i] == -1 && i == major_dim) continue;
     if (dim[i] < 0)
@@ -131,7 +131,7 @@ CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
   /* Determine array size in bytes (or size of array without the major
      dimension if that dimension wasn't specified) */
   array_size = caml_ba_element_size[flags & CAML_BA_KIND_MASK];
-  for (i = 0; i < num_dims; i++)
+  for (intnat i = 0; i < num_dims; i++)
     if (dim[i] != -1) array_size *= dim[i];
   /* Check if the major dimension is unknown */
   if (dim[major_dim] == -1) {

diff --git a/otherlibs/unix/mmap_win32.c b/otherlibs/unix/mmap_win32.c
index d0e6fd7722ec380479209d8ae744c3f78cc8cecc..60062d8dee13dc8a7aa04fe6386f8bd12d767e20 100644 (file)
--- a/otherlibs/unix/mmap_win32.c
+++ b/otherlibs/unix/mmap_win32.c
@@ -40,12 +40,11 @@ CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
 {
   HANDLE fd, fmap;
   int flags, major_dim, mode, perm;
-  intnat num_dims, i;
+  intnat num_dims;
   intnat dim[CAML_BA_MAX_NUM_DIMS];
   __int64 startpos, data_size;
   LARGE_INTEGER file_size;
-  uintnat array_size, page, delta;
-  char c;
+  uintnat array_size, delta;
   void * addr;
   LARGE_INTEGER li;
   SYSTEM_INFO sysinfo;
@@ -59,7 +58,7 @@ CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
   num_dims = Wosize_val(vdim);
   if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS)
     caml_invalid_argument("Unix.map_file: bad number of dimensions");
-  for (i = 0; i < num_dims; i++) {
+  for (intnat i = 0; i < num_dims; i++) {
     dim[i] = Long_val(Field(vdim, i));
     if (dim[i] == -1 && i == major_dim) continue;
     if (dim[i] < 0)
@@ -71,7 +70,7 @@ CAMLprim value caml_unix_map_file(value vfd, value vkind, value vlayout,
   /* Determine array size in bytes (or size of array without the major
      dimension if that dimension wasn't specified) */
   array_size = caml_ba_element_size[flags & CAML_BA_KIND_MASK];
-  for (i = 0; i < num_dims; i++)
+  for (intnat i = 0; i < num_dims; i++)
     if (dim[i] != -1) array_size *= dim[i];
   /* Check if the first/last dimension is unknown */
   if (dim[major_dim] == -1) {

diff --git a/otherlibs/unix/nanosecond_stat.h b/otherlibs/unix/nanosecond_stat.h
deleted file mode 100644 (file)
index 6abeb57..0000000
--- a/otherlibs/unix/nanosecond_stat.h
+++ /dev/null
@@ -1,27 +0,0 @@
-/**************************************************************************/
-/*                                                                        */
-/*                                 OCaml                                  */
-/*                                                                        */
-/*                  Jeremie Dimino, Jane Street Group, LLC                */
-/*                                                                        */
-/*   Copyright 2015 Institut National de Recherche en Informatique et     */
-/*     en Automatique.                                                    */
-/*                                                                        */
-/*   All rights reserved.  This file is distributed under the terms of    */
-/*   the GNU Lesser General Public License version 2.1, with the          */
-/*   special exception on linking described in the file LICENSE.          */
-/*                                                                        */
-/**************************************************************************/
-
-/* This file is used by the configure test program nanosecond_stat.c
-   and stat.c in this directory */
-
-#if HAS_NANOSECOND_STAT == 1
-#  define NSEC(buf, field) buf->st_##field##tim.tv_nsec
-#elif HAS_NANOSECOND_STAT == 2
-#  define NSEC(buf, field) buf->st_##field##timespec.tv_nsec
-#elif HAS_NANOSECOND_STAT == 3
-#  define NSEC(buf, field) buf->st_##field##timensec
-#else
-#  define NSEC(buf, field) 0
-#endif

diff --git a/otherlibs/unix/open_win32.c b/otherlibs/unix/open_win32.c
index b9ead8ca55805588cfb1ccccdc1dc491b6d988a1..d15177d54e8ddfd2667340ebeceab8feee8c1c00 100644 (file)
--- a/otherlibs/unix/open_win32.c
+++ b/otherlibs/unix/open_win32.c
@@ -24,7 +24,7 @@
 
 static const int open_access_flags[15] = {
   GENERIC_READ, GENERIC_WRITE, GENERIC_READ|GENERIC_WRITE,
-  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
+  0, FILE_APPEND_DATA, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
 };
 
 static const int open_create_flags[15] = {
@@ -46,6 +46,7 @@ CAMLprim value caml_unix_open(value path, value flags, value perm)
   int fileaccess, createflags, fileattrib, filecreate, sharemode, cloexec;
   SECURITY_ATTRIBUTES attr;
   HANDLE h;
+  DWORD dwMoved;
   wchar_t * wpath;
 
   caml_unix_check_path(path, "open");
@@ -87,5 +88,15 @@ CAMLprim value caml_unix_open(value path, value flags, value perm)
     caml_win32_maperr(GetLastError());
     caml_uerror("open", path);
   }
+
+  if (fileaccess & FILE_APPEND_DATA) {
+    dwMoved = SetFilePointer(h, 0, NULL, FILE_END);
+    if (dwMoved == INVALID_SET_FILE_POINTER) {
+      caml_win32_maperr(GetLastError());
+      CloseHandle(h);
+      caml_uerror("open", path);
+    }
+  }
+
   return caml_win32_alloc_handle(h);
 }

diff --git a/otherlibs/unix/select_unix.c b/otherlibs/unix/select_unix.c
index afdb5593de10f5514d6ac00dd2ea081bfe44d367..ab02e54c174b369fbb3097638a0dfb6b1b67e927 100644 (file)
--- a/otherlibs/unix/select_unix.c
+++ b/otherlibs/unix/select_unix.c
@@ -33,9 +33,8 @@
 
 static int fdlist_to_fdset(value fdlist, fd_set *fdset, int *maxfd)
 {
-  value l;
   FD_ZERO(fdset);
-  for (l = fdlist; l != Val_emptylist; l = Field(l, 1)) {
+  for (value l = fdlist; l != Val_emptylist; l = Field(l, 1)) {
     long fd = Long_val(Field(l, 0));
     /* PR#5563: harden against bad fds */
     if (fd < 0 || fd >= FD_SETSIZE) return -1;

diff --git a/otherlibs/unix/select_win32.c b/otherlibs/unix/select_win32.c
index aba7b63c9b2c1876874adb39458fa3e8835d8c7c..5118ea7299db6d1a97a4b80cb3da70e24687fef1 100644 (file)
--- a/otherlibs/unix/select_win32.c
+++ b/otherlibs/unix/select_win32.c
@@ -13,6 +13,7 @@
 /*                                                                        */
 /**************************************************************************/
 
+#define CAML_INTERNALS
 #include <caml/mlvalues.h>
 #include <caml/alloc.h>
 #include <caml/memory.h>
@@ -46,14 +47,12 @@ typedef SELECTHANDLESET *LPSELECTHANDLESET;
 
 static void handle_set_init (LPSELECTHANDLESET hds, LPHANDLE lpHdl, DWORD max)
 {
-  DWORD i;
-
   hds->lpHdl = lpHdl;
   hds->nMax  = max;
   hds->nLast = 0;
 
   /* Set to invalid value every entry of the handle */
-  for (i = 0; i < hds->nMax; i++)
+  for (DWORD i = 0; i < hds->nMax; i++)
   {
     hds->lpHdl[i] = INVALID_HANDLE_VALUE;
   };
@@ -61,8 +60,6 @@ static void handle_set_init (LPSELECTHANDLESET hds, LPHANDLE lpHdl, DWORD max)
 
 static void handle_set_add (LPSELECTHANDLESET hds, HANDLE hdl)
 {
-  LPSELECTHANDLESET res;
-
   if (hds->nLast < hds->nMax)
   {
     hds->lpHdl[hds->nLast] = hdl;
@@ -75,10 +72,9 @@ static void handle_set_add (LPSELECTHANDLESET hds, HANDLE hdl)
 static BOOL handle_set_mem (LPSELECTHANDLESET hds, HANDLE hdl)
 {
   BOOL  res;
-  DWORD i;
 
   res = FALSE;
-  for (i = 0; !res && i < hds->nLast; i++)
+  for (DWORD i = 0; !res && i < hds->nLast; i++)
   {
     res = (hds->lpHdl[i] == hdl);
   }
@@ -88,9 +84,7 @@ static BOOL handle_set_mem (LPSELECTHANDLESET hds, HANDLE hdl)
 
 static void handle_set_reset (LPSELECTHANDLESET hds)
 {
-  DWORD i;
-
-  for (i = 0; i < hds->nMax; i++)
+  for (DWORD i = 0; i < hds->nMax; i++)
   {
     hds->lpHdl[i] = INVALID_HANDLE_VALUE;
   }
@@ -189,7 +183,6 @@ static LPSELECTDATA select_data_new (LPSELECTDATA lpSelectData,
 {
   /* Allocate the data structure */
   LPSELECTDATA res;
-  DWORD        i;
 
   res = (LPSELECTDATA)caml_stat_alloc(sizeof(SELECTDATA));
 
@@ -216,8 +209,6 @@ static LPSELECTDATA select_data_new (LPSELECTDATA lpSelectData,
 /* Free select data */
 static void select_data_free (LPSELECTDATA lpSelectData)
 {
-  DWORD i;
-
   DEBUG_PRINT("Freeing data of %x", lpSelectData);
 
   /* Free APC related data, if they exists */
@@ -330,7 +321,6 @@ static void read_console_poll(HANDLE hStop, void *_data)
 
   DEBUG_PRINT("Waiting for data on console");
 
-  record;
   waitRes = 0;
   n = 0;
   lpSelectData = (LPSELECTDATA)_data;
@@ -404,7 +394,6 @@ static void read_pipe_poll (HANDLE hStop, void *_data)
   DWORD         n;
   LPSELECTQUERY iterQuery;
   LPSELECTDATA  lpSelectData;
-  DWORD         i;
   DWORD         wait;
 
   /* Poll pipe */
@@ -416,7 +405,7 @@ static void read_pipe_poll (HANDLE hStop, void *_data)
   DEBUG_PRINT("Checking data pipe");
   while (lpSelectData->EState == SELECT_STATE_NONE)
   {
-    for (i = 0; i < lpSelectData->nQueriesCount; i++)
+    for (DWORD i = 0; i < lpSelectData->nQueriesCount; i++)
     {
       iterQuery = &(lpSelectData->aQueries[i]);
       res = PeekNamedPipe(
@@ -504,7 +493,6 @@ static void socket_poll (HANDLE hStop, void *_data)
   HANDLE           aEvents[MAXIMUM_SELECT_OBJECTS];
   DWORD            nEvents;
   long             maskEvents;
-  DWORD            i;
   u_long           iMode;
   SELECTMODE       mode;
   WSANETWORKEVENTS events;
@@ -557,7 +545,7 @@ static void socket_poll (HANDLE hStop, void *_data)
 
   if (lpSelectData->nError == 0)
   {
-    for (i = 0; i < lpSelectData->nQueriesCount; i++)
+    for (DWORD i = 0; i < lpSelectData->nQueriesCount; i++)
     {
       iterQuery = &(lpSelectData->aQueries[i]);
       if (WaitForSingleObject(aEvents[i], 0) == WAIT_OBJECT_0)
@@ -903,7 +891,6 @@ static value find_handle(LPSELECTRESULT iterResult, value readfds,
 {
   CAMLparam3(readfds, writefds, exceptfds);
   CAMLlocal2(result, list);
-  int i;
 
   switch( iterResult->EMode )
   {
@@ -917,10 +904,10 @@ static value find_handle(LPSELECTRESULT iterResult, value readfds,
       list = exceptfds;
       break;
     case SELECT_MODE_NONE:
-      CAMLassert(0);
+      CAMLunreachable();
   };
 
-  for(i=0; list != Val_unit && i < iterResult->lpOrigIdx; ++i )
+  for(int i=0; list != Val_unit && i < iterResult->lpOrigIdx; ++i )
   {
     list = Field(list, 1);
   }
@@ -941,10 +928,10 @@ static value find_handle(LPSELECTRESULT iterResult, value readfds,
  */
 static int fdlist_to_fdset(value fdlist, fd_set *fdset)
 {
-  value l, c;
+  value c;
   int n = 0;
   FD_ZERO(fdset);
-  for (l = fdlist; l != Val_emptylist; l = Field(l, 1)) {
+  for (value l = fdlist; l != Val_emptylist; l = Field(l, 1)) {
     if (++n > FD_SETSIZE) {
       DEBUG_PRINT("More than FD_SETSIZE sockets");
       return 0;
@@ -1004,9 +991,6 @@ CAMLprim value caml_unix_select(value readfds, value writefds, value exceptfds,
   /* Is there static select data */
   BOOL  hasStaticData = FALSE;
 
-  /* Wait return */
-  DWORD waitRet;
-
   /* Set of handle */
   SELECTHANDLESET hds;
   DWORD           hdsMax;
@@ -1074,7 +1058,6 @@ CAMLprim value caml_unix_select(value readfds, value writefds, value exceptfds,
       iterSelectData = NULL;
       iterResult     = NULL;
       hasStaticData  = 0;
-      waitRet        = 0;
       readfds_len    = caml_list_length(readfds);
       writefds_len   = caml_list_length(writefds);
       exceptfds_len  = caml_list_length(exceptfds);
@@ -1084,7 +1067,7 @@ CAMLprim value caml_unix_select(value readfds, value writefds, value exceptfds,
 
       if (tm >= 0.0)
         {
-          milliseconds = 1000 * tm;
+          milliseconds = (DWORD)(1000 * tm);
           DEBUG_PRINT("Will wait %d ms", milliseconds);
         }
       else
@@ -1282,7 +1265,7 @@ CAMLprim value caml_unix_select(value readfds, value writefds, value exceptfds,
                       except_list = l;
                       break;
                     case SELECT_MODE_NONE:
-                      CAMLassert(0);
+                      CAMLunreachable();
                     }
                 }
               /* We try to only process the first error, bypass other errors */

diff --git a/otherlibs/unix/setgroups.c b/otherlibs/unix/setgroups.c
index 8a445b604364820ced9b5f295c607deb61ff90c2..433660e8bc7c61df69dba53c29f56ab8ab0ebf68 100644 (file)
--- a/otherlibs/unix/setgroups.c
+++ b/otherlibs/unix/setgroups.c
@@ -31,12 +31,12 @@
 CAMLprim value caml_unix_setgroups(value groups)
 {
   gid_t * gidset;
-  mlsize_t size, i;
+  mlsize_t size;
   int n;
 
   size = Wosize_val(groups);
   gidset = (gid_t *) caml_stat_alloc(size * sizeof(gid_t));
-  for (i = 0; i < size; i++) gidset[i] = Int_val(Field(groups, i));
+  for (mlsize_t i = 0; i < size; i++) gidset[i] = Int_val(Field(groups, i));
 
   n = setgroups(size, gidset);
 

diff --git a/otherlibs/unix/signals.c b/otherlibs/unix/signals.c
index 5739d6be42904515ca4a60e0ef32bec106d5eb50..5d728aad854dd9e16473eff34bfdc3060eff61f1 100644 (file)
--- a/otherlibs/unix/signals.c
+++ b/otherlibs/unix/signals.c
@@ -40,9 +40,7 @@ static value encode_sigset(sigset_t * set)
 {
   CAMLparam0();
   CAMLlocal1(res);
-  int i;
-
-  for (i = 1; i < NSIG; i++)
+  for (int i = 1; i < NSIG; i++)
     if (sigismember(set, i) > 0) {
       value newcons = caml_alloc_2(Tag_cons,
         Val_int(caml_rev_convert_signal_number(i)),
@@ -74,13 +72,12 @@ CAMLprim value caml_unix_sigprocmask(value vaction, value vset)
 CAMLprim value caml_unix_sigpending(value unit)
 {
   sigset_t pending;
-  int i, j;
   uintnat curr;
   if (sigpending(&pending) == -1) caml_uerror("sigpending", Nothing);
-  for (i = 0; i < NSIG_WORDS; i++) {
+  for (int i = 0; i < NSIG_WORDS; i++) {
     curr = atomic_load(&caml_pending_signals[i]);
     if (curr == 0) continue;
-    for (j = 0; j < BITS_PER_WORD; j++) {
+    for (int j = 0; j < BITS_PER_WORD; j++) {
       if (curr & ((uintnat)1 << j))
       sigaddset(&pending, i * BITS_PER_WORD + j + 1);
     }

diff --git a/otherlibs/unix/sleep_win32.c b/otherlibs/unix/sleep_win32.c
index 9c62e11618159ed46294ec29336152ce560c86de..de22d7b736d71002be186bbbfb1937af55224874 100644 (file)
--- a/otherlibs/unix/sleep_win32.c
+++ b/otherlibs/unix/sleep_win32.c
@@ -19,9 +19,9 @@
 
 CAMLprim value caml_unix_sleep(value t)
 {
-  double d = Double_val(t);
+  DWORD ms = (DWORD)(Double_val(t) * 1e3);
   caml_enter_blocking_section();
-  Sleep(d * 1e3);
+  Sleep(ms);
   caml_leave_blocking_section();
   return Val_unit;
 }

diff --git a/otherlibs/unix/socket_unix.c b/otherlibs/unix/socket_unix.c
index 237adf15b94ba177a564bca37c32c001d7db6819..452546281345ba9df37e4b3176ba23c15f52cd7f 100644 (file)
--- a/otherlibs/unix/socket_unix.c
+++ b/otherlibs/unix/socket_unix.c
@@ -23,7 +23,7 @@
 #include <sys/types.h>
 #include <sys/socket.h>
 
-int caml_unix_socket_domain_table[] = {
+const int caml_unix_socket_domain_table[] = {
   PF_UNIX, PF_INET,
 #if defined(HAS_IPV6)
   PF_INET6
@@ -34,7 +34,7 @@ int caml_unix_socket_domain_table[] = {
 #endif
 };
 
-int caml_unix_socket_type_table[] = {
+const int caml_unix_socket_type_table[] = {
   SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET
 };
 

diff --git a/otherlibs/unix/socket_win32.c b/otherlibs/unix/socket_win32.c
index af9990a15a90304072b67ab0e4dd75a22f740111..8f5d33a76002ef198b0bfcb6d8963822eed7a37e 100644 (file)
--- a/otherlibs/unix/socket_win32.c
+++ b/otherlibs/unix/socket_win32.c
@@ -17,11 +17,11 @@
 #include <caml/memory.h>
 #include "caml/unixsupport.h"
 
-int caml_unix_socket_domain_table[] = {
+const int caml_unix_socket_domain_table[] = {
   PF_UNIX, PF_INET, PF_INET6
 };
 
-int caml_unix_socket_type_table[] = {
+const int caml_unix_socket_type_table[] = {
   SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET
 };
 

diff --git a/otherlibs/unix/socketaddr.c b/otherlibs/unix/socketaddr.c
index a33aef91ed36ba5f05fadc23f01b2c88838e42c9..b340eeba1392d4d4e29cd9aad6d561549b5a97d5 100644 (file)
--- a/otherlibs/unix/socketaddr.c
+++ b/otherlibs/unix/socketaddr.c
@@ -27,6 +27,7 @@
 #ifdef _WIN32
 #undef EAFNOSUPPORT
 #define EAFNOSUPPORT WSAEAFNOSUPPORT
+#include <io.h>
 #endif
 
 CAMLexport value caml_unix_alloc_inet_addr(struct in_addr * a)

diff --git a/otherlibs/unix/socketpair_unix.c b/otherlibs/unix/socketpair_unix.c
index d9dcab697a6f2da9341d6b4bfdff08e78f88e3ce..a93c95502a671afb256ca369ff656b0b599ca4d8 100644 (file)
--- a/otherlibs/unix/socketpair_unix.c
+++ b/otherlibs/unix/socketpair_unix.c
@@ -22,7 +22,7 @@
 
 #include <sys/socket.h>
 
-extern int caml_unix_socket_domain_table[], caml_unix_socket_type_table[];
+extern const int caml_unix_socket_domain_table[], caml_unix_socket_type_table[];
 
 CAMLprim value caml_unix_socketpair(value cloexec, value domain,
                                value type, value proto)

diff --git a/otherlibs/unix/socketpair_win32.c b/otherlibs/unix/socketpair_win32.c
index a6595b4887ff9b970e55dc06da80597b1e27195c..effeeb7cfb26fc930f0ae142815f53ce966e64ba 100644 (file)
--- a/otherlibs/unix/socketpair_win32.c
+++ b/otherlibs/unix/socketpair_win32.c
@@ -25,8 +25,8 @@
 #include "caml/socketaddr.h"
 #include <ws2tcpip.h>
 
-extern int caml_unix_socket_domain_table[]; /* from socket.c */
-extern int caml_unix_socket_type_table[]; /* from socket.c */
+extern const int caml_unix_socket_domain_table[]; /* from socket.c */
+extern const int caml_unix_socket_type_table[]; /* from socket.c */
 
 #ifdef HAS_SOCKETPAIR
 

diff --git a/otherlibs/unix/sockopt_unix.c b/otherlibs/unix/sockopt_unix.c
index 05c339b9588c695df3cc87ff1d9eb62ee340c239..a826de86ba058c9a29862c07a19496091f921dcd 100644 (file)
--- a/otherlibs/unix/sockopt_unix.c
+++ b/otherlibs/unix/sockopt_unix.c
@@ -108,7 +108,7 @@ struct socket_option {
 
 /* Table of options, indexed by type */
 
-static struct socket_option sockopt_bool[] = {
+static const struct socket_option sockopt_bool[] = {
   { SOL_SOCKET, SO_DEBUG },
   { SOL_SOCKET, SO_BROADCAST },
   { SOL_SOCKET, SO_REUSEADDR },
@@ -121,7 +121,7 @@ static struct socket_option sockopt_bool[] = {
   { SOL_SOCKET, SO_REUSEPORT }
 };
 
-static struct socket_option sockopt_int[] = {
+static const struct socket_option sockopt_int[] = {
   { SOL_SOCKET, SO_SNDBUF },
   { SOL_SOCKET, SO_RCVBUF },
   { SOL_SOCKET, SO_ERROR },
@@ -129,20 +129,20 @@ static struct socket_option sockopt_int[] = {
   { SOL_SOCKET, SO_RCVLOWAT },
   { SOL_SOCKET, SO_SNDLOWAT } };
 
-static struct socket_option sockopt_linger[] = {
+static const struct socket_option sockopt_linger[] = {
   { SOL_SOCKET, SO_LINGER }
 };
 
-static struct socket_option sockopt_timeval[] = {
+static const struct socket_option sockopt_timeval[] = {
   { SOL_SOCKET, SO_RCVTIMEO },
   { SOL_SOCKET, SO_SNDTIMEO }
 };
 
-static struct socket_option sockopt_unix_error[] = {
+static const struct socket_option sockopt_unix_error[] = {
   { SOL_SOCKET, SO_ERROR }
 };
 
-static struct socket_option * sockopt_table[] = {
+static const struct socket_option * sockopt_table[] = {
   sockopt_bool,
   sockopt_int,
   sockopt_linger,
@@ -150,7 +150,7 @@ static struct socket_option * sockopt_table[] = {
   sockopt_unix_error
 };
 
-static char * getsockopt_fun_name[] = {
+static const char * getsockopt_fun_name[] = {
   "getsockopt",
   "getsockopt_int",
   "getsockopt_optint",
@@ -158,7 +158,7 @@ static char * getsockopt_fun_name[] = {
   "getsockopt_error"
 };
 
-static char * setsockopt_fun_name[] = {
+static const char * setsockopt_fun_name[] = {
   "setsockopt",
   "setsockopt_int",
   "setsockopt_optint",
@@ -172,7 +172,7 @@ union option_value {
   struct timeval tv;
 };
 
-CAMLexport value caml_unix_getsockopt_aux(char * name,
+CAMLexport value caml_unix_getsockopt_aux(const char * name,
                                      enum option_type ty, int level, int option,
                                      value socket)
 {
@@ -230,7 +230,7 @@ CAMLexport value caml_unix_getsockopt_aux(char * name,
   CAMLreturn(res);
 }
 
-CAMLexport value caml_unix_setsockopt_aux(char * name,
+CAMLexport value caml_unix_setsockopt_aux(const char * name,
                                      enum option_type ty, int level, int option,
                                      value socket, value val)
 {
@@ -271,7 +271,7 @@ CAMLexport value caml_unix_setsockopt_aux(char * name,
 CAMLprim value caml_unix_getsockopt(value vty, value vsocket, value voption)
 {
   enum option_type ty = Int_val(vty);
-  struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
+  const struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
   return caml_unix_getsockopt_aux(getsockopt_fun_name[ty],
                              ty,
                              opt->level,
@@ -283,7 +283,7 @@ CAMLprim value caml_unix_setsockopt(value vty, value vsocket, value voption,
                                value val)
 {
   enum option_type ty = Int_val(vty);
-  struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
+  const struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
   return caml_unix_setsockopt_aux(setsockopt_fun_name[ty],
                              ty,
                              opt->level,

diff --git a/otherlibs/unix/sockopt_win32.c b/otherlibs/unix/sockopt_win32.c
index e72ab9168d77a5a34d7efc36fa749f629766550e..64d17b08f37021f47a757f3033374d28715feed9 100644 (file)
--- a/otherlibs/unix/sockopt_win32.c
+++ b/otherlibs/unix/sockopt_win32.c
@@ -46,7 +46,7 @@ struct socket_option {
 
 /* Table of options, indexed by type */
 
-static struct socket_option sockopt_bool[] = {
+static const struct socket_option sockopt_bool[] = {
   { SOL_SOCKET, SO_DEBUG },
   { SOL_SOCKET, SO_BROADCAST },
   { SOL_SOCKET, SO_REUSEADDR },
@@ -59,7 +59,7 @@ static struct socket_option sockopt_bool[] = {
   { SOL_SOCKET, SO_REUSEPORT }
 };
 
-static struct socket_option sockopt_int[] = {
+static const struct socket_option sockopt_int[] = {
   { SOL_SOCKET, SO_SNDBUF },
   { SOL_SOCKET, SO_RCVBUF },
   { SOL_SOCKET, SO_ERROR },
@@ -67,20 +67,20 @@ static struct socket_option sockopt_int[] = {
   { SOL_SOCKET, SO_RCVLOWAT },
   { SOL_SOCKET, SO_SNDLOWAT } };
 
-static struct socket_option sockopt_linger[] = {
+static const struct socket_option sockopt_linger[] = {
   { SOL_SOCKET, SO_LINGER }
 };
 
-static struct socket_option sockopt_timeval[] = {
+static const struct socket_option sockopt_timeval[] = {
   { SOL_SOCKET, SO_RCVTIMEO },
   { SOL_SOCKET, SO_SNDTIMEO }
 };
 
-static struct socket_option sockopt_unix_error[] = {
+static const struct socket_option sockopt_unix_error[] = {
   { SOL_SOCKET, SO_ERROR }
 };
 
-static struct socket_option * sockopt_table[] = {
+static const struct socket_option * sockopt_table[] = {
   sockopt_bool,
   sockopt_int,
   sockopt_linger,
@@ -88,7 +88,7 @@ static struct socket_option * sockopt_table[] = {
   sockopt_unix_error
 };
 
-static char * getsockopt_fun_name[] = {
+static const char * getsockopt_fun_name[] = {
   "getsockopt",
   "getsockopt_int",
   "getsockopt_optint",
@@ -96,7 +96,7 @@ static char * getsockopt_fun_name[] = {
   "getsockopt_error"
 };
 
-static char * setsockopt_fun_name[] = {
+static const char * setsockopt_fun_name[] = {
   "setsockopt",
   "setsockopt_int",
   "setsockopt_optint",
@@ -110,7 +110,7 @@ union option_value {
   struct timeval tv;
 };
 
-CAMLexport value caml_unix_getsockopt_aux(char * name,
+CAMLexport value caml_unix_getsockopt_aux(const char * name,
                                      enum option_type ty, int level, int option,
                                      value socket)
 {
@@ -168,7 +168,7 @@ CAMLexport value caml_unix_getsockopt_aux(char * name,
   CAMLreturn(res);
 }
 
-CAMLexport value caml_unix_setsockopt_aux(char * name,
+CAMLexport value caml_unix_setsockopt_aux(const char * name,
                                      enum option_type ty, int level, int option,
                                      value socket, value val)
 {
@@ -211,7 +211,7 @@ CAMLexport value caml_unix_setsockopt_aux(char * name,
 CAMLprim value caml_unix_getsockopt(value vty, value vsocket, value voption)
 {
   enum option_type ty = Int_val(vty);
-  struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
+  const struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
   return caml_unix_getsockopt_aux(getsockopt_fun_name[ty],
                              ty,
                              opt->level,
@@ -223,7 +223,7 @@ CAMLprim value caml_unix_setsockopt(value vty, value vsocket, value voption,
                                value val)
 {
   enum option_type ty = Int_val(vty);
-  struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
+  const struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]);
   return caml_unix_setsockopt_aux(setsockopt_fun_name[ty],
                              ty,
                              opt->level,

diff --git a/otherlibs/unix/spawn.c b/otherlibs/unix/spawn.c
index 02ea55d289c5bb3e9a84515ae7e4a6a6538a11f0..74e573953851dd63d4c8544d699f9320b80c2eca 100644 (file)
--- a/otherlibs/unix/spawn.c
+++ b/otherlibs/unix/spawn.c
@@ -38,7 +38,7 @@ CAMLprim value caml_unix_spawn(value executable, /* string */
   char ** envp;
   const char * path;
   pid_t pid;
-  int src, dst, r, i;
+  int src, r;
   posix_spawn_file_actions_t act;
 
   caml_unix_check_path(executable, "create_process");
@@ -51,14 +51,14 @@ CAMLprim value caml_unix_spawn(value executable, /* string */
   }
   /* Prepare the redirections for stdin, stdout, stderr */
   posix_spawn_file_actions_init(&act);
-  for (dst = 0; dst <= 2; dst++) {
+  for (int dst = 0; dst <= 2; dst++) {
     /* File descriptor [redirect.(dst)] becomes file descriptor [dst] */
     src = Int_val(Field(redirect, dst));
     if (src != dst) {
       r = posix_spawn_file_actions_adddup2(&act, src, dst);
       if (r != 0) goto error;
       /* Close [src] if this is its last use */
-      for (i = dst + 1; i <= 2; i++) {
+      for (int i = dst + 1; i <= 2; i++) {
         if (src == Int_val(Field(redirect, i))) goto dontclose;
       }
       r = posix_spawn_file_actions_addclose(&act, src);
@@ -100,7 +100,7 @@ CAMLprim value caml_unix_spawn(value executable, /* string */
   char ** envp;
   const char * path;
   pid_t pid;
-  int src, dst, i;
+  int src;
 
   caml_unix_check_path(executable, "create_process");
   path = String_val(executable);
@@ -120,13 +120,13 @@ CAMLprim value caml_unix_spawn(value executable, /* string */
   }
   /* This is the child process */
   /* Perform the redirections for stdin, stdout, stderr */
-  for (dst = 0; dst <= 2; dst++) {
+  for (int dst = 0; dst <= 2; dst++) {
     /* File descriptor [redirect.(dst)] becomes file descriptor [dst] */
     src = Int_val(Field(redirect, dst));
     if (src != dst) {
       if (dup2(src, dst) == -1) _exit(ERROR_EXIT_STATUS);
       /* Close [src] if this is its last use */
-      for (i = dst + 1; i <= 2; i++) {
+      for (int i = dst + 1; i <= 2; i++) {
         if (src == Int_val(Field(redirect, i))) goto dontclose;
       }
       if (close(src) == -1) _exit(ERROR_EXIT_STATUS);

diff --git a/otherlibs/unix/startup.c b/otherlibs/unix/startup.c
index 62bb5cccfc2b95eabd44e0f8051c8d3ca5f12ba5..08ad22dedb65109558fa5aafa4182f0541a8d1a0 100644 (file)
--- a/otherlibs/unix/startup.c
+++ b/otherlibs/unix/startup.c
@@ -25,7 +25,6 @@ value caml_win32_process_id;
 CAMLprim value caml_unix_startup(value unit)
 {
   WSADATA wsaData;
-  int i;
   HANDLE h;
 
   (void) WSAStartup(MAKEWORD(2, 0), &wsaData);

diff --git a/otherlibs/unix/stat_unix.c b/otherlibs/unix/stat_unix.c
index e54ccfe36d3613e97fa3d37cd8a44502421f31af..c51c1013d03b43bbac0ce9947b77a0cbc373fce0 100644 (file)
--- a/otherlibs/unix/stat_unix.c
+++ b/otherlibs/unix/stat_unix.c
@@ -74,11 +74,22 @@ static value stat_aux(int use_64, struct stat *buf)
   CAMLparam0();
   CAMLlocal5(atime, mtime, ctime, offset, v);
 
-  #include "nanosecond_stat.h"
+#if defined(HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC)
+#  define NSEC(buf, field) buf->st_##field##tim.tv_nsec
+#elif defined(HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC)
+#  define NSEC(buf, field) buf->st_##field##timespec.tv_nsec
+#elif defined(HAVE_STRUCT_STAT_ST_ATIMENSEC)
+#  define NSEC(buf, field) buf->st_##field##timensec
+#else
+#  define NSEC(buf, field) 0
+#endif
+
   atime = caml_copy_double(stat_timestamp(buf->st_atime, NSEC(buf, a)));
   mtime = caml_copy_double(stat_timestamp(buf->st_mtime, NSEC(buf, m)));
   ctime = caml_copy_double(stat_timestamp(buf->st_ctime, NSEC(buf, c)));
-  #undef NSEC
+
+#undef NSEC
+
   offset = use_64 ? Val_file_offset(buf->st_size) : Val_int (buf->st_size);
   v = caml_alloc_small(12, 0);
   Field (v, 0) = Val_int (buf->st_dev);

diff --git a/otherlibs/unix/stat_win32.c b/otherlibs/unix/stat_win32.c
index b600d2102207c2907c72e6159ea5a23b74afd568..f66f5fbc89f3b0c5d2543f06b1a75ee578b3166e 100644 (file)
--- a/otherlibs/unix/stat_win32.c
+++ b/otherlibs/unix/stat_win32.c
@@ -166,7 +166,6 @@ static int safe_do_stat(int do_lstat, int use_64, wchar_t* path, HANDLE fstat, _
 {
   BY_HANDLE_FILE_INFORMATION info;
   wchar_t* ptr;
-  char c;
   HANDLE h;
   unsigned short mode;
   int is_symlink = 0;
@@ -391,7 +390,6 @@ CAMLprim value caml_unix_lstat_64(value path)
 
 static value do_fstat(value handle, int use_64)
 {
-  int ret;
   struct _stat64 buf;
   __int64 st_ino;
   HANDLE h;

diff --git a/otherlibs/unix/termios.c b/otherlibs/unix/termios.c
index 40ad32ccaaefea849e6b01e86e2fd2747ce9c714..b65180493344d559afa7174a09b9cf9bece4733d 100644 (file)
--- a/otherlibs/unix/termios.c
+++ b/otherlibs/unix/termios.c
@@ -38,7 +38,7 @@ enum { Input, Output };
 
 /* Structure of the terminal_io record. Cf. unix.mli */
 
-static long terminal_io_descr[] = {
+static const long terminal_io_descr[] = {
   /* Input modes */
   Bool, iflags, IGNBRK,
   Bool, iflags, BRKINT,
@@ -90,7 +90,7 @@ static long terminal_io_descr[] = {
 #undef cflags
 #undef lflags
 
-static struct {
+static const struct {
   speed_t speed;
   int baud;
 } speedtable[] = {
@@ -192,10 +192,7 @@ static struct {
 
 static void encode_terminal_status(volatile value *dst, struct termios *src)
 {
-  long * pc;
-  int i;
-
-  for(pc = terminal_io_descr; *pc != End; dst++) {
+  for(const long * pc = terminal_io_descr; *pc != End; dst++) {
     switch(*pc++) {
     case Bool:
       { tcflag_t * src_p = (tcflag_t *) ((char *)src + *pc++);
@@ -207,7 +204,7 @@ static void encode_terminal_status(volatile value *dst, struct termios *src)
         int ofs = *pc++;
         int num = *pc++;
         tcflag_t msk = *pc++;
-        for (i = 0; i < num; i++) {
+        for (int i = 0; i < num; i++) {
           if ((*src_p & msk) == pc[i]) {
             *dst = Val_int(i + ofs);
             break;
@@ -225,7 +222,7 @@ static void encode_terminal_status(volatile value *dst, struct termios *src)
         case Input:
           speed = cfgetispeed(src); break;
         }
-        for (i = 0; i < NSPEEDS; i++) {
+        for (int i = 0; i < NSPEEDS; i++) {
           if (speed == speedtable[i].speed) {
             *dst = Val_int(speedtable[i].baud);
             break;
@@ -242,10 +239,7 @@ static void encode_terminal_status(volatile value *dst, struct termios *src)
 
 static void decode_terminal_status(struct termios *dst, volatile value *src)
 {
-  long * pc;
-  int i;
-
-  for (pc = terminal_io_descr; *pc != End; src++) {
+  for (const long *pc = terminal_io_descr; *pc != End; src++) {
     switch(*pc++) {
     case Bool:
       { tcflag_t * dst_p = (tcflag_t *) ((char *)dst + *pc++);
@@ -260,7 +254,7 @@ static void decode_terminal_status(struct termios *dst, volatile value *src)
         int ofs = *pc++;
         int num = *pc++;
         tcflag_t msk = *pc++;
-        i = Int_val(*src) - ofs;
+        int i = Int_val(*src) - ofs;
         if (i >= 0 && i < num) {
           *dst_p = (*dst_p & ~msk) | pc[i];
         } else {
@@ -272,7 +266,7 @@ static void decode_terminal_status(struct termios *dst, volatile value *src)
       { int which = *pc++;
         int baud = Int_val(*src);
         int res = 0;
-        for (i = 0; i < NSPEEDS; i++) {
+        for (int i = 0; i < NSPEEDS; i++) {
           if (baud == speedtable[i].baud) {
             switch (which) {
             case Output:

diff --git a/otherlibs/unix/unixsupport_win32.c b/otherlibs/unix/unixsupport_win32.c
index 05c91eafcdb5c63e40b8b5c761ddf736bea6934f..b5840a451b9d36eeea5354eb4913f47695e3e77c 100644 (file)
--- a/otherlibs/unix/unixsupport_win32.c
+++ b/otherlibs/unix/unixsupport_win32.c
@@ -98,7 +98,7 @@ void caml_win32_maperr(DWORD win32err)
   } else {
     /* Not found: save original error code, negated so that we can
        recognize it in caml_unix_error_message */
-    errno = -win32err;
+    errno = -(int)win32err;
   }
 }
 

diff --git a/otherlibs/unix/windbug.c b/otherlibs/unix/windbug.c
index 393d77ff109cf43b540f4cc9cb4e6b43351bf007..f1cb0e33c6f25bea04e0ebac91cf42e47df7f81a 100644 (file)
--- a/otherlibs/unix/windbug.c
+++ b/otherlibs/unix/windbug.c
@@ -17,10 +17,10 @@
 
 int caml_win32_debug_test (void)
 {
-  static int debug_init = 0;
   static int debug = 0;
 
 #ifdef DEBUG
+  static int debug_init = 0;
   if (!debug_init)
   {
     debug = (getenv("OCAMLDEBUG") != NULL);

diff --git a/otherlibs/unix/winworker.c b/otherlibs/unix/winworker.c
index b040d41ab4c76d2b03bc96f51da941c40b17131d..383a7bdf8bfdfe1497c54f5fbbc8ce400fe674ea 100644 (file)
--- a/otherlibs/unix/winworker.c
+++ b/otherlibs/unix/winworker.c
@@ -238,8 +238,6 @@ void caml_win32_worker_push(LPWORKER lpWorker)
 
 void caml_win32_worker_init (void)
 {
-  int i = 0;
-
   /* Init a shared variable. The only way to ensure that no other
      worker will be at the same point is to use a critical section.
      */

diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml
index bc18f41be4c890501ce11b82032f8b9e3dd99431..daa73c4205debce29aecedf76fd65d0f0e0697b1 100644 (file)
--- a/parsing/ast_helper.ml
+++ b/parsing/ast_helper.ml
@@ -33,15 +33,20 @@ let with_default_loc l f =
   Misc.protect_refs [Misc.R (default_loc, l)] f
 
 module Const = struct
-  let integer ?suffix i = Pconst_integer (i, suffix)
-  let int ?suffix i = integer ?suffix (Int.to_string i)
-  let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i)
-  let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i)
-  let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i)
-  let float ?suffix f = Pconst_float (f, suffix)
-  let char c = Pconst_char c
+  let mk ?(loc = !default_loc) d =
+    {pconst_desc = d;
+     pconst_loc = loc}
+
+  let integer ?loc ?suffix i = mk ?loc (Pconst_integer (i, suffix))
+  let int ?loc ?suffix i = integer ?loc ?suffix (Int.to_string i)
+  let int32 ?loc ?(suffix='l') i = integer ?loc ~suffix (Int32.to_string i)
+  let int64 ?loc ?(suffix='L') i = integer ?loc ~suffix (Int64.to_string i)
+  let nativeint ?loc ?(suffix='n') i =
+    integer ?loc ~suffix (Nativeint.to_string i)
+  let float ?loc ?suffix f = mk ?loc (Pconst_float (f, suffix))
+  let char ?loc c = mk ?loc (Pconst_char c)
   let string ?quotation_delimiter ?(loc= !default_loc) s =
-    Pconst_string (s, loc, quotation_delimiter)
+    mk ~loc (Pconst_string (s, loc, quotation_delimiter))
 end
 
 module Attr = struct
@@ -167,6 +172,7 @@ module Pat = struct
   let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a)
   let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b))
   let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a)
+  let effect_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_effect(a, b))
   let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a)
 end
 
@@ -602,7 +608,6 @@ module Te = struct
      pext_loc = loc;
      pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
     }
-
 end
 
 module Csig = struct

diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index 7004144cbcdbda61f7fd81203eb1662103594aa6..6a8a0fa3687095dc8bcaf1217fd25dc643e306c4 100644 (file)
--- a/parsing/ast_helper.mli
+++ b/parsing/ast_helper.mli
@@ -44,15 +44,16 @@ val with_default_loc: loc -> (unit -> 'a) -> 'a
 (** {1 Constants} *)
 
 module Const : sig
-  val char : char -> constant
+  val mk : ?loc:loc -> constant_desc -> constant
+  val char : ?loc:loc -> char -> constant
   val string :
     ?quotation_delimiter:string -> ?loc:Location.t -> string -> constant
-  val integer : ?suffix:char -> string -> constant
-  val int : ?suffix:char -> int -> constant
-  val int32 : ?suffix:char -> int32 -> constant
-  val int64 : ?suffix:char -> int64 -> constant
-  val nativeint : ?suffix:char -> nativeint -> constant
-  val float : ?suffix:char -> string -> constant
+  val integer : ?loc:loc -> ?suffix:char -> string -> constant
+  val int : ?loc:loc -> ?suffix:char -> int -> constant
+  val int32 : ?loc:loc -> ?suffix:char -> int32 -> constant
+  val int64 : ?loc:loc -> ?suffix:char -> int64 -> constant
+  val nativeint : ?loc:loc -> ?suffix:char -> nativeint -> constant
+  val float : ?loc:loc -> ?suffix:char -> string -> constant
 end
 
 (** {1 Attributes} *)
@@ -124,6 +125,7 @@ module Pat:
     val unpack: ?loc:loc -> ?attrs:attrs -> str_opt -> pattern
     val open_: ?loc:loc -> ?attrs:attrs  -> lid -> pattern -> pattern
     val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
+    val effect_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern
   end
 

diff --git a/parsing/ast_invariants.ml b/parsing/ast_invariants.ml
index f69b6a45bb81898e9fca4eedf1d948784fd9d9e8..53e8a1629c985a19dcc36ee90da6c907ba76f0fd 100644 (file)
--- a/parsing/ast_invariants.ml
+++ b/parsing/ast_invariants.ml
@@ -23,6 +23,8 @@ let invalid_tuple loc = err loc "Tuples must have at least 2 components."
 let no_args loc = err loc "Function application with no argument."
 let empty_let loc = err loc "Let with no bindings."
 let empty_type loc = err loc "Type declarations cannot be empty."
+let empty_poly_binder loc =
+  err loc "Explicit universal type quantification cannot be empty."
 let complex_id loc = err loc "Functor application not allowed here."
 let module_type_substitution_missing_rhs loc =
   err loc "Module type substitution with no right hand side"
@@ -53,6 +55,7 @@ let iterator =
     | Ptyp_tuple ([] | [_]) -> invalid_tuple loc
     | Ptyp_package (_, cstrs) ->
       List.iter (fun (id, _) -> simple_longident id) cstrs
+    | Ptyp_poly([],_) -> empty_poly_binder loc
     | _ -> ()
   in
   let pat self pat =

diff --git a/parsing/ast_iterator.ml b/parsing/ast_iterator.ml
index 94d5806fb3d07c670ff7075fcf956e2b44225a47..389a9a40425c233d0ac91dd7035a98ed00a8d917 100644 (file)
--- a/parsing/ast_iterator.ml
+++ b/parsing/ast_iterator.ml
@@ -493,6 +493,7 @@ module P = struct
     | Ppat_type s -> iter_loc sub s
     | Ppat_lazy p -> sub.pat sub p
     | Ppat_unpack s -> iter_loc sub s
+    | Ppat_effect (p1,p2) -> sub.pat sub p1; sub.pat sub p2
     | Ppat_exception p -> sub.pat sub p
     | Ppat_extension x -> sub.extension sub x
     | Ppat_open (lid, p) ->

diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index 204fec464128fff0c95a342953f72640b0a9c81c..25512e59c68059638b641323f2258274b0225f5a 100644 (file)
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -95,14 +95,18 @@ let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt}
 module C = struct
   (* Constants *)
 
-  let map sub c = match c with
-    | Pconst_integer _
-    | Pconst_char _
-    | Pconst_float _
-      -> c
-    | Pconst_string (s, loc, quotation_delimiter) ->
-        let loc = sub.location sub loc in
-        Const.string ~loc ?quotation_delimiter s
+  let map sub { pconst_desc; pconst_loc } =
+    let loc = sub.location sub pconst_loc in
+    let desc =
+      match pconst_desc with
+      | Pconst_integer _
+      | Pconst_char _
+      | Pconst_float _ ->
+          pconst_desc
+      | Pconst_string (s, loc, quotation_delimiter) ->
+          Pconst_string (s, sub.location sub loc, quotation_delimiter)
+    in
+    Const.mk ~loc desc
 end
 
 module T = struct
@@ -549,6 +553,8 @@ module P = struct
     | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s)
     | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p)
     | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p)
+    | Ppat_effect(p1, p2) ->
+        effect_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)
     | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x)
 end
 
@@ -828,21 +834,21 @@ let default_mapper =
 let extension_of_error {kind; main; sub} =
   if kind <> Location.Report_error then
     raise (Invalid_argument "extension_of_error: expected kind Report_error");
-  let str_of_pp pp_msg = Format.asprintf "%t" pp_msg in
+  let str_of_msg msg = Format.asprintf "%a" Format_doc.Doc.format msg in
   let extension_of_sub sub =
     { loc = sub.loc; txt = "ocaml.error" },
     PStr ([Str.eval (Exp.constant
-                       (Pconst_string (str_of_pp sub.txt, sub.loc, None)))])
+                       (Const.string ~loc:sub.loc (str_of_msg sub.txt)))])
   in
   { loc = main.loc; txt = "ocaml.error" },
   PStr (Str.eval (Exp.constant
-                    (Pconst_string (str_of_pp main.txt, main.loc, None))) ::
+                    (Const.string ~loc:main.loc (str_of_msg main.txt))) ::
         List.map (fun msg -> Str.extension (extension_of_sub msg)) sub)
 
 let attribute_of_warning loc s =
   Attr.mk
     {loc; txt = "ocaml.ppwarning" }
-    (PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, loc, None)))]))
+    (PStr ([Str.eval ~loc (Exp.constant (Const.string ~loc s))]))
 
 let cookies = ref String.Map.empty
 
@@ -935,7 +941,8 @@ module PpxContext = struct
   let restore fields =
     let field name payload =
       let rec get_string = function
-        | { pexp_desc = Pexp_constant (Pconst_string (str, _, None)) } -> str
+        | {pexp_desc = Pexp_constant
+               {pconst_desc = Pconst_string (str, _, None); _}} -> str
         | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
                              { %s }] string syntax" name
       and get_bool pexp =

diff --git a/parsing/asttypes.ml b/parsing/asttypes.ml
new file mode 100644 (file)
index 0000000..0a5e73a
--- /dev/null
+++ b/parsing/asttypes.ml
@@ -0,0 +1,72 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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 Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Auxiliary AST types used by parsetree and typedtree.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type constant =
+    Const_int of int
+  | Const_char of char
+  | Const_string of string * Location.t * string option
+  | Const_float of string
+  | Const_int32 of int32
+  | Const_int64 of int64
+  | Const_nativeint of nativeint
+
+type rec_flag = Nonrecursive | Recursive
+
+type direction_flag = Upto | Downto
+
+(* Order matters, used in polymorphic comparison *)
+type private_flag = Private | Public
+
+type mutable_flag = Immutable | Mutable
+
+type virtual_flag = Virtual | Concrete
+
+type override_flag = Override | Fresh
+
+type closed_flag = Closed | Open
+
+type label = string
+
+type arg_label =
+    Nolabel
+  | Labelled of string (** [label:T -> ...] *)
+  | Optional of string (** [?label:T -> ...] *)
+
+type 'a loc = 'a Location.loc = {
+  txt : 'a;
+  loc : Location.t;
+}
+
+
+type variance =
+  | Covariant
+  | Contravariant
+  | NoVariance
+
+type injectivity =
+  | Injective
+  | NoInjectivity
+
+let string_of_label = function
+    Nolabel -> ""
+  | Labelled s -> s
+  | Optional s -> "?"^s

diff --git a/parsing/asttypes.mli b/parsing/asttypes.mli
index 7a4f1c191320545c955a9fcc575e2f1ce633f6b6..e3cf5ae4e74400c63d63bb825341bdfec44fac1b 100644 (file)
--- a/parsing/asttypes.mli
+++ b/parsing/asttypes.mli
@@ -65,3 +65,5 @@ type variance =
 type injectivity =
   | Injective
   | NoInjectivity
+
+val string_of_label: arg_label -> string

diff --git a/parsing/attr_helper.ml b/parsing/attr_helper.ml
index 390124199bc10d3e124b555f7998420196b83cea..f531cf95b0d162ea374ee6a1120d6d8068990cd0 100644 (file)
--- a/parsing/attr_helper.ml
+++ b/parsing/attr_helper.ml
@@ -39,9 +39,9 @@ let has_no_payload_attribute alt_names attrs =
   | None   -> false
   | Some _ -> true
 
-open Format
+open Format_doc
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Multiple_attributes name ->
     fprintf ppf "Too many %a attributes" Style.inline_code name
   | No_payload_expected name ->
@@ -51,7 +51,9 @@ let () =
   Location.register_error_of_exn
     (function
       | Error (loc, err) ->
-        Some (Location.error_of_printer ~loc report_error err)
+        Some (Location.error_of_printer ~loc report_error_doc err)
       | _ ->
         None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/parsing/attr_helper.mli b/parsing/attr_helper.mli
index a94042a2900096c2b8de00ed42758251f8edf168..2782cba80aacf616091d805e71c65af58b7a76f5 100644 (file)
--- a/parsing/attr_helper.mli
+++ b/parsing/attr_helper.mli
@@ -35,4 +35,5 @@ val has_no_payload_attribute : string -> attributes -> bool
 
 exception Error of Location.t * error
 
-val report_error: Format.formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/parsing/builtin_attributes.ml b/parsing/builtin_attributes.ml
index 9863d8a5693153d7bd1bd8662c23f7e87b1cf2c7..4d730d3026315c51e155045ac1ed359b15149fc6 100644 (file)
--- a/parsing/builtin_attributes.ml
+++ b/parsing/builtin_attributes.ml
@@ -36,12 +36,22 @@ let attr_order a1 a2 =
   | 0 -> Int.compare a1.loc.loc_start.pos_cnum a2.loc.loc_start.pos_cnum
   | n -> n
 
+let compiler_stops_before_attributes_consumed () =
+  let stops_before_lambda =
+    match !Clflags.stop_after with
+    | None -> false
+    | Some pass -> Clflags.Compiler_pass.(compare pass Lambda) < 0
+  in
+  stops_before_lambda || !Clflags.print_types
+
 let warn_unused () =
   let keys = List.of_seq (Attribute_table.to_seq_keys unused_attrs) in
-  let keys = List.sort attr_order keys in
-  List.iter (fun sloc ->
-    Location.prerr_warning sloc.loc (Warnings.Misplaced_attribute sloc.txt))
-    keys
+  Attribute_table.clear unused_attrs;
+  if not (compiler_stops_before_attributes_consumed ()) then
+    let keys = List.sort attr_order keys in
+    List.iter (fun sloc ->
+      Location.prerr_warning sloc.loc (Warnings.Misplaced_attribute sloc.txt))
+      keys
 
 (* These are the attributes that are tracked in the builtin_attrs table for
    misplaced attribute warnings. *)
@@ -93,7 +103,8 @@ let register_attr current_phase name =
     if is_builtin_attr name.txt then
       Attribute_table.replace unused_attrs name ()
 
-let string_of_cst = function
+let string_of_cst const =
+  match const.pconst_desc with
   | Pconst_string(s, _, _) -> Some s
   | _ -> None
 
@@ -107,37 +118,39 @@ let string_of_opt_payload p =
   | Some s -> s
   | None -> ""
 
+module Style = Misc.Style
 let error_of_extension ext =
   let submessage_from main_loc main_txt = function
     | {pstr_desc=Pstr_extension
            (({txt = ("ocaml.error"|"error"); loc}, p), _)} ->
         begin match p with
         | PStr([{pstr_desc=Pstr_eval
-                     ({pexp_desc=Pexp_constant(Pconst_string(msg,_,_))}, _)}
+                     ({pexp_desc=Pexp_constant
+                           {pconst_desc=Pconst_string(msg, _, _); _}}, _)}
                ]) ->
-            { Location.loc; txt = fun ppf -> Format.pp_print_text ppf msg }
+            Location.msg ~loc "%a" Format_doc.pp_print_text msg
         | _ ->
-            { Location.loc; txt = fun ppf ->
-                Format.fprintf ppf
-                  "Invalid syntax for sub-message of extension '%s'." main_txt }
+            Location.msg ~loc "Invalid syntax for sub-message of extension %a."
+              Style.inline_code main_txt
         end
     | {pstr_desc=Pstr_extension (({txt; loc}, _), _)} ->
-        { Location.loc; txt = fun ppf ->
-            Format.fprintf ppf "Uninterpreted extension '%s'." txt }
+        Location.msg ~loc "Uninterpreted extension '%a'."
+          Style.inline_code txt
     | _ ->
-        { Location.loc = main_loc; txt = fun ppf ->
-            Format.fprintf ppf
-              "Invalid syntax for sub-message of extension '%s'." main_txt }
+        Location.msg ~loc:main_loc
+          "Invalid syntax for sub-message of extension %a."
+          Style.inline_code main_txt
   in
   match ext with
   | ({txt = ("ocaml.error"|"error") as txt; loc}, p) ->
       begin match p with
       | PStr [] -> raise Location.Already_displayed_error
       | PStr({pstr_desc=Pstr_eval
-                  ({pexp_desc=Pexp_constant(Pconst_string(msg,_,_))}, _)}::
+                  ({pexp_desc=Pexp_constant
+                      {pconst_desc=Pconst_string(msg, _, _)}}, _)}::
              inner) ->
           let sub = List.map (submessage_from loc txt) inner in
-          Location.error_of_printer ~loc ~sub Format.pp_print_text msg
+          Location.error_of_printer ~loc ~sub Format_doc.pp_print_text msg
       | _ ->
           Location.errorf ~loc "Invalid syntax for extension '%s'." txt
       end
@@ -185,7 +198,8 @@ let kind_and_message = function
          Pstr_eval
            ({pexp_desc=Pexp_apply
                  ({pexp_desc=Pexp_ident{txt=Longident.Lident id}},
-                  [Nolabel,{pexp_desc=Pexp_constant (Pconst_string(s,_,_))}])
+                  [Nolabel,{pexp_desc=Pexp_constant
+                                {pconst_desc=Pconst_string(s,_,_); _}}])
             },_)}] ->
       Some (id, s)
   | PStr[
@@ -264,7 +278,10 @@ let rec attrs_of_sig = function
   | _ ->
       []
 
-let alerts_of_sig sg = alerts_of_attrs (attrs_of_sig sg)
+let alerts_of_sig ~mark sg =
+  let a = attrs_of_sig sg in
+  if mark then mark_alerts_used a;
+  alerts_of_attrs a
 
 let rec attrs_of_str = function
   | {pstr_desc = Pstr_attribute a} :: tl ->
@@ -272,7 +289,10 @@ let rec attrs_of_str = function
   | _ ->
       []
 
-let alerts_of_str str = alerts_of_attrs (attrs_of_str str)
+let alerts_of_str ~mark str =
+  let a = attrs_of_str str in
+  if mark then mark_alerts_used a;
+  alerts_of_attrs a
 
 let warn_payload loc txt msg =
   Location.prerr_warning loc (Warnings.Attribute_payload (txt, msg))
@@ -293,7 +313,7 @@ let warning_attribute ?(ppwarning = true) =
   let process_alert loc name = function
     | PStr[{pstr_desc=
               Pstr_eval(
-                {pexp_desc=Pexp_constant(Pconst_string(s,_,_))},
+                {pexp_desc=Pexp_constant {pconst_desc=Pconst_string(s,_,_); _}},
                 _)
            }] ->
         begin
@@ -302,15 +322,19 @@ let warning_attribute ?(ppwarning = true) =
           with Arg.Bad msg -> warn_payload loc name.txt msg
         end
     | k ->
-        (* Don't [mark_used] in the [Some] cases - that happens in [Env] or
-           [type_mod] if they are in a valid place.  Do [mark_used] in the
-           [None] case, which is just malformed and covered by the "Invalid
-           payload" warning. *)
         match kind_and_message k with
         | Some ("all", _) ->
             warn_payload loc name.txt "The alert name 'all' is reserved"
-        | Some _ -> ()
+        | Some _ ->
+            (* Do [mark_used] in the [Some] case only if Warning 53 is
+               disabled. Later, they will be marked used (provided they are in a
+               valid place) in [compile_common], when they are extracted to be
+               persisted inside the [.cmi] file. *)
+            if not (Warnings.is_active (Misplaced_attribute ""))
+            then mark_used name
         | None -> begin
+            (* Do [mark_used] in the [None] case, which is just malformed and
+               covered by the "Invalid payload" warning. *)
             mark_used name;
             warn_payload loc name.txt "Invalid payload"
           end
@@ -326,7 +350,7 @@ let warning_attribute ?(ppwarning = true) =
       begin match attr_payload with
       | PStr [{ pstr_desc=
                   Pstr_eval({pexp_desc=Pexp_constant
-                                         (Pconst_string (s, _, _))},_);
+                                 {pconst_desc=Pconst_string (s, _, _); _}},_);
                 pstr_loc }] ->
         (mark_used attr_name;
          Location.prerr_warning pstr_loc (Warnings.Preprocessor s))

diff --git a/parsing/builtin_attributes.mli b/parsing/builtin_attributes.mli
index 4eb5ef91f206860e000eec6134160bfcee87c0f1..4176bcb93edd8889a47053321ceff0b225ccbcfa 100644 (file)
--- a/parsing/builtin_attributes.mli
+++ b/parsing/builtin_attributes.mli
@@ -75,7 +75,8 @@ val register_attr : current_phase -> string Location.loc -> unit
 val mark_payload_attrs_used : Parsetree.payload -> unit
 
 (** Issue misplaced attribute warnings for all attributes created with
-    [mk_internal] but not yet marked used. *)
+    [mk_internal] but not yet marked used. Does nothing if compilation
+    is stopped before lambda due to command-line flags. *)
 val warn_unused : unit -> unit
 
 (** {3 Warning 53 helpers for environment attributes}
@@ -115,8 +116,8 @@ val check_alerts_inclusion:
   def:Location.t -> use:Location.t -> Location.t -> Parsetree.attributes ->
   Parsetree.attributes -> string -> unit
 val alerts_of_attrs: Parsetree.attributes -> Misc.alerts
-val alerts_of_sig: Parsetree.signature -> Misc.alerts
-val alerts_of_str: Parsetree.structure -> Misc.alerts
+val alerts_of_sig: mark:bool -> Parsetree.signature -> Misc.alerts
+val alerts_of_str: mark:bool -> Parsetree.structure -> Misc.alerts
 
 val check_deprecated_mutable:
     Location.t -> Parsetree.attributes -> string -> unit
@@ -172,7 +173,7 @@ val select_attributes :
 (** [attr_equals_builtin attr s] is true if the name of the attribute is [s] or
     ["ocaml." ^ s].  This is useful for manually inspecting attribute names, but
     note that doing so will not result in marking the attribute used for the
-    purpose of warning 53, so it is usually preferrable to use [has_attribute]
+    purpose of warning 53, so it is usually preferable to use [has_attribute]
     or [select_attributes]. *)
 val attr_equals_builtin : Parsetree.attribute -> string -> bool
 

diff --git a/parsing/depend.ml b/parsing/depend.ml
index 7d76e6fc92a909c5b7030340422b63d59944997b..bed4fd707e5ccfa7929b71c4e24b949370d917ec 100644 (file)
--- a/parsing/depend.ml
+++ b/parsing/depend.ml
@@ -191,6 +191,7 @@ let rec add_pattern bv pat =
       Option.iter
         (fun name -> pattern_bv := String.Map.add name bound !pattern_bv) id.txt
   | Ppat_open ( m, p) -> let bv = open_module bv m.txt in add_pattern bv p
+  | Ppat_effect(p1, p2) -> add_pattern bv p1; add_pattern bv p2
   | Ppat_exception p -> add_pattern bv p
   | Ppat_extension e -> handle_extension e
 

diff --git a/parsing/docstrings.ml b/parsing/docstrings.ml
index a39f75d2597b19ff5c6eb064cdefebd592fe8a08..32b8e8c468383a54ef63516aadf978eb9bf01113 100644 (file)
--- a/parsing/docstrings.ml
+++ b/parsing/docstrings.ml
@@ -91,8 +91,9 @@ let docs_attr ds =
   let open Parsetree in
   let body = ds.ds_body in
   let loc = ds.ds_loc in
+  let const = { pconst_desc= Pconst_string(body,loc,None); pconst_loc= loc } in
   let exp =
-    { pexp_desc = Pexp_constant (Pconst_string(body, loc, None));
+    { pexp_desc = Pexp_constant const;
       pexp_loc = loc;
       pexp_loc_stack = [];
       pexp_attributes = []; }
@@ -143,8 +144,9 @@ let text_attr ds =
   let open Parsetree in
   let body = ds.ds_body in
   let loc = ds.ds_loc in
+  let const = { pconst_desc= Pconst_string(body,loc,None); pconst_loc= loc } in
   let exp =
-    { pexp_desc = Pexp_constant (Pconst_string(body, loc, None));
+    { pexp_desc = Pexp_constant const;
       pexp_loc = loc;
       pexp_loc_stack = [];
       pexp_attributes = []; }

diff --git a/parsing/lexer.mli b/parsing/lexer.mli
index 756ee95992ffce59b0247a9b5637eb1957d478da..fc43eee28c0642ed6e515255d49361d2fedd55a0 100644 (file)
--- a/parsing/lexer.mli
+++ b/parsing/lexer.mli
@@ -20,7 +20,7 @@
 
 *)
 
-val init : unit -> unit
+val init : ?keyword_edition:((int*int) option * string list) -> unit -> unit
 val token: Lexing.lexbuf -> Parser.token
 val skip_hash_bang: Lexing.lexbuf -> unit
 
@@ -33,8 +33,14 @@ type error =
   | Unterminated_string_in_comment of Location.t * Location.t
   | Empty_character_literal
   | Keyword_as_label of string
+  | Capitalized_label of string
   | Invalid_literal of string
   | Invalid_directive of string * string option
+  | Invalid_encoding of string
+  | Invalid_char_in_ident of Uchar.t
+  | Non_lowercase_delimiter of string
+  | Capitalized_raw_identifier of string
+  | Unknown_keyword of string
 
 exception Error of error * Location.t
 

diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index df87f9a3c37678efc72151d09dc0be858842ad64..d4d069d0b794e35a0de45f6d597a92c742e6d1cd 100644 (file)
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -29,75 +29,109 @@ type error =
   | Unterminated_string_in_comment of Location.t * Location.t
   | Empty_character_literal
   | Keyword_as_label of string
+  | Capitalized_label of string
   | Invalid_literal of string
   | Invalid_directive of string * string option
+  | Invalid_encoding of string
+  | Invalid_char_in_ident of Uchar.t
+  | Non_lowercase_delimiter of string
+  | Capitalized_raw_identifier of string
+  | Unknown_keyword of string
 
 exception Error of error * Location.t
 
 (* The table of keywords *)
 
-let keyword_table =
-  create_hashtable 149 [
-    "and", AND;
-    "as", AS;
-    "assert", ASSERT;
-    "begin", BEGIN;
-    "class", CLASS;
-    "constraint", CONSTRAINT;
-    "do", DO;
-    "done", DONE;
-    "downto", DOWNTO;
-    "else", ELSE;
-    "end", END;
-    "exception", EXCEPTION;
-    "external", EXTERNAL;
-    "false", FALSE;
-    "for", FOR;
-    "fun", FUN;
-    "function", FUNCTION;
-    "functor", FUNCTOR;
-    "if", IF;
-    "in", IN;
-    "include", INCLUDE;
-    "inherit", INHERIT;
-    "initializer", INITIALIZER;
-    "lazy", LAZY;
-    "let", LET;
-    "match", MATCH;
-    "method", METHOD;
-    "module", MODULE;
-    "mutable", MUTABLE;
-    "new", NEW;
-    "nonrec", NONREC;
-    "object", OBJECT;
-    "of", OF;
-    "open", OPEN;
-    "or", OR;
+let all_keywords =
+  let v5_3 = Some (5,3) in
+  let v1_0 = Some (1,0) in
+  let v1_6 = Some (1,6) in
+  let v4_2 = Some (4,2) in
+  let always = None in
+  [
+    "and", AND, always;
+    "as", AS, always;
+    "assert", ASSERT, v1_6;
+    "begin", BEGIN, always;
+    "class", CLASS, v1_0;
+    "constraint", CONSTRAINT, v1_0;
+    "do", DO, always;
+    "done", DONE, always;
+    "downto", DOWNTO, always;
+    "effect", EFFECT, v5_3;
+    "else", ELSE, always;
+    "end", END, always;
+    "exception", EXCEPTION, always;
+    "external", EXTERNAL, always;
+    "false", FALSE, always;
+    "for", FOR, always;
+    "fun", FUN, always;
+    "function", FUNCTION, always;
+    "functor", FUNCTOR, always;
+    "if", IF, always;
+    "in", IN, always;
+    "include", INCLUDE, always;
+    "inherit", INHERIT, v1_0;
+    "initializer", INITIALIZER, v1_0;
+    "lazy", LAZY, v1_6;
+    "let", LET, always;
+    "match", MATCH, always;
+    "method", METHOD, v1_0;
+    "module", MODULE, always;
+    "mutable", MUTABLE, always;
+    "new", NEW, v1_0;
+    "nonrec", NONREC, v4_2;
+    "object", OBJECT, v1_0;
+    "of", OF, always;
+    "open", OPEN, always;
+    "or", OR, always;
 (*  "parser", PARSER; *)
-    "private", PRIVATE;
-    "rec", REC;
-    "sig", SIG;
-    "struct", STRUCT;
-    "then", THEN;
-    "to", TO;
-    "true", TRUE;
-    "try", TRY;
-    "type", TYPE;
-    "val", VAL;
-    "virtual", VIRTUAL;
-    "when", WHEN;
-    "while", WHILE;
-    "with", WITH;
-
-    "lor", INFIXOP3("lor"); (* Should be INFIXOP2 *)
-    "lxor", INFIXOP3("lxor"); (* Should be INFIXOP2 *)
-    "mod", INFIXOP3("mod");
-    "land", INFIXOP3("land");
-    "lsl", INFIXOP4("lsl");
-    "lsr", INFIXOP4("lsr");
-    "asr", INFIXOP4("asr")
+    "private", PRIVATE, v1_0;
+    "rec", REC, always;
+    "sig", SIG, always;
+    "struct", STRUCT, always;
+    "then", THEN, always;
+    "to", TO, always;
+    "true", TRUE, always;
+    "try", TRY, always;
+    "type", TYPE, always;
+    "val", VAL, always;
+    "virtual", VIRTUAL, v1_0;
+    "when", WHEN, always;
+    "while", WHILE, always;
+    "with", WITH, always;
+
+    "lor", INFIXOP3("lor"), always; (* Should be INFIXOP2 *)
+    "lxor", INFIXOP3("lxor"), always; (* Should be INFIXOP2 *)
+    "mod", INFIXOP3("mod"), always;
+    "land", INFIXOP3("land"), always;
+    "lsl", INFIXOP4("lsl"), always;
+    "lsr", INFIXOP4("lsr"), always;
+    "asr", INFIXOP4("asr"), always
 ]
 
+
+let keyword_table = Hashtbl.create 149
+
+let populate_keywords (version,keywords) =
+  let greater (x:(int*int) option) (y:(int*int) option) =
+    match x, y with
+    | None, _ | _, None -> true
+    | Some x, Some y -> x >= y
+  in
+  let tbl = keyword_table in
+  Hashtbl.clear tbl;
+  let add_keyword (name, token, since) =
+    if greater version since then Hashtbl.replace tbl name (Some token)
+  in
+  List.iter add_keyword all_keywords;
+  List.iter (fun name ->
+    match List.find (fun (n,_,_) -> n = name) all_keywords with
+    | (_,tok,_) -> Hashtbl.replace tbl name (Some tok)
+    | exception Not_found -> Hashtbl.replace tbl name None
+    ) keywords
+
+
 (* To buffer string literals *)
 
 let string_buffer = Buffer.create 256
@@ -255,10 +289,53 @@ let uchar_for_uchar_escape lexbuf =
       illegal_escape lexbuf
         (Printf.sprintf "%X is not a Unicode scalar value" cp)
 
-let is_keyword name = Hashtbl.mem keyword_table name
-
-let check_label_name lexbuf name =
-  if is_keyword name then error lexbuf (Keyword_as_label name)
+let validate_encoding lexbuf raw_name =
+  match Utf8_lexeme.normalize raw_name with
+  | Error _ -> error lexbuf (Invalid_encoding raw_name)
+  | Ok name -> name
+
+let ident_for_extended lexbuf raw_name =
+  let name = validate_encoding lexbuf raw_name in
+  match Utf8_lexeme.validate_identifier name with
+  | Utf8_lexeme.Valid -> name
+  | Utf8_lexeme.Invalid_character u -> error lexbuf (Invalid_char_in_ident u)
+  | Utf8_lexeme.Invalid_beginning _ ->
+  assert false (* excluded by the regexps *)
+
+let validate_delim lexbuf raw_name =
+  let name = validate_encoding lexbuf raw_name in
+  if Utf8_lexeme.is_lowercase name then name
+  else error lexbuf (Non_lowercase_delimiter name)
+
+let validate_ext lexbuf name =
+    let name = validate_encoding lexbuf name in
+    match Utf8_lexeme.validate_identifier ~with_dot:true name with
+    | Utf8_lexeme.Valid -> name
+    | Utf8_lexeme.Invalid_character u -> error lexbuf (Invalid_char_in_ident u)
+    | Utf8_lexeme.Invalid_beginning _ ->
+    assert false (* excluded by the regexps *)
+
+let lax_delim raw_name =
+  match Utf8_lexeme.normalize raw_name with
+  | Error _ -> None
+  | Ok name ->
+     if Utf8_lexeme.is_lowercase name then Some name
+     else None
+
+let is_keyword name =
+  Hashtbl.mem keyword_table name
+
+let find_keyword lexbuf name =
+  match Hashtbl.find keyword_table name with
+  | Some x -> x
+  | None -> error lexbuf (Unknown_keyword name)
+  | exception Not_found -> LIDENT name
+
+let check_label_name ?(raw_escape=false) lexbuf name =
+  if Utf8_lexeme.is_capitalized name then
+    error lexbuf (Capitalized_label name);
+  if not raw_escape && is_keyword name then
+    error lexbuf (Keyword_as_label name)
 
 (* Update the current location with file name and line number. *)
 
@@ -278,13 +355,6 @@ let preprocessor = ref None
 
 let escaped_newlines = ref false
 
-(* Warn about Latin-1 characters used in idents *)
-
-let warn_latin1 lexbuf =
-  Location.deprecated
-    (Location.curr lexbuf)
-    "ISO-Latin1 characters in identifiers"
-
 let handle_docstrings = ref true
 let comment_list = ref []
 
@@ -301,7 +371,7 @@ let comments () = List.rev !comment_list
 
 (* Error report *)
 
-open Format
+open Format_doc
 
 let prepare_error loc = function
   | Illegal_character c ->
@@ -335,6 +405,10 @@ let prepare_error loc = function
   | Keyword_as_label kwd ->
       Location.errorf ~loc
         "%a is a keyword, it cannot be used as label name" Style.inline_code kwd
+  | Capitalized_label lbl ->
+      Location.errorf ~loc
+        "%a cannot be used as label name, \
+         it must start with a lowercase letter" Style.inline_code lbl
   | Invalid_literal s ->
       Location.errorf ~loc "Invalid literal %s" s
   | Invalid_directive (dir, explanation) ->
@@ -342,6 +416,25 @@ let prepare_error loc = function
         (fun ppf -> match explanation with
            | None -> ()
            | Some expl -> fprintf ppf ": %s" expl)
+  | Invalid_encoding s ->
+    Location.errorf ~loc "Invalid encoding of identifier %s." s
+  | Invalid_char_in_ident u ->
+      Location.errorf ~loc "Invalid character U+%X in identifier"
+         (Uchar.to_int u)
+  | Capitalized_raw_identifier lbl ->
+      Location.errorf ~loc
+        "%a cannot be used as a raw identifier, \
+         it must start with a lowercase letter" Style.inline_code lbl
+  | Non_lowercase_delimiter name ->
+      Location.errorf ~loc
+        "%a cannot be used as a quoted string delimiter,@ \
+         it must contain only lowercase letters."
+         Style.inline_code name
+  | Unknown_keyword name ->
+      Location.errorf ~loc
+      "%a has been defined as an additional keyword.@ \
+       This version of OCaml does not support this keyword."
+      Style.inline_code name
 
 let () =
   Location.register_error_of_exn
@@ -358,12 +451,15 @@ let newline = ('\013'* '\010')
 let blank = [' ' '\009' '\012']
 let lowercase = ['a'-'z' '_']
 let uppercase = ['A'-'Z']
+let identstart = lowercase | uppercase
 let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
-let lowercase_latin1 = ['a'-'z' '\223'-'\246' '\248'-'\255' '_']
-let uppercase_latin1 = ['A'-'Z' '\192'-'\214' '\216'-'\222']
-let identchar_latin1 =
-  ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
-(* This should be kept in sync with the [is_identchar] function in [env.ml] *)
+let utf8 = ['\192'-'\255'] ['\128'-'\191']*
+let identstart_ext = identstart | utf8
+let identchar_ext = identchar | utf8
+let delim_ext = (lowercase | uppercase | utf8)*
+(* ascii uppercase letters in quoted string delimiters ({delim||delim}) are
+   rejected by the delimiter validation function, we accept them temporarily to
+   have the same error message for ascii and non-ascii uppercase letters *)
 
 let symbolchar =
   ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
@@ -375,7 +471,8 @@ let kwdopchar =
   ['$' '&' '*' '+' '-' '/' '<' '=' '>' '@' '^' '|']
 
 let ident = (lowercase | uppercase) identchar*
-let extattrident = ident ('.' ident)*
+let ident_ext = identstart_ext  identchar_ext*
+let extattrident = ident_ext ('.' ident_ext)*
 
 let decimal_literal =
   ['0'-'9'] ['0'-'9' '_']*
@@ -418,35 +515,38 @@ rule token = parse
   | ".~"
       { error lexbuf
           (Reserved_sequence (".~", Some "is reserved for use in MetaOCaml")) }
-  | "~" raw_ident_escape (lowercase identchar * as name) ':'
-      { LABEL name }
-  | "~" (lowercase identchar * as name) ':'
+  | "~" (identstart identchar * as name) ':'
       { check_label_name lexbuf name;
         LABEL name }
-  | "~" (lowercase_latin1 identchar_latin1 * as name) ':'
-      { warn_latin1 lexbuf;
+  | "~" (raw_ident_escape? as escape) (ident_ext as raw_name) ':'
+      { let name = ident_for_extended lexbuf raw_name in
+        check_label_name ~raw_escape:(escape<>"") lexbuf name;
         LABEL name }
   | "?"
       { QUESTION }
-  | "?" raw_ident_escape (lowercase identchar * as name) ':'
-      { OPTLABEL name }
   | "?" (lowercase identchar * as name) ':'
       { check_label_name lexbuf name;
         OPTLABEL name }
-  | "?" (lowercase_latin1 identchar_latin1 * as name) ':'
-      { warn_latin1 lexbuf;
-        OPTLABEL name }
-  | raw_ident_escape (lowercase identchar * as name)
-      { LIDENT name }
+  | "?" (raw_ident_escape? as escape) (ident_ext as raw_name) ':'
+      { let name = ident_for_extended lexbuf raw_name in
+        check_label_name ~raw_escape:(escape<>"") lexbuf name;
+        OPTLABEL name
+      }
   | lowercase identchar * as name
-      { try Hashtbl.find keyword_table name
-        with Not_found -> LIDENT name }
-  | lowercase_latin1 identchar_latin1 * as name
-      { warn_latin1 lexbuf; LIDENT name }
+      { find_keyword lexbuf name }
   | uppercase identchar * as name
       { UIDENT name } (* No capitalized keywords *)
-  | uppercase_latin1 identchar_latin1 * as name
-      { warn_latin1 lexbuf; UIDENT name }
+  | (raw_ident_escape? as escape) (ident_ext as raw_name)
+      { let name = ident_for_extended lexbuf raw_name in
+        if Utf8_lexeme.is_capitalized name then begin
+            if escape="" then UIDENT name
+            else
+              (* we don't have capitalized keywords, and thus no needs for
+                 capitalized raw identifiers. *)
+              error lexbuf (Capitalized_raw_identifier name)
+        end else
+          LIDENT name
+      } (* No non-ascii keywords *)
   | int_literal as lit { INT (lit, None) }
   | (int_literal as lit) (literal_modifier as modif)
       { INT (lit, Some modif) }
@@ -459,26 +559,34 @@ rule token = parse
   | "\""
       { let s, loc = wrap_string_lexer string lexbuf in
         STRING (s, loc, None) }
-  | "{" (lowercase* as delim) "|"
-      { let s, loc = wrap_string_lexer (quoted_string delim) lexbuf in
-        STRING (s, loc, Some delim) }
-  | "{%" (extattrident as id) "|"
+  | "{" (delim_ext as raw_name) '|'
+      { let delim = validate_delim lexbuf raw_name in
+        let s, loc = wrap_string_lexer (quoted_string delim) lexbuf in
+        STRING (s, loc, Some delim)
+       }
+  | "{%" (extattrident as raw_id) "|"
       { let orig_loc = Location.curr lexbuf in
+        let id = validate_ext lexbuf raw_id in
         let s, loc = wrap_string_lexer (quoted_string "") lexbuf in
         let idloc = compute_quoted_string_idloc orig_loc 2 id in
         QUOTED_STRING_EXPR (id, idloc, s, loc, Some "") }
-  | "{%" (extattrident as id) blank+ (lowercase* as delim) "|"
+  | "{%" (extattrident as raw_id) blank+ (delim_ext as raw_delim) "|"
       { let orig_loc = Location.curr lexbuf in
+        let id = validate_ext lexbuf raw_id in
+        let delim = validate_delim lexbuf raw_delim in
         let s, loc = wrap_string_lexer (quoted_string delim) lexbuf in
         let idloc = compute_quoted_string_idloc orig_loc 2 id in
         QUOTED_STRING_EXPR (id, idloc, s, loc, Some delim) }
-  | "{%%" (extattrident as id) "|"
+  | "{%%" (extattrident as raw_id) "|"
       { let orig_loc = Location.curr lexbuf in
+        let id = validate_ext lexbuf raw_id in
         let s, loc = wrap_string_lexer (quoted_string "") lexbuf in
         let idloc = compute_quoted_string_idloc orig_loc 3 id in
         QUOTED_STRING_ITEM (id, idloc, s, loc, Some "") }
-  | "{%%" (extattrident as id) blank+ (lowercase* as delim) "|"
+  | "{%%" (extattrident as raw_id) blank+ (delim_ext as raw_delim) "|"
       { let orig_loc = Location.curr lexbuf in
+        let id = validate_ext lexbuf raw_id in
+        let delim = validate_delim lexbuf raw_delim in
         let s, loc = wrap_string_lexer (quoted_string delim) lexbuf in
         let idloc = compute_quoted_string_idloc orig_loc 3 id in
         QUOTED_STRING_ITEM (id, idloc, s, loc, Some delim) }
@@ -665,8 +773,10 @@ and comment = parse
         is_in_string := false;
         store_string_char '\"';
         comment lexbuf }
-  | "{" ('%' '%'? extattrident blank*)? (lowercase* as delim) "|"
-      {
+  | "{" ('%' '%'? extattrident blank*)? (delim_ext as raw_delim) "|"
+      { match lax_delim raw_delim with
+        | None -> store_lexeme lexbuf; comment lexbuf
+        | Some delim ->
         string_start_loc := Location.curr lexbuf;
         store_lexeme lexbuf;
         is_in_string := true;
@@ -780,8 +890,9 @@ and quoted_string delim = parse
   | eof
       { is_in_string := false;
         error_loc !string_start_loc Unterminated_string }
-  | "|" (lowercase* as edelim) "}"
+  | "|" (ident_ext? as raw_edelim) "}"
       {
+        let edelim = validate_encoding lexbuf raw_edelim in
         if delim = edelim then lexbuf.lex_start_p
         else (store_lexeme lexbuf; quoted_string delim lexbuf)
       }
@@ -892,7 +1003,8 @@ and skip_hash_bang = parse
     in
       loop NoLine Initial lexbuf
 
-  let init () =
+  let init ?(keyword_edition=None,[]) () =
+    populate_keywords keyword_edition;
     is_in_string := false;
     comment_start_loc := [];
     comment_list := [];

diff --git a/parsing/location.ml b/parsing/location.ml
index d51a7f03b43f8818c39e4b6a3f79990ea6f0413a..865ca5f2038dc87f90b4b23f3c5ec4fd3cbc4162 100644 (file)
--- a/parsing/location.ml
+++ b/parsing/location.ml
@@ -118,13 +118,6 @@ let echo_eof () =
   print_newline ();
   incr num_loc_lines
 
-(* This is used by the toplevel and the report printers below. *)
-let separate_new_message ppf =
-  if not (is_first_message ()) then begin
-    Format.pp_print_newline ppf ();
-    incr num_loc_lines
-  end
-
 (* Code printing errors and warnings must be wrapped using this function, in
    order to update [num_loc_lines].
 
@@ -146,6 +139,8 @@ let print_updating_num_loc_lines ppf f arg =
   pp_print_flush ppf ();
   pp_set_formatter_out_functions ppf out_functions
 
+(** {1 Printing setup }*)
+
 let setup_tags () =
   Misc.Style.setup !Clflags.color
 
@@ -204,8 +199,18 @@ let absolute_path s = (* This function could go into Filename *)
 let show_filename file =
   if !Clflags.absname then absolute_path file else file
 
-let print_filename ppf file =
-  Format.pp_print_string ppf (show_filename file)
+module Fmt = Format_doc
+module Doc = struct
+
+  (* This is used by the toplevel and the report printers below. *)
+  let separate_new_message ppf () =
+    if not (is_first_message ()) then begin
+      Fmt.pp_print_newline ppf ();
+      incr num_loc_lines
+    end
+
+  let filename ppf file =
+    Fmt.pp_print_string ppf (show_filename file)
 
 (* Best-effort printing of the text describing a location, of the form
    'File "foo.ml", line 3, characters 10-12'.
@@ -213,65 +218,73 @@ let print_filename ppf file =
    Some of the information (filename, line number or characters numbers) in the
    location might be invalid; in which case we do not print it.
  *)
-let print_loc ppf loc =
-  setup_tags ();
-  let file_valid = function
-    | "_none_" ->
-        (* This is a dummy placeholder, but we print it anyway to please editors
-           that parse locations in error messages (e.g. Emacs). *)
-        true
-    | "" | "//toplevel//" -> false
-    | _ -> true
-  in
-  let line_valid line = line > 0 in
-  let chars_valid ~startchar ~endchar = startchar <> -1 && endchar <> -1 in
-
-  let file =
-    (* According to the comment in location.mli, if [pos_fname] is "", we must
-       use [!input_name]. *)
-    if loc.loc_start.pos_fname = "" then !input_name
-    else loc.loc_start.pos_fname
-  in
-  let startline = loc.loc_start.pos_lnum in
-  let endline = loc.loc_end.pos_lnum in
-  let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in
-  let endchar = loc.loc_end.pos_cnum - loc.loc_end.pos_bol in
-
-  let first = ref true in
-  let capitalize s =
-    if !first then (first := false; String.capitalize_ascii s)
-    else s in
-  let comma () =
-    if !first then () else Format.fprintf ppf ", " in
-
-  Format.fprintf ppf "@{<loc>";
-
-  if file_valid file then
-    Format.fprintf ppf "%s \"%a\"" (capitalize "file") print_filename file;
-
-  (* Print "line 1" in the case of a dummy line number. This is to please the
-     existing setup of editors that parse locations in error messages (e.g.
-     Emacs). *)
-  comma ();
-  let startline = if line_valid startline then startline else 1 in
-  let endline = if line_valid endline then endline else startline in
-  begin if startline = endline then
-    Format.fprintf ppf "%s %i" (capitalize "line") startline
-  else
-    Format.fprintf ppf "%s %i-%i" (capitalize "lines") startline endline
-  end;
-
-  if chars_valid ~startchar ~endchar then (
+  let loc ppf loc =
+    setup_tags ();
+    let file_valid = function
+      | "_none_" ->
+          (* This is a dummy placeholder, but we print it anyway to please
+             editors that parse locations in error messages (e.g. Emacs). *)
+          true
+      | "" | "//toplevel//" -> false
+      | _ -> true
+    in
+    let line_valid line = line > 0 in
+    let chars_valid ~startchar ~endchar = startchar <> -1 && endchar <> -1 in
+
+    let file =
+      (* According to the comment in location.mli, if [pos_fname] is "", we must
+         use [!input_name]. *)
+      if loc.loc_start.pos_fname = "" then !input_name
+      else loc.loc_start.pos_fname
+    in
+    let startline = loc.loc_start.pos_lnum in
+    let endline = loc.loc_end.pos_lnum in
+    let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in
+    let endchar = loc.loc_end.pos_cnum - loc.loc_end.pos_bol in
+
+    let first = ref true in
+    let capitalize s =
+      if !first then (first := false; String.capitalize_ascii s)
+      else s in
+    let comma () =
+      if !first then () else Fmt.fprintf ppf ", " in
+
+    Fmt.fprintf ppf "@{<loc>";
+
+    if file_valid file then
+      Fmt.fprintf ppf "%s \"%a\"" (capitalize "file") filename file;
+
+    (* Print "line 1" in the case of a dummy line number. This is to please the
+       existing setup of editors that parse locations in error messages (e.g.
+       Emacs). *)
     comma ();
-    Format.fprintf ppf "%s %i-%i" (capitalize "characters") startchar endchar
-  );
+    let startline = if line_valid startline then startline else 1 in
+    let endline = if line_valid endline then endline else startline in
+    begin if startline = endline then
+        Fmt.fprintf ppf "%s %i" (capitalize "line") startline
+      else
+        Fmt.fprintf ppf "%s %i-%i" (capitalize "lines") startline endline
+    end;
 
-  Format.fprintf ppf "@}"
+    if chars_valid ~startchar ~endchar then (
+      comma ();
+      Fmt.fprintf ppf "%s %i-%i" (capitalize "characters") startchar endchar
+    );
 
-(* Print a comma-separated list of locations *)
-let print_locs ppf locs =
-  Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
-    print_loc ppf locs
+    Fmt.fprintf ppf "@}"
+
+  (* Print a comma-separated list of locations *)
+  let locs ppf locs =
+    Fmt.pp_print_list ~pp_sep:(fun ppf () -> Fmt.fprintf ppf ",@ ")
+      loc ppf locs
+  let quoted_filename ppf f = Misc.Style.as_inline_code filename ppf f
+
+end
+
+let print_filename = Fmt.compat Doc.filename
+let print_loc = Fmt.compat Doc.loc
+let print_locs = Fmt.compat Doc.locs
+let separate_new_message ppf = Fmt.compat Doc.separate_new_message ppf ()
 
 (******************************************************************************)
 (* An interval set structure; additionally, it stores user-provided information
@@ -497,13 +510,13 @@ let highlight_quote ppf
            Option.fold ~some:Int.to_string ~none:"" lnum,
            start_pos))
       in
-    Format.fprintf ppf "@[<v>";
+    Fmt.fprintf ppf "@[<v>";
     begin match lines with
     | [] | [("", _, _)] -> ()
     | [(line, line_nb, line_start_cnum)] ->
         (* Single-line error *)
-        Format.fprintf ppf "%s | %s@," line_nb line;
-        Format.fprintf ppf "%*s   " (String.length line_nb) "";
+        Fmt.fprintf ppf "%s | %s@," line_nb line;
+        Fmt.fprintf ppf "%*s   " (String.length line_nb) "";
         (* Iterate up to [rightmost], which can be larger than the length of
            the line because we may point to a location after the end of the
            last token on the line, for instance:
@@ -515,21 +528,21 @@ let highlight_quote ppf
         for i = 0 to rightmost.pos_cnum - line_start_cnum - 1 do
           let pos = line_start_cnum + i in
           if ISet.is_start iset ~pos <> None then
-            Format.fprintf ppf "@{<%s>" highlight_tag;
-          if ISet.mem iset ~pos then Format.pp_print_char ppf '^'
+            Fmt.fprintf ppf "@{<%s>" highlight_tag;
+          if ISet.mem iset ~pos then Fmt.pp_print_char ppf '^'
           else if i < String.length line then begin
             (* For alignment purposes, align using a tab for each tab in the
                source code *)
-            if line.[i] = '\t' then Format.pp_print_char ppf '\t'
-            else Format.pp_print_char ppf ' '
+            if line.[i] = '\t' then Fmt.pp_print_char ppf '\t'
+            else Fmt.pp_print_char ppf ' '
           end;
           if ISet.is_end iset ~pos <> None then
-            Format.fprintf ppf "@}"
+            Fmt.fprintf ppf "@}"
         done;
-        Format.fprintf ppf "@}@,"
+        Fmt.fprintf ppf "@}@,"
     | _ ->
         (* Multi-line error *)
-        Misc.pp_two_columns ~sep:"|" ~max_lines ppf
+        Fmt.pp_two_columns ~sep:"|" ~max_lines ppf
         @@ List.map (fun (line, line_nb, line_start_cnum) ->
           let line = String.mapi (fun i car ->
             if ISet.mem iset ~pos:(line_start_cnum + i) then car else '.'
@@ -537,7 +550,7 @@ let highlight_quote ppf
           (line_nb, line)
         ) lines
     end;
-    Format.fprintf ppf "@]"
+    Fmt.fprintf ppf "@]"
 
 
 
@@ -633,10 +646,10 @@ let lines_around_from_current_input ~start_pos ~end_pos =
 (******************************************************************************)
 (* Reporting errors and warnings *)
 
-type msg = (Format.formatter -> unit) loc
+type msg = Fmt.t loc
 
 let msg ?(loc = none) fmt =
-  Format.kdprintf (fun txt -> { loc; txt }) fmt
+  Fmt.kdoc_printf (fun txt -> { loc; txt }) fmt
 
 type report_kind =
   | Report_error
@@ -649,6 +662,7 @@ type report = {
   kind : report_kind;
   main : msg;
   sub : msg list;
+  footnote: Fmt.t option;
 }
 
 type report_printer = {
@@ -661,7 +675,7 @@ type report_printer = {
   pp_main_loc : report_printer -> report ->
     Format.formatter -> t -> unit;
   pp_main_txt : report_printer -> report ->
-    Format.formatter -> (Format.formatter -> unit) -> unit;
+    Format.formatter -> Fmt.t -> unit;
   pp_submsgs : report_printer -> report ->
     Format.formatter -> msg list -> unit;
   pp_submsg : report_printer -> report ->
@@ -669,7 +683,7 @@ type report_printer = {
   pp_submsg_loc : report_printer -> report ->
     Format.formatter -> t -> unit;
   pp_submsg_txt : report_printer -> report ->
-    Format.formatter -> (Format.formatter -> unit) -> unit;
+    Format.formatter -> Fmt.t -> unit;
 }
 
 let is_dummy_loc loc =
@@ -725,9 +739,13 @@ let batch_mode_printer : report_printer =
       | Misc.Error_style.Short ->
           ()
     in
-    Format.fprintf ppf "@[<v>%a:@ %a@]" print_loc loc highlight loc
+    Format.fprintf ppf "@[<v>%a:@ %a@]" print_loc loc
+      (Fmt.compat highlight) loc
+  in
+  let pp_txt ppf txt = Format.fprintf ppf "@[%a@]" Fmt.Doc.format txt in
+  let pp_footnote ppf f =
+    Option.iter (Format.fprintf ppf "@,%a" pp_txt) f
   in
-  let pp_txt ppf txt = Format.fprintf ppf "@[%t@]" txt in
   let pp self ppf report =
     setup_tags ();
     separate_new_message ppf;
@@ -736,13 +754,14 @@ let batch_mode_printer : report_printer =
        to be aligned with the main message box
     *)
     print_updating_num_loc_lines ppf (fun ppf () ->
-      Format.fprintf ppf "@[<v>%a%a%a: %a%a%a%a@]@."
+      Format.fprintf ppf "@[<v>%a%a%a: %a%a%a%a%a@]@."
       Format.pp_open_tbox ()
       (self.pp_main_loc self report) report.main.loc
       (self.pp_report_kind self report) report.kind
       Format.pp_set_tab ()
       (self.pp_main_txt self report) report.main.txt
       (self.pp_submsgs self report) report.sub
+      pp_footnote report.footnote
       Format.pp_close_tbox ()
     ) ()
   in
@@ -824,21 +843,22 @@ let print_report ppf report =
 (* Reporting errors *)
 
 type error = report
+type delayed_msg = unit -> Fmt.t option
 
 let report_error ppf err =
   print_report ppf err
 
-let mkerror loc sub txt =
-  { kind = Report_error; main = { loc; txt }; sub }
+let mkerror loc sub footnote txt =
+  { kind = Report_error; main = { loc; txt }; sub; footnote=footnote () }
 
-let errorf ?(loc = none) ?(sub = []) =
-  Format.kdprintf (mkerror loc sub)
+let errorf ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) =
+  Fmt.kdoc_printf (mkerror loc sub footnote)
 
-let error ?(loc = none) ?(sub = []) msg_str =
-  mkerror loc sub (fun ppf -> Format.pp_print_string ppf msg_str)
+let error ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) msg_str =
+  mkerror loc sub footnote Fmt.Doc.(string msg_str empty)
 
-let error_of_printer ?(loc = none) ?(sub = []) pp x =
-  mkerror loc sub (fun ppf -> pp ppf x)
+let error_of_printer ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) pp x =
+  mkerror loc sub footnote (Fmt.doc_printf "%a" pp x)
 
 let error_of_printer_file print x =
   error_of_printer ~loc:(in_file !input_name) print x
@@ -851,13 +871,13 @@ let default_warning_alert_reporter report mk (loc: t) w : report option =
   match report w with
   | `Inactive -> None
   | `Active { Warnings.id; message; is_error; sub_locs } ->
-      let msg_of_str str = fun ppf -> Format.pp_print_string ppf str in
+      let msg_of_str str = Format_doc.Doc.(empty |> string str) in
       let kind = mk is_error id in
       let main = { loc; txt = msg_of_str message } in
       let sub = List.map (fun (loc, sub_message) ->
         { loc; txt = msg_of_str sub_message }
       ) sub_locs in
-      Some { kind; main; sub }
+      Some { kind; main; sub; footnote=None }
 
 
 let default_warning_reporter =
@@ -907,7 +927,7 @@ let deprecated ?def ?use loc message =
 module Style = Misc.Style
 
 let auto_include_alert lib =
-  let message = Format.asprintf "\
+  let message = Fmt.asprintf "\
     OCaml's lib directory layout changed in 5.0. The %a subdirectory has been \
     automatically added to the search path, but you should add %a to the \
     command-line to silence this alert (e.g. by adding %a to the list of \
@@ -926,7 +946,7 @@ let auto_include_alert lib =
   prerr_alert none alert
 
 let deprecated_script_alert program =
-  let message = Format.asprintf "\
+  let message = Fmt.asprintf "\
     Running %a where the first argument is an implicit basename with no \
     extension (e.g. %a) is deprecated. Either rename the script \
     (%a) or qualify the basename (%a)"
@@ -992,5 +1012,5 @@ let () =
       | _ -> None
     )
 
-let raise_errorf ?(loc = none) ?(sub = []) =
-  Format.kdprintf (fun txt -> raise (Error (mkerror loc sub txt)))
+let raise_errorf ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) =
+  Fmt.kdoc_printf (fun txt -> raise (Error (mkerror loc sub footnote txt)))

diff --git a/parsing/location.mli b/parsing/location.mli
index 85bae4ff763f359f5e4f357938df91820d9ee64b..5298386f3947b2bef6962d5edff0d06892cb4940 100644 (file)
--- a/parsing/location.mli
+++ b/parsing/location.mli
@@ -88,7 +88,6 @@ val input_phrase_buffer: Buffer.t option ref
 (** {1 Toplevel-specific functions} *)
 
 val echo_eof: unit -> unit
-val separate_new_message: formatter -> unit
 val reset: unit -> unit
 
 
@@ -170,10 +169,17 @@ val show_filename: string -> string
         Otherwise, returns the filename unchanged. *)
 
 val print_filename: formatter -> string -> unit
-
 val print_loc: formatter -> t -> unit
 val print_locs: formatter -> t list -> unit
+val separate_new_message: formatter -> unit
 
+module Doc: sig
+  val separate_new_message: unit Format_doc.printer
+  val filename: string Format_doc.printer
+  val quoted_filename: string Format_doc.printer
+  val loc: t Format_doc.printer
+  val locs: t list Format_doc.printer
+end
 
 (** {1 Toplevel-specific location highlighting} *)
 
@@ -185,9 +191,9 @@ val highlight_terminfo:
 
 (** {2 The type of reports and report printers} *)
 
-type msg = (Format.formatter -> unit) loc
+type msg = Format_doc.t loc
 
-val msg: ?loc:t -> ('a, Format.formatter, unit, msg) format4 -> 'a
+val msg: ?loc:t -> ('a, Format_doc.formatter, unit, msg) format4 -> 'a
 
 type report_kind =
   | Report_error
@@ -200,6 +206,7 @@ type report = {
   kind : report_kind;
   main : msg;
   sub : msg list;
+  footnote: Format_doc.t option
 }
 
 type report_printer = {
@@ -212,7 +219,7 @@ type report_printer = {
   pp_main_loc : report_printer -> report ->
     Format.formatter -> t -> unit;
   pp_main_txt : report_printer -> report ->
-    Format.formatter -> (Format.formatter -> unit) -> unit;
+    Format.formatter -> Format_doc.t -> unit;
   pp_submsgs : report_printer -> report ->
     Format.formatter -> msg list -> unit;
   pp_submsg : report_printer -> report ->
@@ -220,7 +227,7 @@ type report_printer = {
   pp_submsg_loc : report_printer -> report ->
     Format.formatter -> t -> unit;
   pp_submsg_txt : report_printer -> report ->
-    Format.formatter -> (Format.formatter -> unit) -> unit;
+    Format.formatter -> Format_doc.t -> unit;
 }
 (** A printer for [report]s, defined using open-recursion.
     The goal is to make it easy to define new printers by re-using code from
@@ -321,15 +328,17 @@ val deprecated_script_alert: string -> unit
 type error = report
 (** An [error] is a [report] which [report_kind] must be [Report_error]. *)
 
-val error: ?loc:t -> ?sub:msg list -> string -> error
+type delayed_msg = unit -> Format_doc.t option
+
+val error: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg -> string -> error
 
-val errorf: ?loc:t -> ?sub:msg list ->
-  ('a, Format.formatter, unit, error) format4 -> 'a
+val errorf: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
+  ('a, Format_doc.formatter, unit, error) format4 -> 'a
 
-val error_of_printer: ?loc:t -> ?sub:msg list ->
-  (formatter -> 'a -> unit) -> 'a -> error
+val error_of_printer: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
+  (Format_doc.formatter -> 'a -> unit) -> 'a -> error
 
-val error_of_printer_file: (formatter -> 'a -> unit) -> 'a -> error
+val error_of_printer_file: (Format_doc.formatter -> 'a -> unit) -> 'a -> error
 
 
 (** {1 Automatically reporting errors for raised exceptions} *)
@@ -352,8 +361,8 @@ exception Already_displayed_error
 (** Raising [Already_displayed_error] signals an error which has already been
    printed. The exception will be caught, but nothing will be printed *)
 
-val raise_errorf: ?loc:t -> ?sub:msg list ->
-  ('a, Format.formatter, unit, 'b) format4 -> 'a
+val raise_errorf: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
+  ('a, Format_doc.formatter, unit, 'b) format4 -> 'a
 
 val report_exception: formatter -> exn -> unit
 (** Reraise the exception if it is unknown. *)

diff --git a/parsing/parse.ml b/parsing/parse.ml
index c4e14013b1fc0642c0a511419b63c38fcefd7bda..2ef1392c2bef5287c413f005a299eea1ab9a53bd 100644 (file)
--- a/parsing/parse.ml
+++ b/parsing/parse.ml
@@ -46,7 +46,10 @@ type 'a parser =
 let wrap (parser : 'a parser) lexbuf : 'a =
   try
     Docstrings.init ();
-    Lexer.init ();
+    let keyword_edition =
+      Clflags.(Option.map parse_keyword_edition !keyword_edition)
+    in
+    Lexer.init ?keyword_edition ();
     let ast = parser token lexbuf in
     Parsing.clear_parser();
     Docstrings.warn_bad_docstrings ();
@@ -138,7 +141,7 @@ let prepare_error err =
       Location.errorf ~loc
         "In this scoped type, variable %a \
          is reserved for the local type %a."
-        (Style.as_inline_code Pprintast.tyvar) var
+        (Style.as_inline_code Pprintast.Doc.tyvar) var
         Style.inline_code var
   | Other loc ->
       Location.errorf ~loc "Syntax error"
@@ -148,20 +151,20 @@ let prepare_error err =
   | Invalid_package_type (loc, ipt) ->
       let invalid ppf ipt = match ipt with
         | Syntaxerr.Parameterized_types ->
-            Format.fprintf ppf "parametrized types are not supported"
+            Format_doc.fprintf ppf "parametrized types are not supported"
         | Constrained_types ->
-            Format.fprintf ppf "constrained types are not supported"
+            Format_doc.fprintf ppf "constrained types are not supported"
         | Private_types ->
-            Format.fprintf ppf  "private types are not supported"
+            Format_doc.fprintf ppf  "private types are not supported"
         | Not_with_type ->
-            Format.fprintf ppf "only %a constraints are supported"
+            Format_doc.fprintf ppf "only %a constraints are supported"
               Style.inline_code "with type t ="
         | Neither_identifier_nor_with_type ->
-            Format.fprintf ppf
+            Format_doc.fprintf ppf
               "only module type identifier and %a constraints are supported"
               Style.inline_code "with type"
       in
-      Location.errorf ~loc "invalid package type: %a" invalid ipt
+      Location.errorf ~loc "Syntax error: invalid package type: %a" invalid ipt
   | Removed_string_set loc ->
       Location.errorf ~loc
         "Syntax error: strings are immutable, there is no assignment \

diff --git a/parsing/parser.mly b/parsing/parser.mly
index f5908b2ebd54e0ddeb37fe09f940b3c98b9e57fb..84597d962aa712bcab7eec48bd083fdbec6d6e17 100644 (file)
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -58,6 +58,7 @@ let mkmod ~loc ?attrs d = Mod.mk ~loc:(make_loc loc) ?attrs d
 let mkstr ~loc d = Str.mk ~loc:(make_loc loc) d
 let mkclass ~loc ?attrs d = Cl.mk ~loc:(make_loc loc) ?attrs d
 let mkcty ~loc ?attrs d = Cty.mk ~loc:(make_loc loc) ?attrs d
+let mkconst ~loc c = Const.mk ~loc:(make_loc loc) c
 
 let pstr_typext (te, ext) =
   (Pstr_typext te, ext)
@@ -150,20 +151,31 @@ let neg_string f =
   then String.sub f 1 (String.length f - 1)
   else "-" ^ f
 
-let mkuminus ~oploc name arg =
-  match name, arg.pexp_desc with
-  | "-", Pexp_constant(Pconst_integer (n,m)) ->
-      Pexp_constant(Pconst_integer(neg_string n,m))
-  | ("-" | "-."), Pexp_constant(Pconst_float (f, m)) ->
-      Pexp_constant(Pconst_float(neg_string f, m))
+(* Pre-apply the special [-], [-.], [+] and [+.] prefix operators into
+   constants if possible, otherwise turn them into the corresponding prefix
+   operators [~-], [~-.], etc.. *)
+let mkuminus ~sloc ~oploc name arg =
+  match name, arg.pexp_desc, arg.pexp_attributes with
+  | "-",
+    Pexp_constant({pconst_desc = Pconst_integer (n,m); pconst_loc=_}),
+    [] ->
+      Pexp_constant(mkconst ~loc:sloc (Pconst_integer(neg_string n, m)))
+  | ("-" | "-."),
+    Pexp_constant({pconst_desc = Pconst_float (f, m); pconst_loc=_}), [] ->
+      Pexp_constant(mkconst ~loc:sloc (Pconst_float(neg_string f, m)))
   | _ ->
       Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
 
-let mkuplus ~oploc name arg =
+let mkuplus ~sloc ~oploc name arg =
   let desc = arg.pexp_desc in
-  match name, desc with
-  | "+", Pexp_constant(Pconst_integer _)
-  | ("+" | "+."), Pexp_constant(Pconst_float _) -> desc
+  match name, desc, arg.pexp_attributes with
+  | "+",
+    Pexp_constant({pconst_desc = Pconst_integer _ as desc; pconst_loc=_}),
+    []
+  | ("+" | "+."),
+    Pexp_constant({pconst_desc = Pconst_float _ as desc; pconst_loc=_}),
+    [] ->
+      Pexp_constant(mkconst ~loc:sloc desc)
   | _ ->
       Pexp_apply(mkoperator ~loc:oploc ("~" ^ name), [Nolabel, arg])
 
@@ -478,7 +490,8 @@ let wrap_mksig_ext ~loc (item, ext) =
 
 let mk_quotedext ~loc (id, idloc, str, strloc, delim) =
   let exp_id = mkloc id idloc in
-  let e = ghexp ~loc (Pexp_constant (Pconst_string (str, strloc, delim))) in
+  let const = Const.mk ~loc:strloc (Pconst_string (str, strloc, delim)) in
+  let e = ghexp ~loc (Pexp_constant const) in
   (exp_id, PStr [mkstrexp e []])
 
 let text_str pos = Str.text (rhs_text pos)
@@ -648,6 +661,11 @@ let mkfunction params body_constraint body =
       | Some newtypes ->
           mkghost_newtype_function_body newtypes body_constraint body_exp
 
+let mk_functor_typ args mty =
+  List.fold_left (fun acc (startpos, arg) ->
+      mkmty ~loc:(startpos, mty.pmty_loc.loc_end) (Pmty_functor (arg, acc)))
+    mty args
+
 (* Alternatively, we could keep the generic module type in the Parsetree
    and extract the package type during type-checking. In that case,
    the assertions below should be turned into explicit checks. *)
@@ -733,6 +751,7 @@ let mk_directive ~loc name arg =
 %token DOT                    "."
 %token DOTDOT                 ".."
 %token DOWNTO                 "downto"
+%token EFFECT                 "effect"
 %token ELSE                   "else"
 %token END                    "end"
 %token EOF                    ""
@@ -838,6 +857,11 @@ let mk_directive ~loc name arg =
 
 %token EOL                    "\\n"      (* not great, but EOL is unused *)
 
+(* see the [metaocaml_expr] comment *)
+%token METAOCAML_ESCAPE       ".~"
+%token METAOCAML_BRACKET_OPEN   ".<"
+%token METAOCAML_BRACKET_CLOSE  ">."
+
 /* Precedences and associativities.
 
 Tokens and rules have precedences.  A reduce/reduce conflict is resolved
@@ -901,7 +925,7 @@ The precedences must be listed from low to high.
           LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
           NEW PREFIXOP STRING TRUE UIDENT
           LBRACKETPERCENT QUOTED_STRING_EXPR
-
+          METAOCAML_BRACKET_OPEN METAOCAML_ESCAPE
 
 /* Entry points */
 
@@ -1696,11 +1720,11 @@ module_type:
   | FUNCTOR attrs = attributes args = functor_args
     MINUSGREATER mty = module_type
       %prec below_WITH
-      { wrap_mty_attrs ~loc:$sloc attrs (
-          List.fold_left (fun acc (startpos, arg) ->
-            mkmty ~loc:(startpos, $endpos) (Pmty_functor (arg, acc))
-          ) mty args
-        ) }
+      { wrap_mty_attrs ~loc:$sloc attrs (mk_functor_typ args mty) }
+  | args = functor_args
+    MINUSGREATER mty = module_type
+      %prec below_WITH
+      { mk_functor_typ args mty }
   | MODULE TYPE OF attributes module_expr %prec below_LBRACKETAT
       { mkmty ~loc:$sloc ~attrs:$4 (Pmty_typeof $5) }
   | LPAREN module_type RPAREN
@@ -1712,8 +1736,6 @@ module_type:
   | mkmty(
       mkrhs(mty_longident)
         { Pmty_ident $1 }
-    | LPAREN RPAREN MINUSGREATER module_type
-        { Pmty_functor(Unit, $4) }
     | module_type MINUSGREATER module_type
         %prec below_WITH
         { Pmty_functor(Named (mknoloc None, $1), $3) }
@@ -2483,9 +2505,9 @@ fun_expr:
   | e1 = fun_expr op = op(infix_operator) e2 = expr
       { mkinfix e1 op e2 }
   | subtractive expr %prec prec_unary_minus
-      { mkuminus ~oploc:$loc($1) $1 $2 }
+      { mkuminus ~sloc:$sloc ~oploc:$loc($1) $1 $2 }
   | additive expr %prec prec_unary_plus
-      { mkuplus ~oploc:$loc($1) $1 $2 }
+      { mkuplus ~sloc:$sloc ~oploc:$loc($1) $1 $2 }
 ;
 
 simple_expr:
@@ -2501,6 +2523,7 @@ simple_expr:
       { mk_indexop_expr user_indexing_operators ~loc:$sloc $1 }
   | indexop_error (DOT, seq_expr) { $1 }
   | indexop_error (qualified_dotop, expr_semi_list) { $1 }
+  | metaocaml_expr { $1 }
   | simple_expr_attrs
     { let desc, attrs = $1 in
       mkexp_attrs ~loc:$sloc desc attrs }
@@ -2527,6 +2550,25 @@ simple_expr:
   | OBJECT ext_attributes class_structure error
       { unclosed "object" $loc($1) "end" $loc($4) }
 ;
+
+(* We include this parsing rule from the BER-MetaOCaml patchset
+   (see https://okmij.org/ftp/ML/MetaOCaml.html)
+   even though the lexer does *not* include any lexing rule
+   for the METAOCAML_* tokens, so they
+   will never be produced by the upstream compiler.
+
+   The intention of this dead parsing rule is purely to ease the
+   future maintenance work on MetaOCaml.
+*)
+%inline metaocaml_expr:
+  | METAOCAML_ESCAPE e = simple_expr
+    { wrap_exp_attrs ~loc:$sloc e
+       (Some (mknoloc "metaocaml.escape"), []) }
+  | METAOCAML_BRACKET_OPEN e = seq_expr METAOCAML_BRACKET_CLOSE
+    { wrap_exp_attrs ~loc:$sloc e
+       (Some  (mknoloc "metaocaml.bracket"),[]) }
+;
+
 %inline simple_expr_:
   | mkrhs(val_longident)
       { Pexp_ident ($1) }
@@ -2864,6 +2906,8 @@ pattern:
       { $1 }
   | EXCEPTION ext_attributes pattern %prec prec_constr_appl
       { mkpat_attrs ~loc:$sloc (Ppat_exception $3) $2}
+  | EFFECT pattern_gen COMMA simple_pattern
+      { mkpat ~loc:$sloc (Ppat_effect($2,$4)) }
 ;
 
 pattern_no_exn:
@@ -2909,6 +2953,7 @@ pattern_gen:
   | LAZY ext_attributes simple_pattern
       { mkpat_attrs ~loc:$sloc (Ppat_lazy $3) $2}
 ;
+
 simple_pattern:
     mkpat(mkrhs(val_ident) %prec below_EQUAL
       { Ppat_var ($1) })
@@ -3723,17 +3768,24 @@ meth_list:
 /* Constants */
 
 constant:
-  | INT          { let (n, m) = $1 in Pconst_integer (n, m) }
-  | CHAR         { Pconst_char $1 }
-  | STRING       { let (s, strloc, d) = $1 in Pconst_string (s, strloc, d) }
-  | FLOAT        { let (f, m) = $1 in Pconst_float (f, m) }
+  | INT          { let (n, m) = $1 in
+                   mkconst ~loc:$sloc (Pconst_integer (n, m)) }
+  | CHAR         { mkconst ~loc:$sloc (Pconst_char $1) }
+  | STRING       { let (s, strloc, d) = $1 in
+                   mkconst ~loc:$sloc (Pconst_string (s,strloc,d)) }
+  | FLOAT        { let (f, m) = $1 in
+                   mkconst ~loc:$sloc (Pconst_float (f, m)) }
 ;
 signed_constant:
     constant     { $1 }
-  | MINUS INT    { let (n, m) = $2 in Pconst_integer("-" ^ n, m) }
-  | MINUS FLOAT  { let (f, m) = $2 in Pconst_float("-" ^ f, m) }
-  | PLUS INT     { let (n, m) = $2 in Pconst_integer (n, m) }
-  | PLUS FLOAT   { let (f, m) = $2 in Pconst_float(f, m) }
+  | MINUS INT    { let (n, m) = $2 in
+                   mkconst ~loc:$sloc (Pconst_integer("-" ^ n, m)) }
+  | MINUS FLOAT  { let (f, m) = $2 in
+                   mkconst ~loc:$sloc (Pconst_float("-" ^ f, m)) }
+  | PLUS INT     { let (n, m) = $2 in
+                   mkconst ~loc:$sloc (Pconst_integer (n, m)) }
+  | PLUS FLOAT   { let (f, m) = $2 in
+                   mkconst ~loc:$sloc (Pconst_float(f, m)) }
 ;
 
 /* Identifiers and long identifiers */

diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index 2f0a40c26c5b23e524b08cdf9464e43f6dbdf8c6..e22a9a7813373de248d6659ee01354e558c92f22 100644 (file)
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -22,7 +22,12 @@
 
 open Asttypes
 
-type constant =
+type constant = {
+  pconst_desc : constant_desc;
+  pconst_loc : Location.t;
+}
+
+and constant_desc =
   | Pconst_integer of string * char option
       (** Integer constants such as [3] [3l] [3L] [3n].
 
@@ -270,6 +275,7 @@ and pattern_desc =
            [Ppat_constraint(Ppat_unpack(Some "P"), Ptyp_package S)]
          *)
   | Ppat_exception of pattern  (** Pattern [exception P] *)
+  | Ppat_effect of pattern * pattern (* Pattern [effect P P] *)
   | Ppat_extension of extension  (** Pattern [[%id]] *)
   | Ppat_open of Longident.t loc * pattern  (** Pattern [M.(P)] *)
 

diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index ac20c3155edd66762cc57d299d7b777827e014f6..48d96c8f28fd2b9c597221368911710c2a3f8111 100644 (file)
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -81,39 +81,161 @@ let last_is c str =
 let first_is_in cs str =
   str <> "" && List.mem str.[0] cs
 
+(** The OCaml grammar generates [longident]s from five different rules:
+  - module longident (a sequence of uppercase identifiers [A.B.C])
+  - constructor longident, either
+      - a module [longident]
+      - [[]], [()], [true], [false]
+      - an optional module [longident] followed by [(::)] ([A.B.(::)])
+  - class longident, an optional module [longident] followed by a lowercase
+    identifier.
+  - value longident, an optional module [longident] followed by either:
+      - a lowercase identifier ([A.x])
+      - an operator (and in particular the [mod] keyword), ([A.(+), B.(mod)])
+  - type [longident]: a tree of applications and projections of
+    uppercase identifiers followed by a projection ending with
+    a lowercase identifier (for ordinary types), or any identifier
+    (for module types) (e.g [A.B(C.D(E.F).K)(G).X.Y.t])
+All these [longident]s share a common core and optionally add some extensions.
+Unfortunately, these extensions intersect while having different escaping
+and parentheses rules depending on the kind of [longident]:
+  - [true] or [false] can be either constructor [longident]s,
+    or value, type or class [longident]s using the raw identifier syntax.
+  - [mod] can be either an operator value [longident], or a class or type
+    [longident] using the raw identifier syntax.
+Thus in order to print correctly [longident]s, we need to keep track of their
+kind using the context in which they appear.
+*)
+type longindent_kind =
+  | Constr (** variant constructors *)
+  | Type (** core types, module types, class types, and classes *)
+  | Other (** values and modules *)
+
 (* which identifiers are in fact operators needing parentheses *)
-let needs_parens txt =
-  let fix = fixity_of_string txt in
-  is_infix fix
-  || is_mixfix fix
-  || is_kwdop fix
-  || first_is_in prefix_symbols txt
+let needs_parens ~kind txt =
+  match kind with
+  | Type -> false
+  | Constr | Other ->
+      let fix = fixity_of_string txt in
+      is_infix fix
+      || is_mixfix fix
+      || is_kwdop fix
+      || first_is_in prefix_symbols txt
 
 (* some infixes need spaces around parens to avoid clashes with comment
    syntax *)
 let needs_spaces txt =
   first_is '*' txt || last_is '*' txt
 
-(* Turn an arbitrary variable name into a valid OCaml identifier by adding \#
-  in case it is a keyword, or parenthesis when it is an infix or prefix
-  operator. *)
-let ident_of_name ppf txt =
-  let format : (_, _, _) format =
-    if Lexer.is_keyword txt then "\\#%s"
-    else if not (needs_parens txt) then "%s"
-    else if needs_spaces txt then "(@;%s@;)"
-    else "(%s)"
-  in fprintf ppf format txt
-
-let ident_of_name_loc ppf s = ident_of_name ppf s.txt
+let tyvar_of_name s =
+  if String.length s >= 2 && s.[1] = '\'' then
+    (* without the space, this would be parsed as
+       a character literal *)
+    "' " ^ s
+  else if Lexer.is_keyword s then
+    "'\\#" ^ s
+  else if String.equal s "_" then
+    s
+  else
+    "'" ^ s
 
-let protect_longident ppf print_longident longprefix txt =
-    if not (needs_parens txt) then
-      fprintf ppf "%a.%a" print_longident longprefix ident_of_name txt
+module Doc = struct
+(* Turn an arbitrary variable name into a valid OCaml identifier by adding \#
+   in case it is a keyword, or parenthesis when it is an infix or prefix
+   operator. *)
+  let ident_of_name ~kind ppf txt =
+    let format : (_, _, _) format =
+      if Lexer.is_keyword txt then begin
+        match kind, txt with
+        | Constr, ("true"|"false") -> "%s"
+        | _ ->  "\\#%s"
+      end
+      else if not (needs_parens ~kind txt) then "%s"
+      else if needs_spaces txt then "(@;%s@;)"
+      else "(%s)"
+    in Format_doc.fprintf ppf format txt
+
+  let protect_longident ~kind ppf print_longident longprefix txt =
+    if not (needs_parens ~kind txt) then
+      Format_doc.fprintf ppf "%a.%a"
+        print_longident longprefix
+        (ident_of_name ~kind) txt
     else if needs_spaces txt then
-      fprintf ppf "%a.(@;%s@;)" print_longident longprefix txt
+      Format_doc.fprintf ppf "%a.(@;%s@;)" print_longident longprefix txt
     else
-      fprintf ppf "%a.(%s)" print_longident longprefix txt
+      Format_doc.fprintf ppf "%a.(%s)" print_longident longprefix txt
+
+  let rec any_longident ~kind f = function
+    | Lident s -> ident_of_name ~kind f s
+    | Ldot(y,s) ->
+        protect_longident ~kind f (any_longident ~kind:Other) y s
+    | Lapply (y,s) ->
+        Format_doc.fprintf f "%a(%a)"
+          (any_longident ~kind:Other) y
+          (any_longident ~kind:Other) s
+
+  let value_longident ppf l = any_longident ~kind:Other ppf l
+  let longident = value_longident
+  let constr ppf l = any_longident ~kind:Constr ppf l
+  let type_longident ppf l = any_longident ~kind:Type ppf l
+
+  let tyvar ppf s =
+    Format_doc.fprintf ppf "%s" (tyvar_of_name s)
+
+  (* Expressions are considered nominal if they can be used as the subject of a
+     sentence or action. In practice, we consider that an expression is nominal
+     if they satisfy one of:
+     - Similar to an identifier: words separated by '.' or '#'.
+     - Do not contain spaces when printed.
+     - Is a constant that is short enough.
+  *)
+  let nominal_exp t =
+    let open Format_doc.Doc in
+    let longident ?(is_constr=false) l =
+      let kind= if is_constr then Constr else Other in
+      Format_doc.doc_printer (any_longident ~kind) l.Location.txt in
+    let rec nominal_exp doc exp =
+      match exp.pexp_desc with
+      | _ when exp.pexp_attributes <> [] -> None
+      | Pexp_ident l ->
+          Some (longident l doc)
+      | Pexp_variant (lbl, None) ->
+          Some (printf "`%s" lbl doc)
+      | Pexp_construct (l, None) ->
+          Some (longident ~is_constr:true l doc)
+      | Pexp_field (parent, lbl) ->
+          Option.map
+            (printf ".%t" (longident lbl))
+            (nominal_exp doc parent)
+      | Pexp_send (parent, meth) ->
+          Option.map
+            (printf "#%s" meth.txt)
+            (nominal_exp doc parent)
+      (* String constants are syntactically too complex. For example, the
+         quotes conflict with the 'inline_code' style and they might contain
+         spaces. *)
+      | Pexp_constant { pconst_desc = Pconst_string _; _ } -> None
+      (* Char, integer and float constants are nominal. *)
+      | Pexp_constant { pconst_desc = Pconst_char c; _ } ->
+          Some (msg "%C" c)
+      | Pexp_constant
+          { pconst_desc = Pconst_integer (cst, suf) | Pconst_float (cst, suf);
+            _ } ->
+          Some (msg "%s%t" cst (option char suf))
+      | _ -> None
+    in
+    nominal_exp empty t
+end
+
+let value_longident ppf l = Format_doc.compat Doc.value_longident ppf l
+let type_longident ppf l = Format_doc.compat Doc.type_longident ppf l
+
+let ident_of_name ppf i =
+  Format_doc.compat (Doc.ident_of_name ~kind:Other) ppf i
+
+let constr ppf l = Format_doc.compat Doc.constr ppf l
+
+let ident_of_name_loc ppf s = ident_of_name ppf s.txt
 
 type space_formatter = (unit, Format.formatter, unit) format
 
@@ -143,10 +265,10 @@ type construct =
 
 let view_expr x =
   match x.pexp_desc with
-  | Pexp_construct ( {txt= Lident "()"; _},_) -> `tuple
-  | Pexp_construct ( {txt= Lident "true"; _},_) -> `btrue
-  | Pexp_construct ( {txt= Lident "false"; _},_) -> `bfalse
-  | Pexp_construct ( {txt= Lident "[]";_},_) -> `nil
+  | Pexp_construct ( {txt= Lident "()"; _},None) -> `tuple
+  | Pexp_construct ( {txt= Lident "true"; _},None) -> `btrue
+  | Pexp_construct ( {txt= Lident "false"; _},None) -> `bfalse
+  | Pexp_construct ( {txt= Lident "[]";_},None) -> `nil
   | Pexp_construct ( {txt= Lident"::";_},Some _) ->
       let rec loop exp acc = match exp with
           | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);
@@ -225,15 +347,10 @@ let paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
     if b then (pp f "("; pp f first; fu f x; pp f last; pp f ")")
     else fu f x
 
-let rec longident f = function
-  | Lident s -> ident_of_name f s
-  | Ldot(y,s) -> protect_longident f longident y s
-  | Lapply (y,s) ->
-      pp f "%a(%a)" longident y longident s
-
-let longident_loc f x = pp f "%a" longident x.txt
+let with_loc pr ppf x = pr ppf x.txt
+let value_longident_loc = with_loc value_longident
 
-let constant f = function
+let constant_desc f = function
   | Pconst_char i ->
       pp f "%C"  i
   | Pconst_string (i, _, None) ->
@@ -249,6 +366,8 @@ let constant f = function
   | Pconst_float (i, Some m) ->
       paren (first_is '-' i) (fun f (i,m) -> pp f "%s%c" i m) f (i,m)
 
+let constant f const = constant_desc f const.pconst_desc
+
 (* trailing space*)
 let mutable_flag f = function
   | Immutable -> ()
@@ -277,20 +396,9 @@ let iter_loc f ctxt {txt; loc = _} = f ctxt txt
 
 let constant_string f s = pp f "%S" s
 
-let tyvar_of_name s =
-  if String.length s >= 2 && s.[1] = '\'' then
-    (* without the space, this would be parsed as
-       a character literal *)
-    "' " ^ s
-  else if Lexer.is_keyword s then
-    "'\\#" ^ s
-  else if String.equal s "_" then
-    s
-  else
-    "'" ^ s
 
-let tyvar ppf s =
-  Format.fprintf ppf "%s" (tyvar_of_name s)
+
+let tyvar ppf v = Format_doc.compat Doc.tyvar ppf v
 
 let tyvar_loc f str = tyvar f str.txt
 let string_quot f x = pp f "`%a" ident_of_name x
@@ -343,7 +451,7 @@ and core_type1 ctxt f x =
              |[] -> ()
              |[x]-> pp f "%a@;" (core_type1 ctxt)  x
              | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
-          l longident_loc li
+          l (with_loc type_longident) li
     | Ptyp_variant (l, closed, low) ->
         let first_is_inherit = match l with
           | {Parsetree.prf_desc = Rinherit _}::_ -> true
@@ -397,17 +505,20 @@ and core_type1 ctxt f x =
     | Ptyp_class (li, l) ->   (*FIXME*)
         pp f "@[<hov2>%a#%a@]"
           (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
-          longident_loc li
+          (with_loc type_longident) li
     | Ptyp_package (lid, cstrs) ->
         let aux f (s, ct) =
-          pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct  in
+          pp f "type %a@ =@ %a"
+            (with_loc type_longident) s
+            (core_type ctxt) ct  in
         (match cstrs with
-         |[] -> pp f "@[<hov2>(module@ %a)@]" longident_loc lid
+         |[] -> pp f "@[<hov2>(module@ %a)@]" (with_loc type_longident) lid
          |_ ->
-             pp f "@[<hov2>(module@ %a@ with@ %a)@]" longident_loc lid
+             pp f "@[<hov2>(module@ %a@ with@ %a)@]"
+               (with_loc type_longident) lid
                (list aux  ~sep:"@ and@ ")  cstrs)
     | Ptyp_open(li, ct) ->
-       pp f "@[<hov2>%a.(%a)@]" longident_loc li (core_type ctxt) ct
+       pp f "@[<hov2>%a.(%a)@]" value_longident_loc li (core_type ctxt) ct
     | Ptyp_extension e -> extension ctxt f e
     | (Ptyp_arrow _ | Ptyp_alias _ | Ptyp_poly _) ->
        paren true (core_type ctxt) f x
@@ -461,12 +572,13 @@ and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit =
         else
           (match po with
            | Some ([], x) ->
-               pp f "%a@;%a"  longident_loc li (simple_pattern ctxt) x
+               (* [true] and [false] are handled above *)
+               pp f "%a@;%a"  value_longident_loc li (simple_pattern ctxt) x
            | Some (vl, x) ->
-               pp f "%a@ (type %a)@;%a" longident_loc li
+               pp f "%a@ (type %a)@;%a" value_longident_loc li
                  (list ~sep:"@ " ident_of_name_loc) vl
                  (simple_pattern ctxt) x
-           | None -> pp f "%a" longident_loc li)
+           | None -> pp f "%a" value_longident_loc li)
     | _ -> simple_pattern ctxt f x
 
 and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
@@ -483,7 +595,7 @@ and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
     | Ppat_unpack { txt = Some s } ->
         pp f "(module@ %s)@ " s
     | Ppat_type li ->
-        pp f "#%a" longident_loc li
+        pp f "#%a" (with_loc type_longident) li
     | Ppat_record (l, closed) ->
         let longident_x_pattern f (li, p) =
           match (li,p) with
@@ -491,9 +603,9 @@ and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
              {ppat_desc=Ppat_var {txt;_};
               ppat_attributes=[]; _})
             when s = txt ->
-              pp f "@[<2>%a@]"  longident_loc li
+              pp f "@[<2>%a@]"  value_longident_loc li
           | _ ->
-              pp f "@[<2>%a@;=@;%a@]" longident_loc li (pattern1 ctxt) p
+              pp f "@[<2>%a@;=@;%a@]" value_longident_loc li (pattern1 ctxt) p
         in
         begin match closed with
         | Closed ->
@@ -512,6 +624,8 @@ and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
         pp f "@[<2>(lazy@;%a)@]" (simple_pattern ctxt) p
     | Ppat_exception p ->
         pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
+    | Ppat_effect(p1, p2) ->
+        pp f "@[<2>effect@;%a, @;%a@]" (pattern1 ctxt) p1 (pattern1 ctxt) p2
     | Ppat_extension e -> extension ctxt f e
     | Ppat_open (lid, p) ->
         let with_paren =
@@ -520,7 +634,7 @@ and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
         | Ppat_construct (({txt=Lident ("()"|"[]"|"true"|"false");_}), None) ->
             false
         | _ -> true in
-        pp f "@[<2>%a.%a @]" longident_loc lid
+        pp f "@[<2>%a.%a @]" value_longident_loc lid
           (paren with_paren @@ pattern1 ctxt) p
     | _ -> paren true (pattern ctxt) f x
 
@@ -560,7 +674,7 @@ and sugar_expr ctxt f e =
           rem_args =
         let print_path ppf = function
           | None -> ()
-          | Some m -> pp ppf ".%a" longident m in
+          | Some m -> pp ppf ".%a" value_longident m in
         match assign, rem_args with
             | false, [] ->
               pp f "@[%a%a%s%a%s@]"
@@ -759,12 +873,12 @@ and expression ctxt f x =
         (match view_expr x with
          | `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
          | `normal ->
-             pp f "@[<2>%a@;%a@]" longident_loc li
+             pp f "@[<2>%a@;%a@]" (with_loc constr) li
                (simple_expr ctxt) eo
          | _ -> assert false)
     | Pexp_setfield (e1, li, e2) ->
         pp f "@[<2>%a.%a@ <-@ %a@]"
-          (simple_expr ctxt) e1 longident_loc li (simple_expr ctxt) e2
+          (simple_expr ctxt) e1 value_longident_loc li (simple_expr ctxt) e2
     | Pexp_ifthenelse (e1, e2, eo) ->
         (* @;@[<2>else@ %a@]@] *)
         let fmt:(_,_,_)format ="@[<hv0>@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]" in
@@ -783,7 +897,7 @@ and expression ctxt f x =
         pp f "@[<hv>%a@]"
           (list (expression (under_semi ctxt)) ~sep:";@;") lst
     | Pexp_new (li) ->
-        pp f "@[<hov2>new@ %a@]" longident_loc li;
+        pp f "@[<hov2>new@ %a@]" (with_loc type_longident) li;
     | Pexp_setinstvar (s, e) ->
         pp f "@[<hov2>%a@ <-@ %a@]" ident_of_name s.txt (expression ctxt) e
     | Pexp_override l -> (* FIXME *)
@@ -836,7 +950,7 @@ and expression2 ctxt f x =
   if x.pexp_attributes <> [] then expression ctxt f x
   else match x.pexp_desc with
     | Pexp_field (e, li) ->
-        pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e longident_loc li
+        pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e value_longident_loc li
     | Pexp_send (e, s) ->
         pp f "@[<hov2>%a#%a@]" (simple_expr ctxt) e ident_of_name s.txt
 
@@ -854,10 +968,10 @@ and simple_expr ctxt f x =
          | `list xs ->
              pp f "@[<hv0>[%a]@]"
                (list (expression (under_semi ctxt)) ~sep:";@;") xs
-         | `simple x -> longident f x
+         | `simple x -> constr f x
          | _ -> assert false)
     | Pexp_ident li ->
-        longident_loc f li
+        value_longident_loc f li
     (* (match view_fixity_of_exp x with *)
     (* |`Normal -> longident_loc f li *)
     (* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
@@ -878,9 +992,11 @@ and simple_expr ctxt f x =
           match e with
           |  {pexp_desc=Pexp_ident {txt;_};
               pexp_attributes=[]; _} when li.txt = txt ->
-              pp f "@[<hov2>%a@]" longident_loc li
+              pp f "@[<hov2>%a@]" value_longident_loc li
           | _ ->
-              pp f "@[<hov2>%a@;=@;%a@]" longident_loc li (simple_expr ctxt) e
+              pp f "@[<hov2>%a@;=@;%a@]"
+                value_longident_loc li
+                (simple_expr ctxt) e
         in
         pp f "@[<hv0>@[<hv2>{@;%a%a@]@;}@]"(* "@[<hov2>{%a%a}@]" *)
           (option ~last:" with@;" (simple_expr ctxt)) eo
@@ -976,7 +1092,7 @@ and class_type ctxt f x =
         (fun f l -> match l with
            | [] -> ()
            | _  -> pp f "[%a]@ " (list (core_type ctxt) ~sep:"," ) l) l
-        longident_loc li
+        (with_loc type_longident) li
         (attributes ctxt) x.pcty_attributes
   | Pcty_arrow (l, co, cl) ->
       pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
@@ -987,7 +1103,7 @@ and class_type ctxt f x =
       attributes ctxt f x.pcty_attributes
   | Pcty_open (o, e) ->
       pp f "@[<2>let open%s %a in@;%a@]"
-        (override o.popen_override) longident_loc o.popen_expr
+        (override o.popen_override) value_longident_loc o.popen_expr
         (class_type ctxt) e
 
 (* [class type a = object end] *)
@@ -1107,7 +1223,7 @@ and class_expr ctxt f x =
           (fun f l-> if l <>[] then
               pp f "[%a]@ "
                 (list (core_type ctxt) ~sep:",") l) l
-          longident_loc li
+          (with_loc type_longident) li
     | Pcl_constraint (ce, ct) ->
         pp f "(%a@ :@ %a)"
           (class_expr ctxt) ce
@@ -1115,7 +1231,7 @@ and class_expr ctxt f x =
     | Pcl_extension e -> extension ctxt f e
     | Pcl_open (o, e) ->
         pp f "@[<2>let open%s %a in@;%a@]"
-          (override o.popen_override) longident_loc o.popen_expr
+          (override o.popen_override) value_longident_loc o.popen_expr
           (class_expr ctxt) e
 
 and module_type ctxt f x =
@@ -1132,7 +1248,7 @@ and module_type ctxt f x =
             pp f "@[<hov2>%a@ ->@ %a@]"
               (module_type1 ctxt) mt1 (module_type ctxt) mt2
         | Some name ->
-            pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" name
+            pp f "@[<hov2>(%s@ :@ %a)@ ->@ %a@]" name
               (module_type ctxt) mt1 (module_type ctxt) mt2
         end
     | Pmty_with (mt, []) -> module_type ctxt f mt
@@ -1146,29 +1262,33 @@ and with_constraint ctxt f = function
   | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
       pp f "type@ %a %a =@ %a"
         (type_params ctxt) ls
-        longident_loc li (type_declaration ctxt) td
+        (with_loc type_longident) li (type_declaration ctxt) td
   | Pwith_module (li, li2) ->
-      pp f "module %a =@ %a" longident_loc li longident_loc li2;
+      pp f "module %a =@ %a" value_longident_loc li value_longident_loc li2;
   | Pwith_modtype (li, mty) ->
-      pp f "module type %a =@ %a" longident_loc li (module_type ctxt) mty;
+      pp f "module type %a =@ %a"
+        (with_loc type_longident) li
+        (module_type ctxt) mty;
   | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
       pp f "type@ %a %a :=@ %a"
         (type_params ctxt) ls
-        longident_loc li
+        (with_loc type_longident) li
         (type_declaration ctxt) td
   | Pwith_modsubst (li, li2) ->
-      pp f "module %a :=@ %a" longident_loc li longident_loc li2
+      pp f "module %a :=@ %a" value_longident_loc li value_longident_loc li2
   | Pwith_modtypesubst (li, mty) ->
-      pp f "module type %a :=@ %a" longident_loc li (module_type ctxt) mty;
+      pp f "module type %a :=@ %a"
+        (with_loc type_longident) li
+        (module_type ctxt) mty;
 
 
 and module_type1 ctxt f x =
   if x.pmty_attributes <> [] then module_type ctxt f x
   else match x.pmty_desc with
     | Pmty_ident li ->
-        pp f "%a" longident_loc li;
+        pp f "%a" (with_loc type_longident) li;
     | Pmty_alias li ->
-        pp f "(module %a)" longident_loc li;
+        pp f "(module %a)" (with_loc type_longident) li;
     | Pmty_signature (s) ->
         pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
           (list (signature_item ctxt)) s (* FIXME wrong indentation*)
@@ -1219,7 +1339,7 @@ and signature_item ctxt f x : unit =
                             pmty_attributes=[]; _};_} as pmd) ->
       pp f "@[<hov>module@ %s@ =@ %a@]%a"
         (Option.value pmd.pmd_name.txt ~default:"_")
-        longident_loc alias
+        value_longident_loc alias
         (item_attributes ctxt) pmd.pmd_attributes
   | Psig_module pmd ->
       pp f "@[<hov>module@ %s@ :@ %a@]%a"
@@ -1228,20 +1348,20 @@ and signature_item ctxt f x : unit =
         (item_attributes ctxt) pmd.pmd_attributes
   | Psig_modsubst pms ->
       pp f "@[<hov>module@ %s@ :=@ %a@]%a" pms.pms_name.txt
-        longident_loc pms.pms_manifest
+        value_longident_loc pms.pms_manifest
         (item_attributes ctxt) pms.pms_attributes
   | Psig_open od ->
       pp f "@[<hov2>open%s@ %a@]%a"
         (override od.popen_override)
-        longident_loc od.popen_expr
+        value_longident_loc od.popen_expr
         (item_attributes ctxt) od.popen_attributes
   | Psig_include incl ->
       pp f "@[<hov2>include@ %a@]%a"
         (module_type ctxt) incl.pincl_mod
         (item_attributes ctxt) incl.pincl_attributes
   | Psig_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
-      pp f "@[<hov2>module@ type@ %s%a@]%a"
-        s.txt
+      pp f "@[<hov2>module@ type@ %a%a@]%a"
+        ident_of_name s.txt
         (fun f md -> match md with
            | None -> ()
            | Some mt ->
@@ -1293,7 +1413,7 @@ and module_expr ctxt f x =
           (module_expr ctxt) me
           (module_type ctxt) mt
     | Pmod_ident (li) ->
-        pp f "%a" longident_loc li;
+        pp f "%a" value_longident_loc li;
     | Pmod_functor (Unit, me) ->
         pp f "functor ()@;->@;%a" (module_expr ctxt) me
     | Pmod_functor (Named (s, mt), me) ->
@@ -1342,7 +1462,7 @@ and binding ctxt f {pvb_pat=p; pvb_expr=x; pvb_constraint = ct; _} =
         (simple_pattern ctxt) p (core_type ctxt) typ (expression ctxt) x
   | Some (Pvc_constraint { locally_abstract_univars = vars; typ }) ->
       pp f "%a@;: type@;%a.@;%a@;=@;%a"
-        (simple_pattern ctxt) p (list pp_print_string ~sep:"@;")
+        (simple_pattern ctxt) p (list ident_of_name ~sep:"@;")
         (List.map (fun x -> x.txt) vars)
         (core_type ctxt) typ (expression ctxt) x
   | Some (Pvc_coercion {ground=None; coercion }) ->
@@ -1433,8 +1553,8 @@ and structure_item ctxt f x =
         (module_expr ctxt) od.popen_expr
         (item_attributes ctxt) od.popen_attributes
   | Pstr_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
-      pp f "@[<hov2>module@ type@ %s%a@]%a"
-        s.txt
+      pp f "@[<hov2>module@ type@ %a%a@]%a"
+        ident_of_name s.txt
         (fun f md -> match md with
            | None -> ()
            | Some mt ->
@@ -1623,7 +1743,7 @@ and type_extension ctxt f x =
        | l ->
            pp f "%a@;" (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",") l)
     x.ptyext_params
-    longident_loc x.ptyext_path
+    (with_loc type_longident) x.ptyext_path
     private_flag x.ptyext_private (* Cf: #7200 *)
     (list ~sep:"" extension_constructor)
     x.ptyext_constructors
@@ -1670,7 +1790,7 @@ and extension_constructor ctxt f x =
         (x.pext_name.txt, v, l, r, x.pext_attributes)
   | Pext_rebind li ->
       pp f "%s@;=@;%a%a" x.pext_name.txt
-        longident_loc li
+        (with_loc constr) li
         (attributes ctxt) x.pext_attributes
 
 and case_list ctxt f l : unit =
@@ -1704,7 +1824,7 @@ and directive_argument f x =
   | Pdir_string (s) -> pp f "@ %S" s
   | Pdir_int (n, None) -> pp f "@ %s" n
   | Pdir_int (n, Some m) -> pp f "@ %s%c" n m
-  | Pdir_ident (li) -> pp f "@ %a" longident li
+  | Pdir_ident (li) -> pp f "@ %a" value_longident li
   | Pdir_bool (b) -> pp f "@ %s" (string_of_bool b)
 
 let toplevel_phrase f x =
@@ -1753,3 +1873,4 @@ let structure_item = structure_item reset_ctxt
 let signature_item = signature_item reset_ctxt
 let binding = binding reset_ctxt
 let payload = payload reset_ctxt
+let longident = value_longident

diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli
index bbb15fef6b0ad841ad6418bdeec5a6456756dc18..3d26895ee919498e10532149946fdcf3ea9b9d14 100644 (file)
--- a/parsing/pprintast.mli
+++ b/parsing/pprintast.mli
@@ -24,6 +24,8 @@
 type space_formatter = (unit, Format.formatter, unit) format
 
 val longident : Format.formatter -> Longident.t -> unit
+val constr : Format.formatter -> Longident.t -> unit
+
 val expression : Format.formatter -> Parsetree.expression -> unit
 val string_of_expression : Parsetree.expression -> string
 
@@ -59,3 +61,14 @@ val tyvar: Format.formatter -> string -> unit
   (** Print a type variable name as a valid identifier, taking care of the
       special treatment required for the single quote character in second
       position, or for keywords by escaping them with \#. No-op on "_". *)
+
+(** {!Format_doc} functions for error messages *)
+module Doc:sig
+  val longident: Longident.t Format_doc.printer
+  val constr: Longident.t Format_doc.printer
+  val tyvar: string Format_doc.printer
+
+  (** Returns a format document if the expression reads nicely as the subject
+      of a sentence in a error message. *)
+  val nominal_exp : Parsetree.expression -> Format_doc.t option
+end

diff --git a/parsing/printast.ml b/parsing/printast.ml
index 2f5702e7d28092bb5c434b0309c6d79fe5455369..17f28836ad48fb01c6b6e93f98f2211fd95cf82e 100644 (file)
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -57,16 +57,6 @@ let fmt_char_option f = function
   | None -> fprintf f "None"
   | Some c -> fprintf f "Some %c" c
 
-let fmt_constant f x =
-  match x with
-  | Pconst_integer (i,m) -> fprintf f "PConst_int (%s,%a)" i fmt_char_option m
-  | Pconst_char (c) -> fprintf f "PConst_char %02x" (Char.code c)
-  | Pconst_string (s, strloc, None) ->
-      fprintf f "PConst_string(%S,%a,None)" s fmt_location strloc
-  | Pconst_string (s, strloc, Some delim) ->
-      fprintf f "PConst_string (%S,%a,Some %S)" s fmt_location strloc delim
-  | Pconst_float (s,m) -> fprintf f "PConst_float (%s,%a)" s fmt_char_option m
-
 let fmt_mutable_flag f x =
   match x with
   | Immutable -> fprintf f "Immutable"
@@ -106,6 +96,18 @@ let line i f s (*...*) =
   fprintf f "%s" (String.make ((2*i) mod 72) ' ');
   fprintf f s (*...*)
 
+let fmt_constant i f x =
+  line i f "constant %a\n" fmt_location x.pconst_loc;
+  let i = i+1 in
+  match x.pconst_desc with
+  | Pconst_integer (j,m) -> line i f "PConst_int (%s,%a)\n" j fmt_char_option m
+  | Pconst_char c -> line i f "PConst_char %02x\n" (Char.code c)
+  | Pconst_string (s, strloc, None) ->
+      line i f "PConst_string(%S,%a,None)\n" s fmt_location strloc
+  | Pconst_string (s, strloc, Some delim) ->
+      line i f "PConst_string (%S,%a,Some %S)\n" s fmt_location strloc delim
+  | Pconst_float (s,m) -> line i f "PConst_float (%s,%a)\n" s fmt_char_option m
+
 let list i f ppf l =
   match l with
   | [] -> line i ppf "[]\n"
@@ -201,9 +203,13 @@ and pattern i ppf x =
   | Ppat_alias (p, s) ->
       line i ppf "Ppat_alias %a\n" fmt_string_loc s;
       pattern i ppf p;
-  | Ppat_constant (c) -> line i ppf "Ppat_constant %a\n" fmt_constant c;
+  | Ppat_constant (c) ->
+      line i ppf "Ppat_constant\n";
+      fmt_constant i ppf c;
   | Ppat_interval (c1, c2) ->
-      line i ppf "Ppat_interval %a..%a\n" fmt_constant c1 fmt_constant c2;
+      line i ppf "Ppat_interval\n";
+      fmt_constant i ppf c1;
+      fmt_constant i ppf c2;
   | Ppat_tuple (l) ->
       line i ppf "Ppat_tuple\n";
       list i pattern ppf l;
@@ -242,6 +248,10 @@ and pattern i ppf x =
   | Ppat_exception p ->
       line i ppf "Ppat_exception\n";
       pattern i ppf p
+  | Ppat_effect(p1, p2) ->
+      line i ppf "Ppat_effect\n";
+      pattern i ppf p1;
+      pattern i ppf p2
   | Ppat_open (m,p) ->
       line i ppf "Ppat_open \"%a\"\n" fmt_longident_loc m;
       pattern i ppf p
@@ -255,7 +265,9 @@ and expression i ppf x =
   let i = i+1 in
   match x.pexp_desc with
   | Pexp_ident (li) -> line i ppf "Pexp_ident %a\n" fmt_longident_loc li;
-  | Pexp_constant (c) -> line i ppf "Pexp_constant %a\n" fmt_constant c;
+  | Pexp_constant (c) ->
+      line i ppf "Pexp_constant\n";
+      fmt_constant i ppf c;
   | Pexp_let (rf, l, e) ->
       line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
       list i value_binding ppf l;

diff --git a/parsing/unit_info.ml b/parsing/unit_info.ml
index 03e8d449495f08f9f7216326599490a2b142eb5a..66ad51b7cb036b77e42245b60f878234c8531805 100644 (file)
--- a/parsing/unit_info.ml
+++ b/parsing/unit_info.ml
@@ -13,18 +13,24 @@
 (*                                                                        *)
 (**************************************************************************)
 
+type intf_or_impl = Intf | Impl
 type modname = string
 type filename = string
 type file_prefix = string
 
+type error = Invalid_encoding of string
+exception Error of error
+
 type t = {
   source_file: filename;
   prefix: file_prefix;
   modname: modname;
+  kind: intf_or_impl;
 }
 
 let source_file (x: t) = x.source_file
 let modname (x: t) = x.modname
+let kind (x: t) = x.kind
 let prefix (x: t) = x.prefix
 
 let basename_chop_extensions basename  =
@@ -32,37 +38,39 @@ let basename_chop_extensions basename  =
   | dot_pos -> String.sub basename 0 dot_pos
   | exception Not_found -> basename
 
-let modulize s = String.capitalize_ascii s
+let strict_modulize s =
+  match Misc.Utf8_lexeme.capitalize s with
+  | Ok x -> x
+  | Error _ -> raise (Error (Invalid_encoding s))
+
+let modulize s = match Misc.Utf8_lexeme.capitalize s with Ok x | Error x -> x
 
-(* We re-export the [Misc] definition *)
-let normalize = Misc.normalized_unit_filename
+(* We re-export the [Misc] definition, and ignore encoding errors under the
+   assumption that we should focus our effort on not *producing* badly encoded
+   module names *)
+let normalize x = match Misc.normalized_unit_filename x with
+  | Ok x | Error x -> x
 
-let modname_from_source source_file =
-  source_file |> Filename.basename |> basename_chop_extensions |> modulize
+let stem source_file =
+  source_file |> Filename.basename |> basename_chop_extensions
 
-let start_char = function
-  | 'A' .. 'Z' -> true
-  | _ -> false
+let strict_modname_from_source source_file =
+  source_file |> stem |> strict_modulize
 
-let is_identchar_latin1 = function
-  | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214' | '\216'..'\246'
-  | '\248'..'\255' | '\'' | '0'..'9' -> true
-  | _ -> false
+let lax_modname_from_source source_file =
+  source_file |> stem |> modulize
 
 (* Check validity of module name *)
-let is_unit_name name =
-  String.length name > 0
-  && start_char name.[0]
-  && String.for_all is_identchar_latin1 name
+let is_unit_name name = Misc.Utf8_lexeme.is_valid_identifier name
 
 let check_unit_name file =
   if not (is_unit_name (modname file)) then
     Location.prerr_warning (Location.in_file (source_file file))
       (Warnings.Bad_module_name (modname file))
 
-let make ?(check_modname=true) ~source_file prefix =
-  let modname = modname_from_source prefix in
-  let p = { modname; prefix; source_file } in
+let make ?(check_modname=true) ~source_file kind prefix =
+  let modname = strict_modname_from_source prefix in
+  let p = { modname; prefix; source_file; kind } in
   if check_modname then check_unit_name p;
   p
 
@@ -79,7 +87,7 @@ module Artifact = struct
   let prefix x = Filename.remove_extension (filename x)
 
   let from_filename filename =
-    let modname = modname_from_source filename in
+    let modname = lax_modname_from_source filename in
     { modname; filename; source_file = None }
 
 end
@@ -120,3 +128,14 @@ let find_normalized_cmi f =
   let filename = modname f ^ ".cmi" in
   let filename = Load_path.find_normalized filename in
   { Artifact.filename; modname = modname f; source_file = Some f.source_file  }
+
+let report_error = function
+  | Invalid_encoding name ->
+      Location.errorf "Invalid encoding of output name: %s." name
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (report_error err)
+      | _ -> None
+    )

diff --git a/parsing/unit_info.mli b/parsing/unit_info.mli
index 466a07a228d3346eb4965ca775fc9f0b204ea43a..04002b25209c0c7339045a24b61b1a97f4fdb958 100644 (file)
--- a/parsing/unit_info.mli
+++ b/parsing/unit_info.mli
@@ -21,24 +21,32 @@
 
 (** {1:modname_from_strings Module name convention and computation} *)
 
+type intf_or_impl = Intf | Impl
 type modname = string
 type filename = string
 type file_prefix = string
 
+type error = Invalid_encoding of filename
+exception Error of error
+
 (** [modulize s] capitalizes the first letter of [s]. *)
 val modulize: string -> modname
 
 (** [normalize s] uncapitalizes the first letter of [s]. *)
 val normalize: string -> string
 
-(** [modname_from_source filename] is [modulize stem] where [stem] is the
+(** [lax_modname_from_source filename] is [modulize stem] where [stem] is the
     basename of the filename [filename] stripped from all its extensions.
     For instance, [modname_from_source "/pa.th/x.ml.pp"] is ["X"]. *)
-val modname_from_source: filename -> modname
+val lax_modname_from_source: filename -> modname
+
+(** Same as {!lax_modname_from_source} but raises an {!error.Invalid_encoding}
+    error on filename with invalid utf8 encoding. *)
+val strict_modname_from_source: filename -> modname
 
 (** {2:module_name_validation Module name validation function}*)
 
-(** [is_unit_name ~strict name] is true only if [name] can be used as a
+(** [is_unit_name name] is true only if [name] can be used as a
     valid module name. *)
 val is_unit_name : modname -> bool
 
@@ -67,19 +75,24 @@ val prefix: t -> file_prefix
     or compilation artifact.*)
 val modname: t -> modname
 
+(** [kind u] is the kind (interface or implementation) of the unit. *)
+val kind: t -> intf_or_impl
+
 (** [check_unit_name u] prints a warning if the derived module name [modname u]
     should not be used as a module name as specified
     by {!is_unit_name}[ ~strict:true]. *)
 val check_unit_name : t -> unit
 
-(** [make ~check ~source_file prefix] associates both the
+(** [make ~check ~source_file kind prefix] associates both the
     [source_file] and the module name {!modname_from_source}[ target_prefix] to
     the prefix filesystem path [prefix].
 
    If [check_modname=true], this function emits a warning if the derived module
    name is not valid according to {!check_unit_name}.
 *)
-val make: ?check_modname:bool -> source_file:filename -> file_prefix -> t
+val make:
+    ?check_modname:bool -> source_file:filename ->
+    intf_or_impl -> file_prefix -> t
 
 (** {1:artifact_function Build artifacts }*)
 module Artifact: sig

diff --git a/release-info/News b/release-info/News
index e6e83a9a948c2931de4e8fe3043a2b8e1722489d..0eeca7dbf2c8c10bc33c10fa075446e33fa17387 100644 (file)
--- a/release-info/News
+++ b/release-info/News
@@ -1,3 +1,63 @@
+OCaml 5.2.0 (13 May 2024)
+------------------------
+
+OCaml 5.2.0 is still a somewhat experimental release compared to the OCaml 4.14
+branch. Some of the highlights in OCaml 5.2.0 are:
+
+- Re-introduced GC compaction
+- Restored native backend for POWER 64 bits
+- Thread sanitizer support
+- New Dynarray module
+- New -H flag for hidden include directories
+- Project-wide occurence metadata support for developer tools
+- Raw identifiers
+- Local open in type expressions
+
+And a lot of incremental changes:
+
+- Around 20 new functions in the standard library
+- Many fixes and improvements in the runtime
+- Many bug fixes
+
+OCaml 5.1.0 (14 September 2023)
+-------------------------------
+
+OCaml 5.1.0 is still a relatively experimental release compared to the OCaml
+4.14 branch. Some of the highlights in OCaml 5.1.0 are:
+
+-  Many runtime performance regression and memory-leaks fixes
+    (dynlinking, weak arrays, weak hash sets, GC with idle domains,
+     and GC prefetching).
+- Restored support for native code generation on RISC-V and s390x architectures.
+- Restored Cygwin port.
+- Reduced installation size (50% reduction)
+- Compressed compilation artefacts (.cmi, .cmt, .cmti, .cmo, .cma files)
+- 19 error message improvements
+- 14 standard library functions made tail-recursive
+  with Tail-Recursion-Modulo-Cons (TRMC), such as List.append and List.map.
+- 57 new standard library functions
+- More examples in the standard library documentation
+- 42 bug fixes
+
+
+OCaml 5.0.0 (15 December 2022)
+------------------------------
+
+OCaml 5.0.0 introduces a completely new runtime environment with support for
+shared memory parallelism and effect handlers.
+
+As a language, OCaml 5 is fully compatible with OCaml 4 down to the performance
+characteristics of your programs. In other words, any code that works with OCaml
+4 should work the same with OCaml 5.
+
+The currently known exceptions to this rule are:
+
+- the removal of many long-deprecated functions and modules
+- changes to the internal runtime API
+- the performance of ephemerons is currently (and temporarily) strongly
+  degraded.
+
+
 OCaml 4.14.0 (28 March 2022)
 ----------------------------
 

diff --git a/release-info/calendar.md b/release-info/calendar.md
new file mode 100644 (file)
index 0000000..f0fae92
--- /dev/null
+++ b/release-info/calendar.md
@@ -0,0 +1,32 @@
+# Prospective release calendar
+
+This is a prospective calendar for the next releases of OCaml.
+
+This document is intended to give a very rough idea of the timeline for the next
+versions of OCaml to anyone interested. However, it would be an unforeseen
+accident if this prospective calendar ever matches the real release calendar.
+
+
+# Main versions
+
+## OCaml 5.3.0
+(Last updated on 29th May 2024)
+
+|    Phase              | Expected (early) | Expected (late) | Actual        |
+|-----------------------|------------------|-----------------|---------------|
+| Feature freeze        | 15 August 2024   | (same)          |               |
+| 1st beta release      | 10th September   | 15th October    | 31st October  |
+| 1st release candidate | 1st October      | 7th November    |               |
+| Release               | 7th October      | 21st November   |               |
+
+## OCaml 5.4.0
+
+|    Release            | Expected (early) | Expected (late)  | Actual      |
+|-----------------------|------------------|------------------|-------------|
+| Release               | April 2025       |  May 2025        |             |
+
+# LTS version
+
+## OCaml 4.14.3
+
+- release: after July 2024

diff --git a/release-info/howto.md b/release-info/howto.md
index 0022e67d230134a456f7d9a4abdce3fc84b95270..3b67474ac6768c57e0966d8225c7ed6e8df961cc 100644 (file)
--- a/release-info/howto.md
+++ b/release-info/howto.md
@@ -24,8 +24,8 @@ OCamlLabs folks (for OPAM testing).
 rm -f /tmp/env-$USER.sh
 cat >/tmp/env-$USER.sh <<EOF
 # Update the data below
-export MAJOR=4
-export MINOR=12
+export MAJOR=5
+export MINOR=2
 export BUGFIX=0
 export PLUSEXT=
 
@@ -35,7 +35,7 @@ export HUMAN=
 # do we need to use tar or gtar?
 export TAR=tar
 
-export WORKTREE=~/o/\$MAJOR.\$MINOR
+export WORKTREE=~/ocaml/\$MAJOR.\$MINOR
   # must be the git worktree for the branch you are releasing
 
 export BRANCH=\$MAJOR.\$MINOR
@@ -121,7 +121,7 @@ make tests
 ## 5: build, tag and push the new release
 
 ```
-# at this point, the VERSION file contains N+devD
+# at this point, the build-aux/ocaml_version.m4 file contains N+devD
 # increment it into N+dev(D+1); for example,
 #   4.07.0+dev8-2018-06-19 => 4.07.0+dev9-2018-06-26
 # for production releases: check and change the Changes header
@@ -129,10 +129,9 @@ make tests
 make -B configure
 git commit -a -m "last commit before tagging $VERSION"
 
-# update VERSION with the new release; for example,
+# update build-aux/ocaml_version.m4 with the new release; for example,
 #   4.07.0+dev9-2018-06-26 => 4.07.0+rc2
 # Update ocaml-variants.opam with new version.
-# Update \year in manual/src/macros.hva
 make -B configure
 # For a production release
 make coreboot -j5
@@ -140,13 +139,13 @@ make coreboot -j5 # must say "Fixpoint reached, bootstrap succeeded."
 git commit -m "release $VERSION" -a
 git tag -m "release $VERSION" $TAGVERSION
 
-# for production releases, change the VERSION file into (N+1)+dev0; for example,
+# for production releases, change the build-aux/ocaml_version.m4 file into (N+1)+dev0; for example,
 #   4.08.0 => 4.08.1+dev0
 # for testing candidates, use N+dev(D+2) instead; for example,
 #   4.07.0+rc2 => 4.07.0+dev10-2018-06-26
 # Revert ocaml-variants.opam to its "trunk" version.
 make -B configure
-git commit -m "increment version number after tagging $VERSION" VERSION configure ocaml-variants.opam
+git commit -m "increment version number after tagging $VERSION" build-aux/ocaml_version.m4 VERSION configure ocaml-variants.opam
 git push
 git push --tags
 ```
@@ -155,7 +154,7 @@ git push --tags
 
 This needs to be more tested, tread with care.
 ```
-# at this point, the VERSION file contains N+devD
+# at this point, the build-aux/ocaml_version.m4 file contains N+devD
 # increment it into N+dev(D+1); for example,
 #   4.07.0+dev0-2018-06-19 => 4.07.0+dev1-2018-06-26
 # Rename the "Working version" header in Changes
@@ -164,7 +163,7 @@ make -B configure
 git commit -a -m "last commit before branching $BRANCH"
 git branch $BRANCH
 
-# update VERSION with the new future branch,
+# update build-aux/ocaml_version.m4 with the new future branch,
 #   4.07.0+dev1-2018-06-26 => 4.08.0+dev0-2018-06-30
 # Update ocaml-variants.opam with new version.
 make -B configure
@@ -273,6 +272,7 @@ cd $WORKTREE
 TMPDIR=/tmp/ocaml-release
 git checkout $TAGVERSION
 git checkout-index -a -f --prefix=$TMPDIR/ocaml-$VERSION/
+git switch $BRANCH
 cd $TMPDIR
 $TAR -c --owner 0 --group 0 -f ocaml-$VERSION.tar ocaml-$VERSION
 gzip -9 <ocaml-$VERSION.tar >ocaml-$VERSION.tar.gz
@@ -345,8 +345,6 @@ it was a release candidate.
 ```
 cd $WORKTREE
 make
-make install
-export PATH="$INSTDIR/bin:$PATH"
 cd manual
 make clean
 make

diff --git a/release-info/introduction.md b/release-info/introduction.md
new file mode 100644 (file)
index 0000000..b249960
--- /dev/null
+++ b/release-info/introduction.md
@@ -0,0 +1,164 @@
+# What does an OCaml version mean?
+
+OCaml releases follow a linux-like scheme for their version string. The
+OCaml version string consists in three numbers, optionally followed by
+either a prerelease or development tag
+(`%i.%i.%i[~alpha%i|~beta%i|~rc%i|+%s]`). For example, `4.14.1`,
+5.1.0~alpha2 and 5.3.0+dev0-2023-12-22 are valid OCaml versions.
+
+- The first version number (`4` in `4.14.1`) is the major version of OCaml.
+  This version number is updated when major new features are added to the OCaml
+  language. For instance, OCaml 5 added shared memory parallelism and effect
+  handlers and OCaml 4 introduced GADTs (Generalised Abstract Data Types).
+
+- The second version number (`14` in` 4.14.1`) is the minor version of OCaml.
+  This number is increased for every new release of OCaml. In particular, a new
+  minor version of OCaml can contain breaking changes. However, we strive to
+  maintain backward compatibility as much as possible.
+
+- The last number (`1` in `4.14.1`) is the bugfix number.
+  Updating to the latest bugfix release is always safe, those bugfix versions
+  are meant to be completely backward compatible and only contain important or
+  very safe bug fixes.
+
+- The prerelease tag `~alpha%i`, `~beta%i`, `~rc%i` (`~alpha2` in
+  `5.1.0~alpha2`) describes a prerelease version of the compiler that is
+  currently being tested. See [below](#prerelease-versions) for
+  a more thorough explanation.
+
+- The development tag `+tag` indicates a development or experimental version of
+  the compiler. `+dev0-2023-12-22` in `5.3.0+dev0-2023-12-22` is an example of the
+  tags of the form `+dev%i-%date` used by the compiler for its development
+  versions.
+
+
+# When are new versions released?
+
+Since OCaml 4.03, we are using a time-based release schedule:
+a new minor version of OCaml is released every six months.
+
+For instance, at the date of writing, the next planned releases of OCaml are:
+
+- OCaml 5.3: around October 2024
+- OCaml 5.4: around April 2025
+
+The timing is approximate, as we often delay a release to ensure quality when
+unforeseen issues come up. In consequence, releases are often late, typically by
+up to two months. There is a prospective release calendar available at
+[calendar.md](calendar.md)
+
+We may release bugfix releases at any time.
+
+
+# What happens between minor releases?
+
+## Feature freeze
+
+All PRs go to the development branch of the compiler, called 'trunk'. (This was
+the standard name in the SVN era, and it remains more descriptive than 'main'.)
+
+Three months before a new release, that is, at the half of the time window
+between two releases, we create a separate branch for the next version of
+OCaml. The intention (there are always exceptions) is that the release should
+correspond to the state of 'trunk' at the time this branch was created, but we
+wait three more months for quality analysis, to get feedback and integrate
+bugfixes.
+
+We do not integrate new features in the release branch, to avoid unplanned
+regressions coming from last-minute changes. Only bugfixes and documentation
+improvements go to the release branch -- by cherry-picking them from 'trunk'.
+
+We do not have the resources to maintain more than one dev branch, one prelease
+branch, and [one exceptional LTS branch](#Exceptional-LTS-versions).
+
+### Example
+
+5.1.0 was released in September 2023, and the feature freeze for 5.2 happened on
+December 2023, for a 5.2 release planned around April 2024.
+
+## Prerelease versions
+
+Once a new version branch has been created, and the feature set has been
+stabilised, we start publishing prerelease versions of this branch.
+
+For instance, after branching OCaml 5.2, we start publishing alpha versions: for
+instance `5.2.0~alpha1`, then `5.2.0~alpha2`.
+
+Once core development tools have been ported to work on those alpha versions, we
+switch to releasing beta versions (e.g. `5.2.0~beta1`).
+
+At last, just before the official release, we publish a release candidate (e.g.
+`5.2.0~rc1`) to have one last check with the hopefully final version
+of the branch.
+
+Our idea for alpha, beta, and rc releases is to have releases with increasing
+stability guarantees, and which can be tested by an increasingly wider audience:
+
+- `alpha` releases:
+   * nearly stable internal compiler-libs API, only API fixes accepted
+   * no new features, problematic features might be removed at this stage
+   * bug fixes very welcome
+   * documentation PRs still accepted
+   * intended for core development tools (merlin, ppxlib, dune) to unlock the rest
+     of the opam ecosystem
+
+- `beta` releases:
+  * stable internal compiler-libs API
+  * stable set of features
+  * bug fixes very welcome
+  * documentation PRs still accepted
+  * intended for early adopters: opam library authors should be able to test their
+    libraries at this point.
+
+- `rc` releases:
+  * stable internal compiler-libs API
+  * stable feature sets
+  * only emergency bug fixes
+  * documentation PRs postponed to after the release
+  * intended for wide testing (and detecting deployment or production issues among
+    large private code base)
+
+Starting from the first alpha release, there is a small team effort to try to
+build and test every package available on opam with the new release, with the
+bulk of the work done by Kate Deplaix. This has been incredibly useful in the
+past to catch bugs or usability regressions.
+
+## Bugfix versions
+
+Bugfix versions are published if we discover issues that significantly impede
+the use of the initially released version. In that situation, it is not uncommon
+that we backport safe bug fixes that were integrated in the trunk after the
+release.
+
+Most bugfix releases are M.m.1 releases that happened one or two months after
+the M.m.0 minor release, to fix an important issue that was not found during
+prerelease testing.
+
+Users are strongly encouraged to switch to the last bugfix versions as soon as
+possible. We make this easy by doing our best to avoid any regression there.
+
+
+# Exceptional LTS versions
+
+Switching from OCaml 4 to OCaml 5 required a full rewrite of the OCaml runtime.
+This has negatively affected the stability of the releases of OCaml 5 in term of
+
+- supported architectures
+- supported OS
+- performance stability
+- number of runtime bugs
+
+To keep a stable version easily available, we are exceptionally maintaining
+OCaml 4.14 as a long term support version of OCaml. New bugfix versions of OCaml
+4.14 will be released in the future until OCaml 5 is considered mature enough.
+
+User feedback is welcome on which fixes from OCaml 5 should be also included in
+4.14.
+
+Once OCaml 5 is stabilized, this extended support of OCaml 4.14  will stop.
+Currently, we expect to support OCaml 4.14 until OCaml 5.4 (around April 2025).
+
+
+# How are new versions of OCaml released?
+
+The release process is documented in [the release howto](https://github.com/ocaml/ocaml/release-info/howto.md)

diff --git a/runtime/HACKING.adoc b/runtime/HACKING.adoc
index 0cac8f131d99bf165d8d3c4aab683633b71c0eec..5d01411260a24dfb33d928c424dd14fce8a27fdf 100644 (file)
--- a/runtime/HACKING.adoc
+++ b/runtime/HACKING.adoc
@@ -151,8 +151,8 @@ TODO: it would be nice to migrate some information here.
 === ThreadSanitizer ===
 
 You can instrument the runtime to detect data races in it, by adding
-`-fsanitize=thread` to the `CFLAGS`. It will make the compiler build rather
-slow.
+`-fsanitize=thread` to both `CFLAGS` and `LDFLAGS`. It will however make the
+compiler build rather slow.
 
 Note that this is different from passing `--enable-tsan` to the configure
 script. `--enable-tsan` not only instruments the runtime, but also the code

diff --git a/runtime/addrmap.c b/runtime/addrmap.c
index da6677335bcefcdd3408e6d31206c6fe3049d7f0..9a3ef7bca1bc57700f2d0e36e7d97e581b8cda26 100644 (file)
--- a/runtime/addrmap.c
+++ b/runtime/addrmap.c
@@ -37,12 +37,10 @@ Caml_inline uintnat pos_next(struct addrmap* t, uintnat pos)
 
 int caml_addrmap_contains(struct addrmap* t, value key)
 {
-  uintnat pos, i;
-
   CAMLassert(Is_block(key));
   if (!t->entries) return 0;
 
-  for (i = 0, pos = pos_initial(t, key);
+  for (uintnat i = 0, pos = pos_initial(t, key);
        i < MAX_CHAIN;
        i++, pos = pos_next(t, pos)) {
     if (t->entries[pos].key == ADDRMAP_INVALID_KEY) break;
@@ -53,12 +51,10 @@ int caml_addrmap_contains(struct addrmap* t, value key)
 
 value caml_addrmap_lookup(struct addrmap* t, value key)
 {
-  uintnat pos;
-
   CAMLassert(Is_block(key));
   CAMLassert(t->entries);
 
-  for (pos = pos_initial(t, key); ; pos = pos_next(t, pos)) {
+  for (uintnat pos = pos_initial(t, key); ; pos = pos_next(t, pos)) {
     CAMLassert(t->entries[pos].key != ADDRMAP_INVALID_KEY);
     if (t->entries[pos].key == key)
       return t->entries[pos].value;
@@ -67,11 +63,10 @@ value caml_addrmap_lookup(struct addrmap* t, value key)
 
 static void addrmap_alloc(struct addrmap* t, uintnat sz)
 {
-  uintnat i;
   CAMLassert(Is_power_of_2(sz));
   t->entries = caml_stat_alloc(sizeof(struct addrmap_entry) * sz);
   t->size = sz;
-  for (i = 0; i < sz; i++) {
+  for (uintnat i = 0; i < sz; i++) {
     t->entries[i].key = ADDRMAP_INVALID_KEY;
     t->entries[i].value = ADDRMAP_NOT_PRESENT;
   }
@@ -91,13 +86,12 @@ void caml_addrmap_clear(struct addrmap* t) {
 
 
 value* caml_addrmap_insert_pos(struct addrmap* t, value key) {
-  uintnat i, pos;
   CAMLassert(Is_block(key));
   if (!t->entries) {
     /* first call, initialise table with a small initial size */
     addrmap_alloc(t, 256);
   }
-  for (i = 0, pos = pos_initial(t, key);
+  for (uintnat i = 0, pos = pos_initial(t, key);
        i < MAX_CHAIN;
        i++,   pos = pos_next(t, pos)) {
     if (t->entries[pos].key == ADDRMAP_INVALID_KEY) {
@@ -112,7 +106,7 @@ value* caml_addrmap_insert_pos(struct addrmap* t, value key) {
     struct addrmap_entry* old_table = t->entries;
     uintnat old_size = t->size;
     addrmap_alloc(t, old_size * 2);
-    for (i = 0; i < old_size; i++) {
+    for (uintnat i = 0; i < old_size; i++) {
       if (old_table[i].key != ADDRMAP_INVALID_KEY) {
         value* p = caml_addrmap_insert_pos(t, old_table[i].key);
         CAMLassert(*p == ADDRMAP_NOT_PRESENT);
@@ -131,8 +125,7 @@ void caml_addrmap_insert(struct addrmap* t, value k, value v) {
 }
 
 void caml_addrmap_iter(struct addrmap* t, void (*f)(value, value)) {
-  addrmap_iterator i;
-  for (i = caml_addrmap_iterator(t);
+  for (addrmap_iterator i = caml_addrmap_iterator(t);
        caml_addrmap_iter_ok(t, i);
        i = caml_addrmap_next(t, i)) {
     f(caml_addrmap_iter_key(t, i),

diff --git a/runtime/afl.c b/runtime/afl.c
index 9548de6e38e1ec4b381ab1a4ec0ba67d3f91df11..d5673f28fce27fe1ade25e33855d8ab07bfd69e4 100644 (file)
--- a/runtime/afl.c
+++ b/runtime/afl.c
@@ -16,6 +16,7 @@
 
 #define CAML_INTERNALS
 
+#include <string.h>
 #include "caml/config.h"
 #include "caml/memory.h"
 #include "caml/mlvalues.h"

diff --git a/runtime/alloc.c b/runtime/alloc.c
index 3bb2730eab78b4b28912239e6b8ba717d22931eb..d7a08a8e48c0995122dd94ee1e05eacd0b1e2690 100644 (file)
--- a/runtime/alloc.c
+++ b/runtime/alloc.c
@@ -33,7 +33,6 @@
 CAMLexport value caml_alloc (mlsize_t wosize, tag_t tag)
 {
   value result;
-  mlsize_t i;
 
   CAMLassert (tag < 256);
   CAMLassert (tag != Infix_tag);
@@ -44,13 +43,13 @@ CAMLexport value caml_alloc (mlsize_t wosize, tag_t tag)
       Caml_check_caml_state();
       Alloc_small (result, wosize, tag, Alloc_small_enter_GC);
       if (tag < No_scan_tag){
-        for (i = 0; i < wosize; i++) Field (result, i) = Val_unit;
+        for (mlsize_t i = 0; i < wosize; i++) Field (result, i) = Val_unit;
       }
     }
   } else {
     result = caml_alloc_shr (wosize, tag);
     if (tag < No_scan_tag) {
-      for (i = 0; i < wosize; i++) Field (result, i) = Val_unit;
+      for (mlsize_t i = 0; i < wosize; i++) Field (result, i) = Val_unit;
     }
     result = caml_check_urgent_gc (result);
   }
@@ -78,13 +77,13 @@ CAMLexport value caml_alloc_shr_check_gc (mlsize_t wosize, tag_t tag)
 /* Copy the values to be preserved to a different array.
    The original vals array never escapes, generating better code in
    the fast path. */
-#define Enter_gc_preserve_vals(dom_st, wosize) do {         \
-    CAMLparam0();                                           \
-    CAMLlocalN(vals_copy, (wosize));                        \
-    for (i = 0; i < (wosize); i++) vals_copy[i] = vals[i];  \
-    Alloc_small_enter_GC(dom_st, wosize);                   \
-    for (i = 0; i < (wosize); i++) vals[i] = vals_copy[i];  \
-    CAMLdrop;                                               \
+#define Enter_gc_preserve_vals(dom_st, wosize) do {                     \
+    CAMLparam0();                                                       \
+    CAMLlocalN(vals_copy, (wosize));                                    \
+    for (mlsize_t j = 0; j < (wosize); j++) vals_copy[j] = vals[j];     \
+    Alloc_small_enter_GC(dom_st, wosize);                               \
+    for (mlsize_t j = 0; j < (wosize); j++) vals[j] = vals_copy[j];     \
+    CAMLdrop;                                                           \
   } while (0)
 
 /* This has to be done with a macro, rather than an inline function, since
@@ -95,12 +94,11 @@ CAMLexport value caml_alloc_shr_check_gc (mlsize_t wosize, tag_t tag)
   Caml_check_caml_state();                              \
   value v;                                              \
   value vals[wosize] = {__VA_ARGS__};                   \
-  mlsize_t i;                                           \
   CAMLassert ((tag) < 256);                             \
                                                         \
   Alloc_small(v, wosize, tag, Enter_gc_preserve_vals);  \
-  for (i = 0; i < (wosize); i++) {                      \
-    Field(v, i) = vals[i];                              \
+  for (mlsize_t j = 0; j < (wosize); j++) {             \
+    Field(v, j) = vals[j];                              \
   }                                                     \
   return v;                                             \
 }
@@ -225,13 +223,13 @@ CAMLexport value caml_alloc_array(value (*funct)(char const *),
                                   char const * const* arr)
 {
   CAMLparam0 ();
-  mlsize_t nbr, n;
+  mlsize_t nbr;
   CAMLlocal2 (v, result);
 
   nbr = 0;
   while (arr[nbr] != 0) nbr++;
   result = caml_alloc (nbr, 0);
-  for (n = 0; n < nbr; n++) {
+  for (mlsize_t n = 0; n < nbr; n++) {
     /* The two statements below must be separate because of evaluation
        order (don't take the address &Field(result, n) before
        calling funct, which may cause a GC and move result). */
@@ -248,7 +246,7 @@ value caml_alloc_float_array(mlsize_t len)
   Caml_check_caml_state();
   mlsize_t wosize = len * Double_wosize;
   value result;
-  /* For consistency with [caml_make_vect], which can't tell whether it should
+  /* For consistency with [caml_array_make], which can't tell whether it should
      create a float array or not when the size is zero, the tag is set to
      zero when the size is zero. */
   if (wosize <= Max_young_wosize){
@@ -322,7 +320,7 @@ CAMLprim value caml_alloc_dummy_infix(value vsize, value voffset)
 
 CAMLprim value caml_update_dummy(value dummy, value newval)
 {
-  mlsize_t size, i;
+  mlsize_t size;
   tag_t tag;
 
   tag = Tag_val (newval);
@@ -342,7 +340,7 @@ CAMLprim value caml_update_dummy(value dummy, value newval)
     CAMLassert (Tag_val(dummy) != Infix_tag);
     Unsafe_store_tag_val(dummy, Double_array_tag);
     size = Wosize_val (newval) / Double_wosize;
-    for (i = 0; i < size; i++) {
+    for (mlsize_t i = 0; i < size; i++) {
       Store_double_flat_field (dummy, i, Double_flat_field (newval, i));
     }
   } else if (tag == Infix_tag) {
@@ -357,7 +355,7 @@ CAMLprim value caml_update_dummy(value dummy, value newval)
        from [clos] to [dummy], because the value being overwritten is
        an integer, and the new "value" is a pointer outside the minor
        heap. */
-    for (i = 0; i < size; i++) {
+    for (mlsize_t i = 0; i < size; i++) {
       caml_modify (&Field(dummy, i), Field(clos, i));
     }
   } else {
@@ -368,7 +366,7 @@ CAMLprim value caml_update_dummy(value dummy, value newval)
     CAMLassert (size == Wosize_val(dummy));
     /* See comment above why this is safe even if [tag == Closure_tag]
        and some of the "values" being copied are actually code pointers. */
-    for (i = 0; i < size; i++){
+    for (mlsize_t i = 0; i < size; i++){
       caml_modify (&Field(dummy, i), Field(newval, i));
     }
   }

diff --git a/runtime/amd64.S b/runtime/amd64.S
index 49c712b16753c3c16261c7e1ab78e5742deedeb4..c646f944df22c6f6c971fe3b1a35f85cd6a06575 100644 (file)
--- a/runtime/amd64.S
+++ b/runtime/amd64.S
@@ -51,7 +51,7 @@
         .align FUNCTION_ALIGN; \
         name:
 
-#else
+#else /* Unix-like operating systems using ELF binaries */
 
 #define LBL(x) .L##x
 #define G(r) r
@@ -81,29 +81,7 @@
 #define ENDFUNCTION(name)
 #endif
 
-#ifdef ASM_CFI_SUPPORTED
-#define CFI_STARTPROC .cfi_startproc
-#define CFI_ENDPROC .cfi_endproc
-#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
-#define CFI_OFFSET(r, n) .cfi_offset r, n
-#define CFI_DEF_CFA_OFFSET(n) .cfi_def_cfa_offset n
-#define CFI_DEF_CFA_REGISTER(r) .cfi_def_cfa_register r
-#define CFI_SAME_VALUE(r) .cfi_same_value r
-#define CFI_SIGNAL_FRAME .cfi_signal_frame
-#define CFI_REMEMBER_STATE .cfi_remember_state
-#define CFI_RESTORE_STATE .cfi_restore_state
-#else
-#define CFI_STARTPROC
-#define CFI_ENDPROC
-#define CFI_ADJUST(n)
-#define CFI_OFFSET(r, n)
-#define CFI_DEF_CFA_OFFSET(n)
-#define CFI_DEF_CFA_REGISTER(r)
-#define CFI_SAME_VALUE(r)
-#define CFI_SIGNAL_FRAME
-#define CFI_REMEMBER_STATE
-#define CFI_RESTORE_STATE
-#endif
+#include "../runtime/caml/asm.h"
 
 #ifdef WITH_FRAME_POINTERS
 #define FRAME_POINTER_SIZE   8
@@ -165,12 +143,7 @@
 /* DWARF */
 /******************************************************************************/
 
-/* These constants are taken from:
-
-     DWARF Debugging Information Format, Version 3
-     http://dwarfstd.org/doc/Dwarf3.pdf
-
-   with the amd64-specific register numbers coming from
+/* These amd64-specific register numbers are taken from
    Fig. 3.36 ("DWARF Register Number Mapping") of:
 
      System V Application Binary Interface
@@ -178,13 +151,9 @@
      Version 1.0
      https://github.com/hjl-tools/x86-psABI/wiki/x86-64-psABI-1.0.pdf */
 
-#define DW_CFA_def_cfa_expression 0x0f
 #define DW_REG_rbx                3
 #define DW_REG_rsp                7
 #define DW_REG_r13                13
-#define DW_OP_breg                0x70
-#define DW_OP_deref               0x06
-#define DW_OP_plus_uconst         0x23
 
 /******************************************************************************/
 /* Access to the current domain state block. */
@@ -211,16 +180,6 @@
         leaq    G(label)(%rip), dst
 #endif
 
-/* Push the current exception handler. Clobbers %r11 */
-#define PUSH_EXN_HANDLER \
-        movq    Caml_state(exn_handler), %r11; \
-        pushq   %r11; CFI_ADJUST(8);
-
-/* Pop the current exception handler. Undoes PUSH_EXN_HANDLER. Clobbers %r11 */
-#define POP_EXN_HANDLER \
-        leaq    Caml_state(exn_handler), %r11; \
-        popq    (%r11); CFI_ADJUST(-8)
-
 /******************************************************************************/
 /* Stack switching operations */
 /******************************************************************************/
@@ -260,11 +219,13 @@
         CFI_RESTORE_STATE
 
 /* Load Caml_state->exn_handler into %rsp and restores prior exn_handler.
-   Clobbers %r10 and %r11. */
+   Clobbers %r11. */
 #define RESTORE_EXN_HANDLER_OCAML              \
         movq    Caml_state(exn_handler), %rsp; \
         CFI_DEF_CFA_OFFSET(16);                \
-        POP_EXN_HANDLER
+        leaq    Caml_state(exn_handler), %r11; \
+        popq    (%r11); CFI_ADJUST(-8)
+
 
 /* When ThreadSanitizer instrumentation is enabled, the code must call
    the C functions __tsan_func_entry and __tsan_func_exit to signal
@@ -1123,6 +1084,7 @@ LBL(do_perform):
         TSAN_RESTORE_CALLER_REGS
         LEAVE_FUNCTION
 #endif
+        movq    %rdi, 8(%rbx) /* Set the last fiber field in the continuation */
         movq    Stack_handler(%rsi), %r11  /* %r11 := old stack -> handler */
         movq    Handler_parent(%r11), %r10 /* %r10 := parent stack */
         cmpq    $0, %r10                   /* parent is NULL? */
@@ -1386,7 +1348,7 @@ G(caml_negf_mask):
 G(caml_absf_mask):
         .quad   0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF
 
-#if defined(SYS_linux)
+#if defined(SYS_linux) || defined(SYS_freebsd)
     /* Mark stack as non-executable, PR#4564 */
         .section .note.GNU-stack,"",%progbits
 #endif

diff --git a/runtime/amd64nt.asm b/runtime/amd64nt.asm
index f7ac3082188f4f7f793143c2694b1d5285e9c6f7..efc6a5aa0e51bdd9bfaf8fe3ece1777b1c25910a 100644 (file)
--- a/runtime/amd64nt.asm
+++ b/runtime/amd64nt.asm
@@ -26,6 +26,12 @@
         EXTRN  caml_program: NEAR
         EXTRN  caml_array_bound_error_asm: NEAR
         EXTRN  caml_stash_backtrace: NEAR
+        EXTRN  caml_try_realloc_stack: NEAR
+        EXTRN  caml_try_realloc_stack: NEAR
+        EXTRN  caml_exn_Stack_overflow: NEAR
+        EXTRN  caml_raise_unhandled_effect: NEAR
+        EXTRN  caml_raise_continuation_already_resumed: NEAR
+        EXTRN  caml_free_stack: NEAR
 
 ; Load caml/domain_state.tbl (via domain_state.inc, to remove C-style comments)
         domain_curr_field = 0
@@ -47,6 +53,162 @@ Caml_state MACRO field:REQ
         EXITM @CatStr(<[r14+>, %(domain_field_caml_&field), <*8]>)
 ENDM
 
+SAVE_ALL_REGS MACRO
+    ; Save young_ptr
+        mov     Caml_state(young_ptr), r15
+    ; Now, use r15 to point to the gc_regs bucket
+    ; We save r11 first to allow it to be scratch
+        mov     r15, Caml_state(gc_regs_buckets)
+        mov    qword ptr [r15 + 11*8], r11
+        mov     r11,qword ptr [r15] ; next ptr
+        mov     Caml_state(gc_regs_buckets), r11
+        mov    qword ptr [r15 + 0*8], rax
+        mov    qword ptr [r15 + 1*8], rbx
+        mov    qword ptr [r15 + 2*8], rdi
+        mov    qword ptr [r15 + 3*8], rsi
+        mov    qword ptr [r15 + 4*8], rdx
+        mov    qword ptr [r15 + 5*8], rcx
+        mov    qword ptr [r15 + 6*8], r8
+        mov    qword ptr [r15 + 7*8], r9
+        mov    qword ptr [r15 + 8*8], r12
+        mov    qword ptr [r15 + 9*8], r13
+        mov    qword ptr [r15 + 10*8], r10
+              ;qword ptr [r15 + 11*8] contains r11 already
+        mov    qword ptr [r15 + 12*8], rbp
+        movsd   mmword ptr [r15 + (0+13)*8], xmm0
+        movsd   mmword ptr [r15 + (1+13)*8], xmm1
+        movsd   mmword ptr [r15 + (2+13)*8], xmm2
+        movsd   mmword ptr [r15 + (3+13)*8], xmm3
+        movsd   mmword ptr [r15 + (4+13)*8], xmm4
+        movsd   mmword ptr [r15 + (5+13)*8], xmm5
+        movsd   mmword ptr [r15 + (6+13)*8], xmm6
+        movsd   mmword ptr [r15 + (7+13)*8], xmm7
+        movsd   mmword ptr [r15 + (8+13)*8], xmm8
+        movsd   mmword ptr [r15 + (9+13)*8], xmm9
+        movsd   mmword ptr [r15 + (10+13)*8], xmm10
+        movsd   mmword ptr [r15 + (11+13)*8], xmm11
+        movsd   mmword ptr [r15 + (12+13)*8], xmm12
+        movsd   mmword ptr [r15 + (13+13)*8], xmm13
+        movsd   mmword ptr [r15 + (14+13)*8], xmm14
+        movsd   mmword ptr [r15 + (15+13)*8], xmm15
+ENDM
+
+RESTORE_ALL_REGS MACRO
+    ; Restore rax, freeing up the next ptr slot
+        mov     rax,qword ptr [r15 + 0*8]
+        mov     r11, Caml_state(gc_regs_buckets)
+        mov     qword ptr [r15], r11 ; next ptr
+        mov     Caml_state(gc_regs_buckets), r15
+    ; above:    rax,qword ptr [r15 + 0*8]
+        mov     rbx,qword ptr [r15 + 1*8]
+        mov     rdi,qword ptr [r15 + 2*8]
+        mov     rsi,qword ptr [r15 + 3*8]
+        mov     rdx,qword ptr [r15 + 4*8]
+        mov     rcx,qword ptr [r15 + 5*8]
+        mov     r8,qword ptr [r15 + 6*8]
+        mov     r9,qword ptr [r15 + 7*8]
+        mov     r12,qword ptr [r15 + 8*8]
+        mov     r13,qword ptr [r15 + 9*8]
+        mov     r10,qword ptr [r15 + 10*8]
+        mov     r11,qword ptr [r15 + 11*8]
+        mov     rbp,qword ptr [r15 + 12*8]
+        movsd   xmm0, mmword ptr [r15 + (0+13)*8]
+        movsd   xmm1, mmword ptr [r15 + (1+13)*8]
+        movsd   xmm2, mmword ptr [r15 + (2+13)*8]
+        movsd   xmm3, mmword ptr [r15 + (3+13)*8]
+        movsd   xmm4, mmword ptr [r15 + (4+13)*8]
+        movsd   xmm5, mmword ptr [r15 + (5+13)*8]
+        movsd   xmm6, mmword ptr [r15 + (6+13)*8]
+        movsd   xmm7, mmword ptr [r15 + (7+13)*8]
+        movsd   xmm8, mmword ptr [r15 + (8+13)*8]
+        movsd   xmm9, mmword ptr [r15 + (9+13)*8]
+        movsd   xmm10, mmword ptr [r15 + (10+13)*8]
+        movsd   xmm11, mmword ptr [r15 + (11+13)*8]
+        movsd   xmm12, mmword ptr [r15 + (12+13)*8]
+        movsd   xmm13, mmword ptr [r15 + (13+13)*8]
+        movsd   xmm14, mmword ptr [r15 + (14+13)*8]
+        movsd   xmm15, mmword ptr [r15 + (15+13)*8]
+        mov     r15, Caml_state(young_ptr)
+ENDM
+
+SWITCH_OCAML_TO_C MACRO
+    ; Fill in Caml_state->current_stack->sp
+        mov     r10, Caml_state(current_stack)
+        mov    qword ptr [r10], rsp
+    ; Fill in Caml_state->c_stack
+        mov     r11, Caml_state(c_stack)
+        mov    qword ptr [r11 + 40], rsp
+        mov    qword ptr [r11 + 32], r10
+    ; Switch to C stack
+        mov     rsp, qword ptr r11
+ENDM
+
+SWITCH_C_TO_OCAML MACRO
+        mov     rsp,qword ptr [rsp+40]
+ENDM
+
+; Callee-save regs are rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15
+
+PUSH_CALLEE_SAVE_REGS MACRO
+        push    rbx
+        push    rbp
+        push    rsi
+        push    rdi
+        push    r12
+        push    r13
+        push    r14
+        push    r15
+        sub     rsp, 10*16       ; stack 16-aligned + 10 saved xmm regs
+        movupd  xmmword ptr [rsp + 0*16], xmm6
+        movupd  xmmword ptr [rsp + 1*16], xmm7
+        movupd  xmmword ptr [rsp + 2*16], xmm8
+        movupd  xmmword ptr [rsp + 3*16], xmm9
+        movupd  xmmword ptr [rsp + 4*16], xmm10
+        movupd  xmmword ptr [rsp + 5*16], xmm11
+        movupd  xmmword ptr [rsp + 6*16], xmm12
+        movupd  xmmword ptr [rsp + 7*16], xmm13
+        movupd  xmmword ptr [rsp + 8*16], xmm14
+        movupd  xmmword ptr [rsp + 9*16], xmm15
+ENDM
+
+POP_CALLEE_SAVE_REGS MACRO
+        movupd  xmm6, xmmword ptr [rsp + 0*16]
+        movupd  xmm7, xmmword ptr [rsp + 1*16]
+        movupd  xmm8, xmmword ptr [rsp + 2*16]
+        movupd  xmm9, xmmword ptr [rsp + 3*16]
+        movupd  xmm10, xmmword ptr [rsp + 4*16]
+        movupd  xmm11, xmmword ptr [rsp + 5*16]
+        movupd  xmm12, xmmword ptr [rsp + 6*16]
+        movupd  xmm13, xmmword ptr [rsp + 7*16]
+        movupd  xmm14, xmmword ptr [rsp + 8*16]
+        movupd  xmm15, xmmword ptr [rsp + 9*16]
+        add     rsp, 10*16
+        pop     r15
+        pop     r14
+        pop     r13
+        pop     r12
+        pop     rdi
+        pop     rsi
+        pop     rbp
+        pop     rbx
+ENDM
+
+RESTORE_EXN_HANDLER_OCAML MACRO
+        mov     rsp, Caml_state(exn_handler)
+        lea     r11, Caml_state(exn_handler)
+        pop     qword ptr [r11]
+ENDM
+
+SWITCH_OCAML_STACKS MACRO
+        mov     qword ptr [rsi], rsp
+        mov     r12, Caml_state(exn_handler)
+        mov     qword ptr [rsi+8], r12
+        mov     Caml_state(current_stack), r10
+        mov     rsp,qword ptr [r10]
+        mov     r12,qword ptr [r10+8]
+        mov     Caml_state(exn_handler), r12
+ENDM
+
         .CODE
 
         PUBLIC  caml_system__code_begin
@@ -56,96 +218,40 @@ caml_system__code_begin:
 
 ; Allocation
 
+        PUBLIC  caml_call_realloc_stack
+        ALIGN   4
+caml_call_realloc_stack:
+        SAVE_ALL_REGS
+        mov     rcx,qword ptr [rsp+8]
+        SWITCH_OCAML_TO_C
+        call    caml_try_realloc_stack
+        SWITCH_C_TO_OCAML
+        cmp     rax, 0
+        jz      L104
+        RESTORE_ALL_REGS
+        ret
+L104:
+        RESTORE_ALL_REGS
+        lea     rax, caml_exn_Stack_overflow
+        add     rsp, 16
+        jmp     caml_raise_exn
+
         PUBLIC  caml_call_gc
-        ALIGN   16
+        ALIGN   4
 caml_call_gc:
-    ; Record lowest stack address and return address
-        mov     r11, [rsp]
-        mov     Caml_state(last_return_address), r11
-        lea     r11, [rsp+8]
-        mov     Caml_state(bottom_of_stack), r11
-    ; Touch the stack to trigger a recoverable segfault
-    ; if insufficient space remains
-        sub     rsp, 01000h
-        mov     [rsp], r11
-        add     rsp, 01000h
-    ; Save young_ptr
-        mov     Caml_state(young_ptr), r15
-    ; Build array of registers, save it into Caml_state(gc_regs)
-        push    rbp
-        push    r11
-        push    r10
-        push    r13
-        push    r12
-        push    r9
-        push    r8
-        push    rcx
-        push    rdx
-        push    rsi
-        push    rdi
-        push    rbx
-        push    rax
-        mov     Caml_state(gc_regs), rsp
-    ; Save floating-point registers
-        sub     rsp, 16*8
-        movsd   QWORD PTR [rsp + 0*8], xmm0
-        movsd   QWORD PTR [rsp + 1*8], xmm1
-        movsd   QWORD PTR [rsp + 2*8], xmm2
-        movsd   QWORD PTR [rsp + 3*8], xmm3
-        movsd   QWORD PTR [rsp + 4*8], xmm4
-        movsd   QWORD PTR [rsp + 5*8], xmm5
-        movsd   QWORD PTR [rsp + 6*8], xmm6
-        movsd   QWORD PTR [rsp + 7*8], xmm7
-        movsd   QWORD PTR [rsp + 8*8], xmm8
-        movsd   QWORD PTR [rsp + 9*8], xmm9
-        movsd   QWORD PTR [rsp + 10*8], xmm10
-        movsd   QWORD PTR [rsp + 11*8], xmm11
-        movsd   QWORD PTR [rsp + 12*8], xmm12
-        movsd   QWORD PTR [rsp + 13*8], xmm13
-        movsd   QWORD PTR [rsp + 14*8], xmm14
-        movsd   QWORD PTR [rsp + 15*8], xmm15
+        SAVE_ALL_REGS
+        mov     Caml_state(gc_regs), r15
     ; Call the garbage collector
-        sub rsp, 32      ; PR#5008: bottom 32 bytes are reserved for callee
-        call caml_garbage_collection
-        add rsp, 32      ; PR#5008
-    ; Restore all regs used by the code generator
-        movsd   xmm0, QWORD PTR [rsp + 0*8]
-        movsd   xmm1, QWORD PTR [rsp + 1*8]
-        movsd   xmm2, QWORD PTR [rsp + 2*8]
-        movsd   xmm3, QWORD PTR [rsp + 3*8]
-        movsd   xmm4, QWORD PTR [rsp + 4*8]
-        movsd   xmm5, QWORD PTR [rsp + 5*8]
-        movsd   xmm6, QWORD PTR [rsp + 6*8]
-        movsd   xmm7, QWORD PTR [rsp + 7*8]
-        movsd   xmm8, QWORD PTR [rsp + 8*8]
-        movsd   xmm9, QWORD PTR [rsp + 9*8]
-        movsd   xmm10, QWORD PTR [rsp + 10*8]
-        movsd   xmm11, QWORD PTR [rsp + 11*8]
-        movsd   xmm12, QWORD PTR [rsp + 12*8]
-        movsd   xmm13, QWORD PTR [rsp + 13*8]
-        movsd   xmm14, QWORD PTR [rsp + 14*8]
-        movsd   xmm15, QWORD PTR [rsp + 15*8]
-        add     rsp, 16*8
-        pop     rax
-        pop     rbx
-        pop     rdi
-        pop     rsi
-        pop     rdx
-        pop     rcx
-        pop     r8
-        pop     r9
-        pop     r12
-        pop     r13
-        pop     r10
-        pop     r11
-        pop     rbp
-    ; Restore Caml_state(young_ptr)
-        mov     r15, Caml_state(young_ptr)
+        SWITCH_OCAML_TO_C
+        call    caml_garbage_collection
+        SWITCH_C_TO_OCAML
+        mov     r15, Caml_state(gc_regs)
+        RESTORE_ALL_REGS
     ; Return to caller
         ret
 
         PUBLIC  caml_alloc1
-        ALIGN   16
+        ALIGN   4
 caml_alloc1:
         sub     r15, 16
         cmp     r15, Caml_state(young_limit)
@@ -153,7 +259,7 @@ caml_alloc1:
         ret
 
         PUBLIC  caml_alloc2
-        ALIGN   16
+        ALIGN   4
 caml_alloc2:
         sub     r15, 24
         cmp     r15, Caml_state(young_limit)
@@ -161,7 +267,7 @@ caml_alloc2:
         ret
 
         PUBLIC  caml_alloc3
-        ALIGN   16
+        ALIGN   4
 caml_alloc3:
         sub     r15, 32
         cmp     r15, Caml_state(young_limit)
@@ -169,7 +275,7 @@ caml_alloc3:
         ret
 
         PUBLIC  caml_allocN
-        ALIGN   16
+        ALIGN   4
 caml_allocN:
         cmp     r15, Caml_state(young_limit)
         jb      caml_call_gc
@@ -177,281 +283,399 @@ caml_allocN:
 
 ; Call a C function from OCaml
 
+; Update [young_limit] when returning from non-noalloc extern calls.
+; Here is C code that can be used to generate RET_FROM_C_CALL for a
+; new back-end.
+
+;   #include <stdatomic.h>
+;   #include <stdint.h>
+
+;   typedef struct { _Atomic(uint64_t) young_limit;
+;                    _Bool action_pending; } caml_domain_state;
+
+;   void ret_from_c_call(caml_domain_state *dom_st)
+;   {
+;     if (__builtin_expect(dom_st->action_pending, 0))
+;       atomic_store_explicit(&dom_st->young_limit, (uint64_t)-1,
+;                             memory_order_relaxed);
+;   }
+
+RET_FROM_C_CALL MACRO
+        LOCAL L1
+        cmp     byte ptr Caml_state(action_pending), 0
+        jne     L1
+        ret
+L1:
+        mov     qword ptr Caml_state(young_limit), -1
+        ret
+ENDM
+
         PUBLIC  caml_c_call
-        ALIGN   16
+        ALIGN   4
 caml_c_call:
-    ; Record lowest stack address and return address
-        pop     r12
-        mov     Caml_state(last_return_address), r12
-        mov     Caml_state(bottom_of_stack), rsp
-    ; Touch the stack to trigger a recoverable segfault
-    ; if insufficient space remains
-        sub     rsp, 01000h
-        mov     [rsp], rax
-        add     rsp, 01000h
+    ; Arguments:
+    ;  C arguments         : rcx, rdx, r8 and r9
+    ;  C function          : rax
+        SWITCH_OCAML_TO_C
     ; Make the alloc ptr available to the C code
         mov     Caml_state(young_ptr), r15
     ; Call the function (address in rax)
         call    rax
-    ; Reload alloc ptr
+    ; Prepare for return to OCaml
         mov     r15, Caml_state(young_ptr)
-    ; Return to caller
-        push    r12
-        ret
+    ; Load OCaml stack and restore global variables
+        SWITCH_C_TO_OCAML
+    ; Return to OCaml caller
+        RET_FROM_C_CALL
+
+        PUBLIC  caml_c_call_stack_args
+        ALIGN 4
+caml_c_call_stack_args:
+    ; Arguments:
+    ;  C arguments         : rcx, rdx, r8 and r9
+    ;    C function          : rax
+    ;    C stack args        : begin=r13 end=r12
+    ; Switch from OCaml to C
+        SWITCH_OCAML_TO_C
+    ; we use rbx (otherwise unused) to enable backtraces
+        mov     rbx, rsp
+    ; Make the alloc ptr available to the C code
+        mov     Caml_state(young_ptr), r15
+    ; Copy arguments from OCaml to C stack
+        add     rsp, 32
+L105:
+        sub     r12, 8
+        cmp     r12,r13
+        jb      L210
+        push    qword ptr [r12]
+        jmp     L105
+L210:
+        sub     rsp, 32
+    ; Call the function (address in %rax)
+        call    rax
+    ; Pop arguments back off the stack
+        mov     rsp, Caml_state(c_stack)
+    ; Prepare for return to OCaml
+        mov     r15, Caml_state(young_ptr)
+    ; Load ocaml stack and restore global variables
+        SWITCH_C_TO_OCAML
+    ; Return to OCaml caller
+        RET_FROM_C_CALL
 
 ; Start the OCaml program
 
         PUBLIC  caml_start_program
-        ALIGN   16
+        ALIGN   4
 caml_start_program:
     ; Save callee-save registers
-        push    rbx
-        push    rbp
-        push    rsi
-        push    rdi
-        push    r12
-        push    r13
-        push    r14
-        push    r15
-        sub     rsp, 8+10*16       ; stack 16-aligned + 10 saved xmm regs
-        movapd  OWORD PTR [rsp + 0*16], xmm6
-        movapd  OWORD PTR [rsp + 1*16], xmm7
-        movapd  OWORD PTR [rsp + 2*16], xmm8
-        movapd  OWORD PTR [rsp + 3*16], xmm9
-        movapd  OWORD PTR [rsp + 4*16], xmm10
-        movapd  OWORD PTR [rsp + 5*16], xmm11
-        movapd  OWORD PTR [rsp + 6*16], xmm12
-        movapd  OWORD PTR [rsp + 7*16], xmm13
-        movapd  OWORD PTR [rsp + 8*16], xmm14
-        movapd  OWORD PTR [rsp + 9*16], xmm15
+        PUSH_CALLEE_SAVE_REGS
     ; First argument (rcx) is Caml_state. Load it in r14
         mov     r14, rcx
     ; Initial entry point is caml_program
         lea     r12, caml_program
     ; Common code for caml_start_program and caml_callback*
 L106:
-    ; Build a callback link
-        sub     rsp, 8  ; stack 16-aligned
-        push    Caml_state(gc_regs)
-        push    Caml_state(last_return_address)
-        push    Caml_state(bottom_of_stack)
-    ; Setup alloc ptr
+    ; Load young_ptr into %r15
         mov     r15, Caml_state(young_ptr)
-    ; Build an exception handler
-        lea     r13, L108
-        push    r13
-        push    Caml_state(exception_pointer)
-        mov     Caml_state(exception_pointer), rsp
-    ; Call the OCaml code
+    ; Build struct c_stack_link on the C stack
+        sub     rsp, 56 ; sizeof struct c_stack_link
+        mov     qword ptr [rsp + 32], 0
+        mov     qword ptr [rsp + 40], 0
+        mov     r10, Caml_state(c_stack)
+        mov     qword ptr [rsp + 48], r10
+        mov     Caml_state(c_stack), rsp
+    ; Load the OCaml stack.
+        mov     r11, Caml_state(current_stack)
+        mov     r10, qword ptr [r11]
+    ; Store the stack pointer to allow DWARF unwind XXX
+        sub     r10, 16
+        mov     qword ptr [r10], rsp ; C_STACK_SP
+    ; Store the gc_regs for callbacks during a GC
+        mov     r11, Caml_state(gc_regs)
+        mov     qword ptr [r10 + 8], r11
+    ; Build a handler for exceptions raised in OCaml on the OCaml stack.
+        sub     r10, 16
+        lea     r11, L108
+        mov     qword ptr [r10 + 8], r11
+    ; link in the previous exn_handler so that copying stacks works
+        mov     r11, Caml_state(exn_handler)
+        mov     qword ptr [r10], r11
+        mov     Caml_state(exn_handler), r10
+    ; Switch stacks and call the OCaml code
+        mov     rsp, r10
         call    r12
 L107:
     ; Pop the exception handler
-        pop     Caml_state(exception_pointer)
-        pop     r12    ; dummy register
+        mov     r11, qword ptr [rsp]
+        mov     Caml_state(exn_handler), r11
+        lea     r10, [rsp+16]
 L109:
+    ; Restore GC regs
+        mov     r11, qword ptr [r10+8]
+        mov     Caml_state(gc_regs), r11
+        add     r10, 16
     ; Update alloc ptr
         mov     Caml_state(young_ptr), r15
-    ; Pop the callback restoring, link the global variables
-        pop     Caml_state(bottom_of_stack)
-        pop     Caml_state(last_return_address)
-        pop     Caml_state(gc_regs)
-        add     rsp, 8
+    ; Return to C stack.
+        mov     r11, Caml_state(current_stack)
+        mov     qword ptr [r11], r10
+        mov     rsp, Caml_state(c_stack)
+    ; Pop the struct c_stack_link
+        mov     r10, qword ptr [rsp+48]
+        mov     Caml_state(c_stack), r10
+        add     rsp, 56
     ; Restore callee-save registers.
-        movapd  xmm6, OWORD PTR [rsp + 0*16]
-        movapd  xmm7, OWORD PTR [rsp + 1*16]
-        movapd  xmm8, OWORD PTR [rsp + 2*16]
-        movapd  xmm9, OWORD PTR [rsp + 3*16]
-        movapd  xmm10, OWORD PTR [rsp + 4*16]
-        movapd  xmm11, OWORD PTR [rsp + 5*16]
-        movapd  xmm12, OWORD PTR [rsp + 6*16]
-        movapd  xmm13, OWORD PTR [rsp + 7*16]
-        movapd  xmm14, OWORD PTR [rsp + 8*16]
-        movapd  xmm15, OWORD PTR [rsp + 9*16]
-        add     rsp, 8+10*16
-        pop     r15
-        pop     r14
-        pop     r13
-        pop     r12
-        pop     rdi
-        pop     rsi
-        pop     rbp
-        pop     rbx
+        POP_CALLEE_SAVE_REGS
     ; Return to caller
         ret
 L108:
     ; Exception handler
     ; Mark the bucket as an exception result and return it
         or      rax, 2
+        ; exn handler already popped here
+        mov     r10, rsp
         jmp     L109
 
 ; Raise an exception from OCaml
 
         PUBLIC  caml_raise_exn
-        ALIGN   16
+        ALIGN   4
 caml_raise_exn:
-        mov     r11, Caml_state(backtrace_active)
-        test    r11, 1
+        test    qword ptr Caml_state(backtrace_active), 1
         jne     L110
-        mov     rsp, Caml_state(exception_pointer) ; Cut stack
-    ; Recover previous exception handler
-        pop     Caml_state(exception_pointer)
-        ret                                        ; Branch to handler
+        RESTORE_EXN_HANDLER_OCAML
+        ret
 L110:
-        mov     r12, rax                           ; Save exception bucket
-        mov     rcx, rax                           ; Arg 1: exception bucket
-        mov     rdx, [rsp]                         ; Arg 2: PC of raise
-        lea     r8, [rsp+8]                        ; Arg 3: SP of raise
-        mov     r9, Caml_state(exception_pointer)  ; Arg 4: SP of handler
-        sub     rsp, 32                            ; Reserve 32 bytes on stack
+        mov     qword ptr Caml_state(backtrace_pos), 0
+L117:
+        mov     r13, rsp             ; Save OCaml stack pointer
+        mov     r12, rax             ; Save exception bucket
+        mov     rsp, Caml_state(c_stack)
+        mov     rcx, rax             ; Arg 1: exception bucket
+        mov     rdx, qword ptr [r13] ; Arg 2: PC of raise
+        lea     r8, [r13+8]          ; Arg 3: SP of raise
+        mov     r9, Caml_state(exn_handler) ; Arg 4: SP of handler
         call    caml_stash_backtrace
-        mov     rax, r12                           ; Recover exception bucket
-        mov     rsp, Caml_state(exception_pointer) ; Cut stack
-    ; Recover previous exception handler
-        pop     Caml_state(exception_pointer)
-        ret                                        ; Branch to handler
+        mov     rax, r12             ; Recover exception bucket
+        RESTORE_EXN_HANDLER_OCAML
+        ret
+
+        PUBLIC  caml_reraise_exn
+        ALIGN   4
+caml_reraise_exn:
+        test     qword ptr Caml_state(backtrace_active), 1
+        jne     L117
+        RESTORE_EXN_HANDLER_OCAML
+        ret
 
 ; Raise an exception from C
 
         PUBLIC  caml_raise_exception
-        ALIGN   16
+        ALIGN   4
 caml_raise_exception:
-        mov     r14, rcx                             ; First arg is Caml_state
-        mov     r11, Caml_state(backtrace_active)
-        test    r11, 1
-        jne     L112
-        mov     rax, rdx                             ; Second arg is exn bucket
-        mov     rsp, Caml_state(exception_pointer)
-    ; Recover previous exception handler
-        pop     Caml_state(exception_pointer)
-        mov     r15, Caml_state(young_ptr)           ; Reload alloc ptr
-        ret
-L112:
-        mov     r12, rdx                             ; Save exception bucket
-        mov     rcx, rdx                             ; Arg 1: exception bucket
-        mov     rdx, Caml_state(last_return_address) ; Arg 2: PC of raise
-        mov     r8, Caml_state(bottom_of_stack)      ; Arg 3: SP of raise
-        mov     r9, Caml_state(exception_pointer)    ; Arg 4: SP of handler
-        sub     rsp, 32                              ; Reserve 32 bytes on stack
-        call    caml_stash_backtrace
-        mov     rax, r12                             ; Recover exception bucket
-        mov     rsp, Caml_state(exception_pointer)
-    ; Recover previous exception handler
-        pop     Caml_state(exception_pointer)
-        mov     r15, Caml_state(young_ptr)           ; Reload alloc ptr
-        ret
+        mov     r14, rcx                   ; First argument is Caml_state
+        mov     rax, rdx                   ; Second argument is exn bucket
+        mov     r15, Caml_state(young_ptr) ; Reload alloc ptr
+    ; Discard the C stack pointer and reset to OCaml stack
+        mov     r10, Caml_state(current_stack)
+        mov     rsp, qword ptr [r10]
+        jmp     caml_raise_exn
 
 ; Callback from C to OCaml
 
         PUBLIC  caml_callback_asm
-        ALIGN   16
+        ALIGN   4
 caml_callback_asm:
-    ; Save callee-save registers
-        push    rbx
-        push    rbp
-        push    rsi
-        push    rdi
-        push    r12
-        push    r13
-        push    r14
-        push    r15
-        sub     rsp, 8+10*16       ; stack 16-aligned + 10 saved xmm regs
-        movapd  OWORD PTR [rsp + 0*16], xmm6
-        movapd  OWORD PTR [rsp + 1*16], xmm7
-        movapd  OWORD PTR [rsp + 2*16], xmm8
-        movapd  OWORD PTR [rsp + 3*16], xmm9
-        movapd  OWORD PTR [rsp + 4*16], xmm10
-        movapd  OWORD PTR [rsp + 5*16], xmm11
-        movapd  OWORD PTR [rsp + 6*16], xmm12
-        movapd  OWORD PTR [rsp + 7*16], xmm13
-        movapd  OWORD PTR [rsp + 8*16], xmm14
-        movapd  OWORD PTR [rsp + 9*16], xmm15
+        PUSH_CALLEE_SAVE_REGS
     ; Initial loading of arguments
         mov     r14, rcx      ; Caml_state
         mov     rbx, rdx      ; closure
-        mov     rax, [r8]     ; argument
-        mov     r12, [rbx]    ; code pointer
+        mov     rax, qword ptr [r8]     ; argument
+        mov     r12, qword ptr [rbx]    ; code pointer
+        mov     rdi, 0 ; XXX dummy?
+        mov     rsi, 0 ; XXX dummy?
         jmp     L106
 
         PUBLIC  caml_callback2_asm
-        ALIGN   16
+        ALIGN   4
 caml_callback2_asm:
-    ; Save callee-save registers
-        push    rbx
-        push    rbp
-        push    rsi
-        push    rdi
-        push    r12
-        push    r13
-        push    r14
-        push    r15
-        sub     rsp, 8+10*16       ; stack 16-aligned + 10 saved xmm regs
-        movapd  OWORD PTR [rsp + 0*16], xmm6
-        movapd  OWORD PTR [rsp + 1*16], xmm7
-        movapd  OWORD PTR [rsp + 2*16], xmm8
-        movapd  OWORD PTR [rsp + 3*16], xmm9
-        movapd  OWORD PTR [rsp + 4*16], xmm10
-        movapd  OWORD PTR [rsp + 5*16], xmm11
-        movapd  OWORD PTR [rsp + 6*16], xmm12
-        movapd  OWORD PTR [rsp + 7*16], xmm13
-        movapd  OWORD PTR [rsp + 8*16], xmm14
-        movapd  OWORD PTR [rsp + 9*16], xmm15
+        PUSH_CALLEE_SAVE_REGS
     ; Initial loading of arguments
         mov     r14, rcx        ; Caml_state
         mov     rdi, rdx        ; closure
-        mov     rax, [r8]       ; first argument
-        mov     rbx, [r8 + 8]   ; second argument
+        mov     rax, qword ptr [r8]       ; first argument
+        mov     rbx, qword ptr [r8 + 8]   ; second argument
         lea     r12, caml_apply2  ; code pointer
+        mov     rsi, 0            ; XXX dummy?
         jmp     L106
 
         PUBLIC  caml_callback3_asm
-        ALIGN   16
+        ALIGN   4
 caml_callback3_asm:
-    ; Save callee-save registers
-        push    rbx
-        push    rbp
-        push    rsi
-        push    rdi
-        push    r12
-        push    r13
-        push    r14
-        push    r15
-        sub     rsp, 8+10*16       ; stack 16-aligned + 10 saved xmm regs
-        movapd  OWORD PTR [rsp + 0*16], xmm6
-        movapd  OWORD PTR [rsp + 1*16], xmm7
-        movapd  OWORD PTR [rsp + 2*16], xmm8
-        movapd  OWORD PTR [rsp + 3*16], xmm9
-        movapd  OWORD PTR [rsp + 4*16], xmm10
-        movapd  OWORD PTR [rsp + 5*16], xmm11
-        movapd  OWORD PTR [rsp + 6*16], xmm12
-        movapd  OWORD PTR [rsp + 7*16], xmm13
-        movapd  OWORD PTR [rsp + 8*16], xmm14
-        movapd  OWORD PTR [rsp + 9*16], xmm15
+        PUSH_CALLEE_SAVE_REGS
     ; Initial loading of arguments
         mov     r14, rcx        ; Caml_state
+        mov     rax, qword ptr [r8]       ; first argument
+        mov     rbx, qword ptr [r8 + 8]   ; second argument
         mov     rsi, rdx        ; closure
-        mov     rax, [r8]       ; first argument
-        mov     rbx, [r8 + 8]   ; second argument
-        mov     rdi, [r8 + 16]  ; third argument
+        mov     rdi, qword ptr [r8 + 16]  ; third argument
         lea     r12, caml_apply3      ; code pointer
         jmp     L106
 
+; Fibers
+
+        PUBLIC  caml_perform
+        ALIGN   4
+caml_perform:
+    ;  %rax: effect to perform
+    ;  %rbx: freshly allocated continuation
+        mov     rsi, Caml_state(current_stack) ; %rsi := old stack
+        lea     rdi, [rsi + 1] ; %rdi (last_fiber) := Val_ptr(old stack)
+        mov     qword ptr [rbx], rdi ; Initialise continuation
+do_perform:
+    ;  %rax: effect to perform
+    ;  %rbx: continuation
+    ;  %rdi: last_fiber
+    ;  %rsi: old stack *;
+        mov     qword ptr [rbx+8], rdi  ; Set last fiber field in continuation
+        mov     r11, qword ptr [rsi+16] ; %r11 := old stack -> handler
+        mov     r10, qword ptr [r11+24] ; %r10 := parent stack
+        cmp     r10, 0                  ; parent is NULL?
+        je      L112
+        SWITCH_OCAML_STACKS ; preserves r11 and rsi
+     ; We have to null the Handler_parent after the switch because the
+     ; Handler_parent is needed to unwind the stack for backtraces
+        mov     qword ptr [r11+24], 0 ; Set parent of performer to NULL
+        mov     rsi, qword ptr [r11+16]  ; %rsi := effect handler
+        jmp     caml_apply3
+L112:
+    ; Switch back to original performer before raising Effect.Unhandled
+    ; (no-op unless this is a reperform)
+        mov     r10, qword ptr [rbx]  ; load performer stack from continuation
+        sub     r10, 1       ; r10 := Ptr_val(r10)
+        mov     rsi, Caml_state(current_stack)
+        SWITCH_OCAML_STACKS
+    ; No parent stack. Raise Effect.Unhandled.
+        mov     rcx, rax
+        lea     rax, caml_raise_unhandled_effect
+        jmp     caml_c_call
+
+        PUBLIC  caml_reperform
+        ALIGN   4
+caml_reperform:
+    ;  %rax: effect to reperform
+    ;  %rbx: continuation
+    ;  %rdi: last_fiber
+        mov     rsi, Caml_state(current_stack)    ; %rsi := old stack
+        mov     r10, qword ptr [rdi+15]
+        mov     qword ptr [r10+24], rsi       ; Append to last_fiber
+        lea     rdi, [rsi + 1]  ; %rdi (last_fiber) := Val_ptr(old stack)
+        jmp     do_perform
+
+        PUBLIC  caml_resume
+        ALIGN   4
+caml_resume:
+    ; %rax -> fiber, %rbx -> fun, %rdi -> arg, %rsi -> last_fiber
+        lea     r10, [rax-1]  ; %r10 (new stack) = Ptr_val(%rax)
+        mov     rax, rdi      ; %rax := argument to the function in %rbx
+    ;  check if stack null, then already used
+        test    r10, r10
+        jz      L502
+    ; Add current stack to the last fiber
+        mov     rdi, qword ptr [rsi+15]
+        mov     rsi, Caml_state(current_stack)
+        mov     qword ptr [rdi+24], rsi
+        SWITCH_OCAML_STACKS
+        jmp     qword ptr [rbx]
+L502:
+        lea     rax, caml_raise_continuation_already_resumed
+        jmp     caml_c_call
+
+        PUBLIC  caml_runstack
+        ALIGN   4
+caml_runstack:
+    ; %rax -> fiber, %rbx -> fun, %rdi -> arg
+        and     rax, -2       ; %rax = Ptr_val(%rax)
+    ; save old stack pointer and exception handler
+        mov     rcx, Caml_state(current_stack)
+        mov     r10, Caml_state(exn_handler)
+        mov     qword ptr [rcx], rsp
+        mov     qword ptr [rcx+8], r10
+    ; Load new stack pointer and set parent
+        mov     r11, qword ptr [rax+16]
+        mov     qword ptr [r11+24], rcx
+        mov     Caml_state(current_stack), rax
+        mov     r11, qword ptr [rax]
+    ; Create an exception handler on the target stack
+    ;  after 16byte DWARF & gc_regs block (which is unused here)
+        sub     r11, 32
+        lea     r10, fiber_exn_handler
+        mov     qword ptr [r11+8], r10
+    ; link the previous exn_handler so that copying stacks works
+        mov     r10, qword ptr [rax+8]
+        mov     qword ptr [r11], r10
+        mov     Caml_state(exn_handler), r11
+    ; Switch to the new stack
+        mov     rsp, r11
+        mov     rax, rdi ; first argument
+        call    qword ptr [rbx] ; closure in %rbx (second argument)
+frame_runstack:
+        lea     r11, [rsp+32] ; SP with exn handler popped
+        mov     rbx, qword ptr [r11]
+L610:
+        mov     rcx, Caml_state(current_stack) ; arg to caml_free_stack
+    ; restore parent stack and exn_handler into Caml_state
+        mov     r10, qword ptr [r11+24]
+        mov     r11, qword ptr [r10+8]
+        mov     Caml_state(current_stack), r10
+        mov     Caml_state(exn_handler), r11
+    ; free old stack by switching directly to c_stack; is a no-alloc call
+        mov     r13, qword ptr [r10]    ; saved across C call
+        mov     r12, rax ; save %rax across C call
+        mov     rsp, Caml_state(c_stack)
+        call  caml_free_stack
+    ; switch directly to parent stack with correct return
+        mov     rsp, r13
+        mov     rax, r12
+    ; Invoke handle_value (or handle_exn)
+        jmp     qword ptr [rbx]
+fiber_exn_handler:
+        lea     r11, [rsp+16]
+        mov     rbx, qword ptr [r11+8]
+        jmp     L610
+
         PUBLIC  caml_ml_array_bound_error
-        ALIGN   16
+        ALIGN   4
 caml_ml_array_bound_error:
         lea     rax, caml_array_bound_error_asm
         jmp     caml_c_call
 
+        PUBLIC  caml_assert_stack_invariants
+        ALIGN   4
+caml_assert_stack_invariants:
+        mov     r11, Caml_state(current_stack)
+        mov     r10, rsp
+        sub     r10, r11
+        cmp     r10, 296
+        jge     L310
+        int     3
+L310:
+        ret
+
         PUBLIC caml_system__code_end
 caml_system__code_end:
 
         .DATA
-        PUBLIC  caml_system__frametable
-caml_system__frametable LABEL QWORD
-        QWORD   1           ; one descriptor
+        PUBLIC  caml_system$frametable
+caml_system$frametable LABEL QWORD
+        QWORD   2           ; two descriptors
         QWORD   L107        ; return address into callback
         WORD    -1          ; negative frame size => use callback link
         WORD    0           ; no roots here
         ALIGN   8
+        QWORD   frame_runstack
+        WORD    -1
+        WORD    0
 
         PUBLIC  caml_negf_mask
         ALIGN   16

diff --git a/runtime/arm64.S b/runtime/arm64.S
index 6c6495a0a881c6c9d637ce6229325776eb50c289..b3a475454d642996a42e12eca00ec6242450fce5 100644 (file)
--- a/runtime/arm64.S
+++ b/runtime/arm64.S
@@ -36,38 +36,9 @@
 #define C_ARG_3 x2
 #define C_ARG_4 x3
 
-/* Support for CFI directives */
-
-#if defined(ASM_CFI_SUPPORTED)
-#define CFI_STARTPROC .cfi_startproc
-#define CFI_ENDPROC .cfi_endproc
-#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
-#define CFI_REGISTER(r1,r2) .cfi_register r1,r2
-#define CFI_OFFSET(r,n) .cfi_offset r,n
-#define CFI_DEF_CFA_REGISTER(r) .cfi_def_cfa_register r
-#define CFI_SIGNAL_FRAME .cfi_signal_frame
-#define CFI_REMEMBER_STATE .cfi_remember_state
-#define CFI_RESTORE_STATE .cfi_restore_state
-#else
-#define CFI_STARTPROC
-#define CFI_ENDPROC
-#define CFI_ADJUST(n)
-#define CFI_REGISTER(r1,r2)
-#define CFI_OFFSET(r,n)
-#define CFI_DEF_CFA_REGISTER(r)
-#define CFI_SIGNAL_FRAME
-#define CFI_REMEMBER_STATE
-#define CFI_RESTORE_STATE
-#endif
-
 /* DWARF
 
-   These constants are taken from:
-
-     DWARF Debugging Information Format, Version 3
-     http://dwarfstd.org/doc/Dwarf3.pdf
-
-   with the ARM64 specific register numbers coming from
+   These ARM64 specific register numbers are coming from
    Table 4 ("Mapping from DWARF register numbers to Arm
    64-bit architecture registers") of:
 
@@ -75,12 +46,8 @@
 
  */
 
-#define DW_CFA_def_cfa_expression 0x0f
 #define DW_REG_x21                21
 #define DW_REG_sp                 31
-#define DW_OP_breg                0x70
-#define DW_OP_deref               0x06
-#define DW_OP_plus_uconst         0x23
 
 
         .set    domain_curr_field, 0
@@ -185,6 +152,23 @@ G(name):
         .size   G(name), .-G(name)
 #endif
 
+#include "../runtime/caml/asm.h"
+
+/* Function prologue and epilogue */
+
+.macro ENTER_FUNCTION
+        CFI_OFFSET(29, -16)
+        CFI_OFFSET(30, -8)
+        stp     x29, x30, [sp, -16]!
+        CFI_ADJUST(16)
+        add     x29, sp, #0
+.endm
+
+.macro LEAVE_FUNCTION
+        ldp     x29, x30, [sp], 16
+        CFI_ADJUST(-16)
+.endm
+
 /* Stack switching operations */
 
 /* struct stack_info */
@@ -450,12 +434,9 @@ G(caml_system__code_begin):
 
 FUNCTION(caml_call_realloc_stack)
         CFI_STARTPROC
+        CFI_SIGNAL_FRAME
     /* Save return address and frame pointer */
-        CFI_OFFSET(29, -16)
-        CFI_OFFSET(30, -8)
-        stp     x29, x30, [sp, -16]!
-        CFI_ADJUST(16)
-        add     x29, sp, #0
+        ENTER_FUNCTION
     /* Save all registers (including ALLOC_PTR & TRAP_PTR) */
         SAVE_ALL_REGS
         ldr     C_ARG_1, [sp, 16] /* argument */
@@ -465,26 +446,23 @@ FUNCTION(caml_call_realloc_stack)
         cbz     x0, 1f
         RESTORE_ALL_REGS
     /* Free stack space and return to caller */
-        ldp     x29, x30, [sp], 16
+        LEAVE_FUNCTION
         ret
 1:      RESTORE_ALL_REGS
     /* Raise the Stack_overflow exception */
-        ldp     x29, x30, [sp], 16
+        LEAVE_FUNCTION
         add     sp, sp, 16 /* pop argument */
         ADDRGLOBAL(x0, caml_exn_Stack_overflow)
         b       G(caml_raise_exn)
         CFI_ENDPROC
-        END_FUNCTION(caml_call_realloc_stack)
+END_FUNCTION(caml_call_realloc_stack)
 
 FUNCTION(caml_call_gc)
         CFI_STARTPROC
 L(caml_call_gc):
+        CFI_SIGNAL_FRAME
     /* Save return address and frame pointer */
-        CFI_OFFSET(29, -16)
-        CFI_OFFSET(30, -8)
-        stp     x29, x30, [sp, -16]!
-        CFI_ADJUST(16)
-        add     x29, sp, #0
+        ENTER_FUNCTION
     /* Store all registers (including ALLOC_PTR & TRAP_PTR) */
         SAVE_ALL_REGS
         TSAN_ENTER_FUNCTION
@@ -495,10 +473,10 @@ L(caml_call_gc):
         TSAN_EXIT_FUNCTION
         RESTORE_ALL_REGS
     /* Free stack space and return to caller */
-        ldp     x29, x30, [sp], 16
+        LEAVE_FUNCTION
         ret
         CFI_ENDPROC
-        END_FUNCTION(caml_call_gc)
+END_FUNCTION(caml_call_gc)
 
 FUNCTION(caml_alloc1)
         CFI_STARTPROC
@@ -508,7 +486,7 @@ FUNCTION(caml_alloc1)
         b.lo    L(caml_call_gc)
         ret
         CFI_ENDPROC
-        END_FUNCTION(caml_alloc1)
+END_FUNCTION(caml_alloc1)
 
 FUNCTION(caml_alloc2)
         CFI_STARTPROC
@@ -518,7 +496,7 @@ FUNCTION(caml_alloc2)
         b.lo    L(caml_call_gc)
         ret
         CFI_ENDPROC
-        END_FUNCTION(caml_alloc2)
+END_FUNCTION(caml_alloc2)
 
 FUNCTION(caml_alloc3)
         CFI_STARTPROC
@@ -528,7 +506,7 @@ FUNCTION(caml_alloc3)
         b.lo    L(caml_call_gc)
         ret
         CFI_ENDPROC
-        END_FUNCTION(caml_alloc3)
+END_FUNCTION(caml_alloc3)
 
 FUNCTION(caml_allocN)
         CFI_STARTPROC
@@ -538,7 +516,7 @@ FUNCTION(caml_allocN)
         b.lo    L(caml_call_gc)
         ret
         CFI_ENDPROC
-        END_FUNCTION(caml_allocN)
+END_FUNCTION(caml_allocN)
 
 /* Call a C function from OCaml */
 /* Function to call is in ADDITIONAL_ARG */
@@ -554,11 +532,8 @@ FUNCTION(caml_allocN)
 
 FUNCTION(caml_c_call)
         CFI_STARTPROC
-        CFI_OFFSET(29, -16)
-        CFI_OFFSET(30, -8)
-        stp     x29, x30, [sp, -16]!
-        CFI_ADJUST(16)
-        add     x29, sp, #0
+        CFI_SIGNAL_FRAME
+        ENTER_FUNCTION
         TSAN_SAVE_CALLER_REGS
         TSAN_ENTER_FUNCTION
         TSAN_RESTORE_CALLER_REGS
@@ -590,23 +565,20 @@ FUNCTION(caml_c_call)
         CFI_ADJUST(-16)
 #endif
     /* Return */
-        ldp     x29, x30, [sp], 16
+        LEAVE_FUNCTION
         RET_FROM_C_CALL
         CFI_ENDPROC
 END_FUNCTION(caml_c_call)
 
 FUNCTION(caml_c_call_stack_args)
         CFI_STARTPROC
+        CFI_SIGNAL_FRAME
     /* Arguments:
         C arguments  : x0 to x7, d0 to d7
         C function   : ADDITIONAL_ARG
         C stack args : begin=STACK_ARG_BEGIN
                        end=STACK_ARG_END */
-        CFI_OFFSET(29, -16)
-        CFI_OFFSET(30, -8)
-        stp     x29, x30, [sp, -16]!
-        CFI_ADJUST(16)
-        add     x29, sp, #0
+        ENTER_FUNCTION
     /* Switch from OCaml to C */
         SWITCH_OCAML_TO_C
     /* Make the exception handler alloc ptr available to the C code */
@@ -632,7 +604,7 @@ FUNCTION(caml_c_call_stack_args)
     /* Switch from C to OCaml */
         SWITCH_C_TO_OCAML
     /* Return */
-        ldp     x29, x30, [sp], 16
+        LEAVE_FUNCTION
         RET_FROM_C_CALL
         CFI_ENDPROC
 END_FUNCTION(caml_c_call_stack_args)
@@ -667,10 +639,10 @@ FUNCTION(caml_start_program)
 
 L(jump_to_caml):
     /* Set up stack frame and save callee-save registers */
+        CFI_OFFSET(29, -160)
+        CFI_OFFSET(30, -152)
         stp     x29, x30, [sp, -160]!
         CFI_ADJUST(160)
-        CFI_OFFSET(29, 0)
-        CFI_OFFSET(30, 8)
         add     x29, sp, #0
         stp     x19, x20, [sp, 16]
         stp     x21, x22, [sp, 32]
@@ -774,7 +746,7 @@ L(return_result):
     /* Return to C caller */
         ret
         CFI_ENDPROC
-        END_FUNCTION(caml_start_program)
+END_FUNCTION(caml_start_program)
 
 /* The trap handler */
 
@@ -795,8 +767,7 @@ L(trap_handler):
     /* Cut stack at current trap handler */
         mov     sp, TRAP_PTR
     /* Pop previous handler and jump to it */
-        ldr     TMP, [sp, 8]
-        ldr     TRAP_PTR, [sp], 16
+        ldp     TRAP_PTR, TMP, [sp], 16
         br      TMP
 .endm
 
@@ -826,7 +797,7 @@ L(caml_reraise_exn_stash):
         mov     x0, x19
         b       1b
         CFI_ENDPROC
-        END_FUNCTION(caml_raise_exn)
+END_FUNCTION(caml_raise_exn)
 
 FUNCTION(caml_reraise_exn)
         CFI_STARTPROC
@@ -834,7 +805,7 @@ FUNCTION(caml_reraise_exn)
         cbnz    TMP, L(caml_reraise_exn_stash)
         JUMP_TO_TRAP_PTR
         CFI_ENDPROC
-        END_FUNCTION(caml_reraise_exn)
+END_FUNCTION(caml_reraise_exn)
 
 #if defined(WITH_THREAD_SANITIZER)
 /* When TSan support is enabled, this routine should be called just before
@@ -850,7 +821,7 @@ FUNCTION(caml_tsan_exit_on_raise_asm)
         TSAN_C_CALL G(caml_tsan_exit_on_raise)
         ret
         CFI_ENDPROC
-        END_FUNCTION(caml_tsan_exit_on_raise_asm)
+END_FUNCTION(caml_tsan_exit_on_raise_asm)
 #endif
 
 /* Raise an exception from C */
@@ -885,10 +856,10 @@ FUNCTION(caml_raise_exception)
         CFI_ADJUST(-16)
 #endif
     /* Restore frame and link on return to OCaml */
-        ldp     x29, x30, [sp], 16
+        LEAVE_FUNCTION
         b       G(caml_raise_exn)
         CFI_ENDPROC
-        END_FUNCTION(caml_raise_exception)
+END_FUNCTION(caml_raise_exception)
 
 /* Callback from C to OCaml */
 
@@ -915,7 +886,7 @@ FUNCTION(caml_callback_asm)
         ldr     TMP2, [x1]       /* code pointer */
         b       L(jump_to_caml)
         CFI_ENDPROC
-        END_FUNCTION(caml_callback_asm)
+END_FUNCTION(caml_callback_asm)
 
 FUNCTION(caml_callback2_asm)
         CFI_STARTPROC
@@ -941,7 +912,7 @@ FUNCTION(caml_callback2_asm)
         ADDRGLOBAL(TMP2, caml_apply2)
         b       L(jump_to_caml)
         CFI_ENDPROC
-        END_FUNCTION(caml_callback2_asm)
+END_FUNCTION(caml_callback2_asm)
 
 FUNCTION(caml_callback3_asm)
         CFI_STARTPROC
@@ -968,7 +939,7 @@ FUNCTION(caml_callback3_asm)
         ADDRGLOBAL(TMP2, caml_apply3)
         b       L(jump_to_caml)
         CFI_ENDPROC
-        END_FUNCTION(caml_callback3_asm)
+END_FUNCTION(caml_callback3_asm)
 
 /* Fibers */
 
@@ -976,9 +947,7 @@ FUNCTION(caml_callback3_asm)
    Preserves old_stack and new_stack registers */
 .macro SWITCH_OCAML_STACKS old_stack, new_stack
     /* Save frame pointer and return address for old_stack */
-        stp     x29, x30, [sp, -16]!
-        CFI_ADJUST(16)
-        add     x29, sp, #0
+        ENTER_FUNCTION
     /* Save OCaml SP and exn_handler in the stack info */
         mov     TMP, sp
         str     TMP, Stack_sp(\old_stack)
@@ -990,8 +959,7 @@ FUNCTION(caml_callback3_asm)
     /* restore exn_handler for new stack */
         ldr     TRAP_PTR, Stack_exception(\new_stack)
     /* Restore frame pointer and return address for new_stack */
-        ldp     x29, x30, [sp], 16
-        CFI_ADJUST(-16)
+        LEAVE_FUNCTION
 .endm
 
 
@@ -1022,6 +990,7 @@ L(do_perform):
         TSAN_C_CALL G(caml_tsan_exit_on_perform)
         TSAN_RESTORE_CALLER_REGS
 #endif
+        str     x3, [x1, 8] /* Set the last_fiber field in the continuation */
         ldr     x9, Stack_handler(x2)  /* x9 := old stack -> handler */
         ldr     x10, Handler_parent(x9) /* x10 := parent stack */
         cbz     x10, 1f
@@ -1075,7 +1044,7 @@ L(do_perform):
         ADDRGLOBAL(ADDITIONAL_ARG, caml_raise_unhandled_effect)
         b       G(caml_c_call)
         CFI_ENDPROC
-        END_FUNCTION(caml_perform)
+END_FUNCTION(caml_perform)
 
 FUNCTION(caml_reperform)
         CFI_STARTPROC
@@ -1088,10 +1057,10 @@ FUNCTION(caml_reperform)
         add     x3, x2, 1 /* x3 (last_fiber) := Val_ptr(old stack) */
         b       L(do_perform)
         CFI_ENDPROC
-        END_FUNCTION(caml_reperform)
+END_FUNCTION(caml_reperform)
 
 FUNCTION(caml_resume)
-CFI_STARTPROC
+        CFI_STARTPROC
     /*  x0: new fiber
         x1: fun
         x2: arg
@@ -1139,12 +1108,12 @@ CFI_STARTPROC
 1:      ADDRGLOBAL(ADDITIONAL_ARG, caml_raise_continuation_already_resumed)
         b       G(caml_c_call)
         CFI_ENDPROC
-        END_FUNCTION(caml_resume)
+END_FUNCTION(caml_resume)
 
 /* Run a function on a new stack, then either
    return the value or invoke exception handler */
 FUNCTION(caml_runstack)
-CFI_STARTPROC
+        CFI_STARTPROC
 #if defined(WITH_THREAD_SANITIZER)
     /* Save non-callee-saved registers x0, x1 and x2 */
         stp     x0, x1, [sp, -16]!
@@ -1158,14 +1127,11 @@ CFI_STARTPROC
         ldp     x0, x1, [sp], 16
         CFI_ADJUST(-16)
 #endif
+        CFI_SIGNAL_FRAME
     /*  x0: fiber
         x1: fun
         x2: arg */
-        CFI_OFFSET(29, -16)
-        CFI_OFFSET(30, -8)
-        stp     x29, x30, [sp, -16]!
-        CFI_ADJUST(16)
-        add     x29, sp, #0
+        ENTER_FUNCTION
         sub     x0, x0, 1  /* x0 := Ptr_val(x0) */
         ldr     x3, [x1]   /* code pointer */
     /*  save old stack pointer and exception handler */
@@ -1233,15 +1199,14 @@ L(frame_runstack):
         mov     x1, x19
         ldr     TMP, [x19]  /* code pointer */
     /* Invoke handle_value (or handle_exn) */
-        ldp     x29, x30, [sp], 16
-        CFI_ADJUST(-16)
+        LEAVE_FUNCTION
         br      TMP
 L(fiber_exn_handler):
         add     x8, sp, 16  /* x8 := stack_handler */
         ldr     x19, Handler_exception(x8)
         b       1b
         CFI_ENDPROC
-        END_FUNCTION(caml_runstack)
+END_FUNCTION(caml_runstack)
 
 FUNCTION(caml_ml_array_bound_error)
         CFI_STARTPROC
@@ -1250,7 +1215,7 @@ FUNCTION(caml_ml_array_bound_error)
     /* Call that function */
         b       G(caml_c_call)
         CFI_ENDPROC
-        END_FUNCTION(caml_ml_array_bound_error)
+END_FUNCTION(caml_ml_array_bound_error)
 
          TEXT_SECTION(caml_system__code_end)
         .globl  G(caml_system__code_end)

diff --git a/runtime/array.c b/runtime/array.c
index 007460f9da9e8566f768b47be9265e6641e2f691..d08289d92778bff654191da6e47a1b34be2b1339 100644 (file)
--- a/runtime/array.c
+++ b/runtime/array.c
@@ -25,7 +25,7 @@
 #include "caml/signals.h"
 #include "caml/runtime_events.h"
 
-static const mlsize_t mlsize_t_max = -1;
+static const mlsize_t mlsize_t_max = CAML_UINTNAT_MAX;
 
 /* returns number of elements (either fields or floats) */
 /* [ 'a array -> int ] */
@@ -197,63 +197,80 @@ CAMLprim value caml_floatarray_create(value len)
   return caml_process_pending_actions_with_root(result);
 }
 
-/* [len] is a [value] representing number of words or floats */
-CAMLprim value caml_make_vect(value len, value init)
+CAMLprim value caml_floatarray_make_unboxed(intnat size, double init)
+{
+  if (size == 0) {
+    return Atom(0);
+  }
+  value res;
+  mlsize_t wsize = size * Double_wosize;
+  if (wsize > Max_wosize) caml_invalid_argument("Array.make");
+  res = caml_alloc(wsize, Double_array_tag);
+  for (mlsize_t i = 0; i < size; i++) {
+    Store_double_flat_field(res, i, init);
+  }
+  /* Give the GC a chance to run, and run memprof callbacks */
+  return caml_process_pending_actions_with_root(res);
+}
+
+/* [int -> float -> floatarray] */
+CAMLprim value caml_floatarray_make(value len, value init)
+{
+  return caml_floatarray_make_unboxed(Long_val(len), Double_val(init));
+}
+
+/* [int -> 'a -> uniform_array] */
+CAMLprim value caml_uniform_array_make(value len, value init)
 {
   CAMLparam2 (len, init);
   CAMLlocal1 (res);
-  mlsize_t size, i;
-
-  size = Long_val(len);
+  mlsize_t size = Long_val(len);
   if (size == 0) {
-    res = Atom(0);
-#ifdef FLAT_FLOAT_ARRAY
-  } else if (Is_block(init)
-             && Tag_val(init) == Double_tag) {
-    mlsize_t wsize;
-    double d;
-    d = Double_val(init);
-    wsize = size * Double_wosize;
-    if (wsize > Max_wosize) caml_invalid_argument("Array.make");
-    res = caml_alloc(wsize, Double_array_tag);
-    for (i = 0; i < size; i++) {
-      Store_double_flat_field(res, i, d);
-    }
-#endif
-  } else {
-    if (size <= Max_young_wosize) {
-      res = caml_alloc_small(size, 0);
-      for (i = 0; i < size; i++) Field(res, i) = init;
-    }
-    else if (size > Max_wosize) caml_invalid_argument("Array.make");
-    else {
-      if (Is_block(init) && Is_young(init)) {
-        /* We don't want to create so many major-to-minor references,
-           so [init] is moved to the major heap by doing a minor GC. */
-        CAML_EV_COUNTER (EV_C_FORCE_MINOR_MAKE_VECT, 1);
-        caml_minor_collection ();
-      }
-      CAMLassert(!(Is_block(init) && Is_young(init)));
-      res = caml_alloc_shr(size, 0);
-      /* We now know that [init] is not in the minor heap, so there is
-         no need to call [caml_initialize]. */
-      for (i = 0; i < size; i++) Field(res, i) = init;
+    CAMLreturn(Atom(0));
+  } else if (size <= Max_young_wosize) {
+    res = caml_alloc_small(size, 0);
+    for (mlsize_t i = 0; i < size; i++) Field(res, i) = init;
+  }
+  else if (size > Max_wosize) caml_invalid_argument("Array.make");
+  else {
+    if (Is_block(init) && Is_young(init)) {
+      /* We don't want to create so many major-to-minor references,
+         so [init] is moved to the major heap by doing a minor GC. */
+      CAML_EV_COUNTER (EV_C_FORCE_MINOR_MAKE_VECT, 1);
+      caml_minor_collection ();
     }
+    CAMLassert(!(Is_block(init) && Is_young(init)));
+    res = caml_alloc_shr(size, 0);
+    /* We now know that [init] is not in the minor heap, so there is
+       no need to call [caml_initialize]. */
+    for (mlsize_t i = 0; i < size; i++) Field(res, i) = init;
   }
   /* Give the GC a chance to run, and run memprof callbacks */
   caml_process_pending_actions ();
   CAMLreturn (res);
 }
 
+/* [len] is a [value] representing number of words or floats */
+CAMLprim value caml_array_make(value len, value init)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Is_block(init)
+      && Tag_val(init) == Double_tag) {
+    return caml_floatarray_make(len, init);
+  }
+#endif
+  return caml_uniform_array_make(len, init);
+}
+
 /* [len] is a [value] representing number of floats */
 /* [ int -> float array ] */
-CAMLprim value caml_make_float_vect(value len)
+CAMLprim value caml_array_create_float(value len)
 {
 #ifdef FLAT_FLOAT_ARRAY
   return caml_floatarray_create (len);
 #else
   /* A signaling NaN, statically allocated */
-  static uintnat some_float_contents[] = {
+  static const uintnat some_float_contents[] = {
     Caml_out_of_heap_header(Double_wosize, Double_tag),
 #if defined(ARCH_SIXTYFOUR)
     0x7FF0000000000001
@@ -264,7 +281,7 @@ CAMLprim value caml_make_float_vect(value len)
 #endif
   };
   value some_float = Val_hp(some_float_contents);
-  return caml_make_vect (len, some_float);
+  return caml_array_make (len, some_float);
 #endif
 }
 
@@ -274,11 +291,11 @@ CAMLprim value caml_make_float_vect(value len)
    boxed floats and returns the corresponding flat-allocated [float array].
    In all other cases, it just returns its argument unchanged.
 */
-CAMLprim value caml_make_array(value init)
+CAMLprim value caml_array_of_uniform_array(value init)
 {
 #ifdef FLAT_FLOAT_ARRAY
   CAMLparam1 (init);
-  mlsize_t wsize, size, i;
+  mlsize_t wsize, size;
   CAMLlocal2 (v, res);
 
   size = Wosize_val(init);
@@ -296,7 +313,7 @@ CAMLprim value caml_make_array(value init)
       } else {
         res = caml_alloc_shr(wsize, Double_array_tag);
       }
-      for (i = 0; i < size; i++) {
+      for (mlsize_t i = 0; i < size; i++) {
         double d = Double_val(Field(init, i));
         Store_double_flat_field(res, i, d);
       }
@@ -310,6 +327,26 @@ CAMLprim value caml_make_array(value init)
 #endif
 }
 
+
+/* #13003: previous names for array-creation primitives,
+   kept for backward-compatibility only. */
+
+CAMLprim value caml_make_vect(value len, value init)
+{
+  return caml_array_make(len, init);
+}
+
+CAMLprim value caml_make_float_vect(value len)
+{
+  return caml_array_create_float(len);
+}
+
+CAMLprim value caml_make_array(value array)
+{
+  return caml_array_of_uniform_array(array);
+}
+
+
 /* Blitting */
 
 /* [wo_memmove] copies [nvals] values from [src] to [dst]. If there is a single
@@ -326,8 +363,6 @@ static void wo_memmove (volatile value* const dst,
                         volatile const value* const src,
                         mlsize_t nvals)
 {
-  mlsize_t i;
-
   if (caml_domain_alone ()) {
     memmove ((value*)dst, (value*)src, nvals * sizeof (value));
   } else {
@@ -335,12 +370,12 @@ static void wo_memmove (volatile value* const dst,
     atomic_thread_fence(memory_order_acquire);
     if (dst < src) {
       /* copy ascending */
-      for (i = 0; i < nvals; i++)
+      for (mlsize_t i = 0; i < nvals; i++)
         atomic_store_release(&((atomic_value*)dst)[i], src[i]);
 
     } else {
       /* copy descending */
-      for (i = nvals; i > 0; i--)
+      for (mlsize_t i = nvals; i > 0; i--)
         atomic_store_release(&((atomic_value*)dst)[i-1], src[i-1]);
     }
   }
@@ -351,6 +386,12 @@ static void wo_memmove (volatile value* const dst,
 CAMLprim value caml_floatarray_blit(value a1, value ofs1, value a2, value ofs2,
                                     value n)
 {
+  if (Long_val(n) == 0) return Val_unit;
+  /* Note: size-0 floatarrays do not have Double_array_tag,
+     but only size-0 blits are possible on them, so they
+     do not reach this point. */
+  CAMLassert (Tag_val(a1) == Double_array_tag);
+  CAMLassert (Tag_val(a2) == Double_array_tag);
   /* See memory model [MM] notes in memory.c */
   atomic_thread_fence(memory_order_acquire);
   memmove((double *)a2 + Long_val(ofs2),
@@ -359,16 +400,16 @@ CAMLprim value caml_floatarray_blit(value a1, value ofs1, value a2, value ofs2,
   return Val_unit;
 }
 
-CAMLprim value caml_array_blit(value a1, value ofs1, value a2, value ofs2,
-                               value n)
+CAMLprim value caml_uniform_array_blit(
+  value a1, value ofs1, value a2, value ofs2, value n)
 {
   volatile value * src, * dst;
   intnat count;
 
-#ifdef FLAT_FLOAT_ARRAY
-  if (Tag_val(a2) == Double_array_tag)
-    return caml_floatarray_blit(a1, ofs1, a2, ofs2, n);
-#endif
+  if (Long_val(n) == 0)
+    /* See comment on size-0 floatarrays in [caml_floatarray_blit]. */
+    return Val_unit;
+  CAMLassert (Tag_val(a1) != Double_array_tag);
   CAMLassert (Tag_val(a2) != Double_array_tag);
   if (Is_young(a2)) {
     /* Arrays of values, destination is in young generation.
@@ -405,57 +446,82 @@ CAMLprim value caml_array_blit(value a1, value ofs1, value a2, value ofs2,
   return Val_unit;
 }
 
-/* A generic function for extraction and concatenation of sub-arrays */
+CAMLprim value caml_array_blit(value a1, value ofs1, value a2, value ofs2,
+                               value n)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(a2) == Double_array_tag)
+    return caml_floatarray_blit(a1, ofs1, a2, ofs2, n);
+#endif
+  return caml_uniform_array_blit(a1, ofs1, a2, ofs2, n);
+}
 
-static value caml_array_gather(intnat num_arrays,
-                               value arrays[/*num_arrays*/],
-                               intnat offsets[/*num_arrays*/],
-                               intnat lengths[/*num_arrays*/])
+/* generic [gather] functions for extraction and concatenation of sub-arrays */
+
+/* The lengths are specified in number of floats,
+   as returned by [caml_array_length]. */
+static value caml_floatarray_gather(intnat num_arrays,
+                                    value arrays[/*num_arrays*/],
+                                    intnat offsets[/*num_arrays*/],
+                                    intnat lengths[/*num_arrays*/])
 {
   CAMLparamN(arrays, num_arrays);
   value res;                    /* no need to register it as a root */
-#ifdef FLAT_FLOAT_ARRAY
-  int isfloat = 0;
-  mlsize_t wsize;
-#endif
-  mlsize_t i, size, count, pos;
-  volatile value * src;
 
-  /* Determine total size and whether result array is an array of floats */
-  size = 0;
-  for (i = 0; i < num_arrays; i++) {
+  /* Determine total size, in number of floats. */
+  mlsize_t size = 0;
+  for (mlsize_t i = 0; i < num_arrays; i++) {
     if (mlsize_t_max - lengths[i] < size) caml_invalid_argument("Array.concat");
     size += lengths[i];
-#ifdef FLAT_FLOAT_ARRAY
-    if (Tag_val(arrays[i]) == Double_array_tag) isfloat = 1;
-#endif
+    CAMLassert(Tag_val(arrays[i]) == Double_array_tag
+               || Wosize_val(arrays[i]) == 0);
   }
   if (size == 0) {
     /* If total size = 0, just return empty array */
     res = Atom(0);
   }
-#ifdef FLAT_FLOAT_ARRAY
-  else if (isfloat) {
-    /* This is an array of floats.  We can use memcpy directly. */
-    if (size > Max_wosize/Double_wosize) caml_invalid_argument("Array.concat");
-    wsize = size * Double_wosize;
-    res = caml_alloc(wsize, Double_array_tag);
-    for (i = 0, pos = 0; i < num_arrays; i++) {
-      /* [res] is freshly allocated, and no other domain has a reference to it.
-         Hence, a plain [memcpy] is sufficient. */
-      memcpy((double *)res + pos,
-             (double *)arrays[i] + offsets[i],
-             lengths[i] * sizeof(double));
-      pos += lengths[i];
-    }
-    CAMLassert(pos == size);
+  /* This is an array of floats.  We can use memcpy directly. */
+  if (size > Max_wosize/Double_wosize) caml_invalid_argument("Array.concat");
+  mlsize_t wsize = size * Double_wosize; /* total size, in words */
+  res = caml_alloc(wsize, Double_array_tag);
+  mlsize_t pos = 0;
+  for (mlsize_t i = 0; i < num_arrays; i++) {
+    /* [res] is freshly allocated, and no other domain has a reference to it.
+       Hence, a plain [memcpy] is sufficient. */
+    memcpy((double *)res + pos,
+           (double *)arrays[i] + offsets[i],
+           lengths[i] * sizeof(double));
+    pos += lengths[i];
+  }
+  CAMLassert(pos == size);
+  CAMLreturn(res);
+}
+
+static value caml_uniform_array_gather(intnat num_arrays,
+                                       value arrays[/*num_arrays*/],
+                                       intnat offsets[/*num_arrays*/],
+                                       intnat lengths[/*num_arrays*/])
+{
+  CAMLparamN(arrays, num_arrays);
+  value res;                    /* no need to register it as a root */
+
+  /* Determine total size */
+  mlsize_t size = 0;
+  for (mlsize_t i = 0; i < num_arrays; i++) {
+    if (mlsize_t_max - lengths[i] < size) caml_invalid_argument("Array.concat");
+    size += lengths[i];
+    CAMLassert(Tag_val(arrays[i]) != Double_array_tag);
+  }
+  if (size == 0) {
+    /* If total size = 0, just return an empty array */
+    res = Atom(0);
   }
-#endif
   else if (size <= Max_young_wosize) {
     /* Array of values, small enough to fit in young generation.
        We can use memcpy directly. */
     res = caml_alloc_small(size, 0);
-    for (i = 0, pos = 0; i < num_arrays; i++) {
+    mlsize_t pos = 0;
+    for (mlsize_t i = 0; i < num_arrays; i++) {
       /* [res] is freshly allocated, and no other domain has a reference to it.
          Hence, a plain [memcpy] is sufficient. */
       memcpy((value*)&Field(res, pos),
@@ -472,8 +538,10 @@ static value caml_array_gather(intnat num_arrays,
     /* Array of values, must be allocated in old generation and filled
        using caml_initialize. */
     res = caml_alloc_shr(size, 0);
-    for (i = 0, pos = 0; i < num_arrays; i++) {
-      for (src = &Field(arrays[i], offsets[i]), count = lengths[i];
+    mlsize_t pos = 0;
+    for (mlsize_t i = 0; i < num_arrays; i++) {
+      volatile value *src = &Field(arrays[i], offsets[i]);
+      for (mlsize_t count = lengths[i];
            count > 0;
            count--, src++, pos++) {
         caml_initialize(&Field(res, pos), *src);
@@ -489,6 +557,47 @@ static value caml_array_gather(intnat num_arrays,
   CAMLreturn (res);
 }
 
+
+static value caml_array_gather(intnat num_arrays,
+                               value arrays[/*num_arrays*/],
+                               intnat offsets[/*num_arrays*/],
+                               intnat lengths[/*num_arrays*/])
+{
+#ifdef FLAT_FLOAT_ARRAY
+  for (mlsize_t i = 0; i < num_arrays; i++) {
+    /* An array is either an empty array,
+       or a float array, or a non-float array.
+       We know which implementation to use on the first non-empty array. */
+    if (Wosize_val(arrays[i]) == 0)
+      continue;
+    else if (Tag_val(arrays[i]) == Double_array_tag)
+      return caml_floatarray_gather(num_arrays, arrays, offsets, lengths);
+    else
+      break;
+  }
+  /* If we reach this point, all arrays were empty.
+     Calling the uniform_ version below is correct
+     -- it will return an empty array. */
+#endif
+  return caml_uniform_array_gather(num_arrays, arrays, offsets, lengths);
+}
+
+CAMLprim value caml_floatarray_sub(value a, value ofs, value len)
+{
+  value arrays[1] = { a };
+  intnat offsets[1] = { Long_val(ofs) };
+  intnat lengths[1] = { Long_val(len) };
+  return caml_floatarray_gather(1, arrays, offsets, lengths);
+}
+
+CAMLprim value caml_uniform_array_sub(value a, value ofs, value len)
+{
+  value arrays[1] = { a };
+  intnat offsets[1] = { Long_val(ofs) };
+  intnat lengths[1] = { Long_val(len) };
+  return caml_uniform_array_gather(1, arrays, offsets, lengths);
+}
+
 CAMLprim value caml_array_sub(value a, value ofs, value len)
 {
   value arrays[1] = { a };
@@ -497,6 +606,23 @@ CAMLprim value caml_array_sub(value a, value ofs, value len)
   return caml_array_gather(1, arrays, offsets, lengths);
 }
 
+CAMLprim value caml_floatarray_append(value a1, value a2)
+{
+  value arrays[2] = { a1, a2 };
+  intnat offsets[2] = { 0, 0 };
+  /* sizes are specified in number of floats */
+  intnat lengths[2] = { caml_array_length(a1), caml_array_length(a2) };
+  return caml_floatarray_gather(2, arrays, offsets, lengths);
+}
+
+CAMLprim value caml_uniform_array_append(value a1, value a2)
+{
+  value arrays[2] = { a1, a2 };
+  intnat offsets[2] = { 0, 0 };
+  intnat lengths[2] = { caml_array_length(a1), caml_array_length(a2) };
+  return caml_uniform_array_gather(2, arrays, offsets, lengths);
+}
+
 CAMLprim value caml_array_append(value a1, value a2)
 {
   value arrays[2] = { a1, a2 };
@@ -552,10 +678,23 @@ CAMLprim value caml_array_concat(value al)
   return res;
 }
 
-CAMLprim value caml_array_fill(value array,
-                               value v_ofs,
-                               value v_len,
-                               value val)
+CAMLprim value caml_floatarray_fill_unboxed(
+  value array, intnat ofs, intnat len, double d)
+{
+  for (; len > 0; len--, ofs++)
+    Store_double_flat_field(array, ofs, d);
+  return Val_unit;
+}
+
+CAMLprim value caml_floatarray_fill(
+  value array, value v_ofs, value v_len, value val)
+{
+  return caml_floatarray_fill_unboxed(
+    array, Long_val(v_ofs), Long_val(v_len), Double_val(val));
+}
+
+CAMLprim value caml_uniform_array_fill(
+  value array, value v_ofs, value v_len, value val)
 {
   intnat ofs = Long_val(v_ofs);
   intnat len = Long_val(v_len);
@@ -564,15 +703,6 @@ CAMLprim value caml_array_fill(value array,
   /* This duplicates the logic of caml_modify.  Please refer to the
      implementation of that function for a description of GC
      invariants we need to enforce.*/
-
-#ifdef FLAT_FLOAT_ARRAY
-  if (Tag_val(array) == Double_array_tag) {
-    double d = Double_val (val);
-    for (; len > 0; len--, ofs++)
-      Store_double_flat_field(array, ofs, d);
-    return Val_unit;
-  }
-#endif
   fp = &Field(array, ofs);
   if (Is_young(array)) {
     for (; len > 0; len--, fp++) *fp = val;
@@ -593,3 +723,16 @@ CAMLprim value caml_array_fill(value array,
   }
   return Val_unit;
 }
+
+CAMLprim value caml_array_fill(value array,
+                               value v_ofs,
+                               value v_len,
+                               value val)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(array) == Double_array_tag) {
+    return caml_floatarray_fill(array, v_ofs, v_len, val);
+  }
+#endif
+  return caml_uniform_array_fill(array, v_ofs, v_len, val);
+}

diff --git a/runtime/backtrace.c b/runtime/backtrace.c
index 83e4314e567b513a674e8ad269a924227ed82480..85c3dda6722fe894cb2bce144c7eff67cc689aa7 100644 (file)
--- a/runtime/backtrace.c
+++ b/runtime/backtrace.c
@@ -103,9 +103,7 @@ static void print_location(struct caml_loc_info * li, int index)
 /* Print a backtrace */
 CAMLexport void caml_print_exception_backtrace(void)
 {
-  int i;
   struct caml_loc_info li;
-  debuginfo dbg;
 
   if (!caml_debug_info_available()) {
     fprintf(stderr, "(Cannot print stack backtrace: "
@@ -113,7 +111,8 @@ CAMLexport void caml_print_exception_backtrace(void)
     return;
   }
 
-  for (i = 0; i < Caml_state->backtrace_pos; i++) {
+  for (int i = 0; i < Caml_state->backtrace_pos; i++) {
+    debuginfo dbg;
     for (dbg = caml_debuginfo_extract(Caml_state->backtrace_buffer[i]);
          dbg != NULL;
          dbg = caml_debuginfo_next(dbg))
@@ -175,7 +174,6 @@ CAMLprim value caml_get_exception_raw_backtrace(value unit)
   else {
     backtrace_slot saved_caml_backtrace_buffer[BACKTRACE_BUFFER_SIZE];
     int saved_caml_backtrace_pos;
-    intnat i;
 
     saved_caml_backtrace_pos = Caml_state->backtrace_pos;
 
@@ -187,7 +185,7 @@ CAMLprim value caml_get_exception_raw_backtrace(value unit)
            saved_caml_backtrace_pos * sizeof(backtrace_slot));
 
     res = caml_alloc(saved_caml_backtrace_pos, 0);
-    for (i = 0; i < saved_caml_backtrace_pos; i++) {
+    for (intnat i = 0; i < saved_caml_backtrace_pos; i++) {
       caml_initialize(&Field(res, i),
                       Val_backtrace_slot(saved_caml_backtrace_buffer[i]));
     }
@@ -201,7 +199,6 @@ CAMLprim value caml_get_exception_raw_backtrace(value unit)
 /* noalloc (caml value): so no CAMLparam* CAMLreturn* */
 CAMLprim value caml_restore_raw_backtrace(value exn, value backtrace)
 {
-  intnat i;
   mlsize_t bt_size;
 
   caml_domain_state* domain_state = Caml_state;
@@ -227,7 +224,7 @@ CAMLprim value caml_restore_raw_backtrace(value exn, value backtrace)
   }
 
   domain_state->backtrace_pos = bt_size;
-  for(i=0; i < domain_state->backtrace_pos; i++){
+  for (intnat i = 0; i < domain_state->backtrace_pos; i++){
     domain_state->backtrace_buffer[i] = Backtrace_slot_val(Field(backtrace, i));
   }
 
@@ -359,7 +356,6 @@ CAMLprim value caml_get_exception_backtrace(value unit)
 {
   CAMLparam0();
   CAMLlocal3(arr, res, backtrace);
-  intnat i;
 
   if (!caml_debug_info_available()) {
     res = Val_none;
@@ -367,7 +363,7 @@ CAMLprim value caml_get_exception_backtrace(value unit)
     backtrace = caml_get_exception_raw_backtrace(Val_unit);
 
     arr = caml_alloc(Wosize_val(backtrace), 0);
-    for (i = 0; i < Wosize_val(backtrace); i++) {
+    for (intnat i = 0; i < Wosize_val(backtrace); i++) {
       backtrace_slot slot = Backtrace_slot_val(Field(backtrace, i));
       debuginfo dbg = caml_debuginfo_extract(slot);
       Store_field(arr, i, caml_convert_debuginfo(dbg));

diff --git a/runtime/backtrace_byt.c b/runtime/backtrace_byt.c
index 548fadec714dfeb527e2f8df69395f17a093d09d..e8cb4b3999dd82164f07d4060213dc80e166a0be 100644 (file)
--- a/runtime/backtrace_byt.c
+++ b/runtime/backtrace_byt.c
@@ -26,6 +26,9 @@
 #ifdef HAS_UNISTD
 #include <unistd.h>
 #endif
+#ifdef _WIN32
+#include <io.h>
+#endif
 
 #include "caml/mlvalues.h"
 #include "caml/alloc.h"
@@ -83,8 +86,7 @@ struct debug_info {
 
 static struct debug_info *find_debug_info(code_t pc)
 {
-  int i;
-  for (i = 0; i < caml_debug_info.size; i++) {
+  for (int i = 0; i < caml_debug_info.size; i++) {
     struct debug_info *di = caml_debug_info.contents[i];
     if (pc >= di->start && pc < di->end)
       return di;
@@ -136,12 +138,12 @@ static struct ev_info *process_debug_events(code_t code_start,
 {
   CAMLparam1(events_heap);
   CAMLlocal4(l, ev, ev_start, ev_end);
-  mlsize_t i, j;
+  mlsize_t j;
   struct ev_info *events;
 
   /* Compute the size of the required event buffer. */
   *num_events = 0;
-  for (i = 0; i < caml_array_length(events_heap); i++)
+  for (mlsize_t i = 0; i < caml_array_length(events_heap); i++)
     for (l = Field(events_heap, i); l != Val_int(0); l = Field(l, 1))
       (*num_events)++;
 
@@ -153,7 +155,7 @@ static struct ev_info *process_debug_events(code_t code_start,
     caml_fatal_error ("caml_add_debug_info: out of memory");
 
   j = 0;
-  for (i = 0; i < caml_array_length(events_heap); i++) {
+  for (mlsize_t i = 0; i < caml_array_length(events_heap); i++) {
     for (l = Field(events_heap, i); l != Val_int(0); l = Field(l, 1)) {
       ev = Field(l, 0);
 
@@ -235,8 +237,7 @@ value caml_remove_debug_info(code_t start)
   CAMLparam0();
   CAMLlocal2(dis, prev);
 
-  int i;
-  for (i = 0; i < caml_debug_info.size; i++) {
+  for (int i = 0; i < caml_debug_info.size; i++) {
     struct debug_info *di = caml_debug_info.contents[i];
     if (di->start == start) {
       /* note that caml_ext_table_remove calls caml_stat_free on the
@@ -372,9 +373,8 @@ static value alloc_callstack(backtrace_slot *trace, size_t slots)
 {
   CAMLparam0();
   CAMLlocal1(callstack);
-  int i;
   callstack = caml_alloc(slots, 0);
-  for (i = 0; i < slots; i++)
+  for (int i = 0; i < slots; i++)
     Store_field(callstack, i, Val_backtrace_slot(trace[i]));
   caml_stat_free(trace);
   CAMLreturn(callstack);
@@ -444,7 +444,7 @@ static void read_main_debug_info(struct debug_info *di)
   CAMLparam0();
   CAMLlocal3(events, evl, l);
   char_os *exec_name;
-  int fd, num_events, orig, i;
+  int fd, num_events, orig;
   struct channel *chan;
   struct exec_trailer trail;
 
@@ -479,7 +479,7 @@ static void read_main_debug_info(struct debug_info *di)
     num_events = caml_getword(chan);
     events = caml_alloc(num_events, 0);
 
-    for (i = 0; i < num_events; i++) {
+    for (int i = 0; i < num_events; i++) {
       orig = caml_getword(chan);
       evl = caml_input_val(chan);
       caml_input_val(chan); /* Skip the list of absolute directory names */

diff --git a/runtime/backtrace_nat.c b/runtime/backtrace_nat.c
index 9e494add9fc4b824c35496af18d062ca54904a15..c6e32af906de48497e8b2504ec838b2e5115cb0c 100644 (file)
--- a/runtime/backtrace_nat.c
+++ b/runtime/backtrace_nat.c
@@ -35,7 +35,8 @@
 /* Returns the next frame descriptor (or NULL if none is available),
    and updates *pc and *sp to point to the following one.  */
 frame_descr * caml_next_frame_descriptor
-    (caml_frame_descrs fds, uintnat * pc, char ** sp, struct stack_info* stack)
+    (caml_frame_descrs * fds, uintnat * pc, char ** sp,
+     struct stack_info* stack)
 {
   frame_descr * d;
 
@@ -103,7 +104,7 @@ static debuginfo debuginfo_extract(frame_descr *d, ptrdiff_t alloc_idx);
 void caml_stash_backtrace(value exn, uintnat pc, char * sp, char* trapsp)
 {
   caml_domain_state* domain_state = Caml_state;
-  caml_frame_descrs fds;
+  caml_frame_descrs* fds;
 
   if (exn != domain_state->backtrace_last_exn) {
     domain_state->backtrace_pos = 0;
@@ -149,7 +150,7 @@ static size_t get_callstack(struct stack_info* stack, intnat max_slots,
   size_t slots = 0;
   char *sp;
   uintnat pc;
-  caml_frame_descrs fds = caml_get_frame_descrs();
+  caml_frame_descrs *fds = caml_get_frame_descrs();
   CAMLnoalloc;
 
   caml_get_stack_sp_pc(stack, &sp, &pc);
@@ -216,9 +217,8 @@ static value alloc_callstack(backtrace_slot* trace, size_t slots)
 {
   CAMLparam0();
   CAMLlocal1(callstack);
-  int i;
   callstack = caml_alloc(slots, 0);
-  for (i = 0; i < slots; i++)
+  for (int i = 0; i < slots; i++)
     Store_field(callstack, i, Val_backtrace_slot(trace[i]));
   caml_stat_free(trace);
   CAMLreturn(callstack);

diff --git a/runtime/bigarray.c b/runtime/bigarray.c
index 1e529ffecacf20cff2f329bebcdf5722cc1b7d5c..0fa0c808c007735ac9f9164c43fae44595fd7fbe 100644 (file)
--- a/runtime/bigarray.c
+++ b/runtime/bigarray.c
@@ -18,6 +18,7 @@
 #include <stddef.h>
 #include <stdarg.h>
 #include <string.h>
+#include <assert.h>
 #include "caml/alloc.h"
 #include "caml/bigarray.h"
 #include "caml/custom.h"
@@ -174,9 +175,8 @@ Caml_inline uint32_t caml_hash_mix_float16(uint32_t hash, uint16 d)
 CAMLexport uintnat caml_ba_num_elts(struct caml_ba_array * b)
 {
   uintnat num_elts;
-  int i;
   num_elts = 1;
-  for (i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
+  for (int i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
   return num_elts;
 }
 
@@ -225,16 +225,17 @@ CAMLexport value
 caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim)
 {
   uintnat num_elts, asize, size;
-  int i, uses_resources;
+  int uses_resources;
   value res;
   struct caml_ba_array * b;
   intnat dimcopy[CAML_BA_MAX_NUM_DIMS];
 
-  CAMLassert(num_dims >= 0 && num_dims <= CAML_BA_MAX_NUM_DIMS);
+  CAMLassert(0 <= num_dims);
+  CAMLassert(num_dims <= CAML_BA_MAX_NUM_DIMS);
   CAMLassert((flags & CAML_BA_KIND_MASK) < CAML_BA_FIRST_UNIMPLEMENTED_KIND);
-  for (i = 0; i < num_dims; i++) dimcopy[i] = dim[i];
+  for (int i = 0; i < num_dims; i++) dimcopy[i] = dim[i];
   num_elts = 1;
-  for (i = 0; i < num_dims; i++) {
+  for (int i = 0; i < num_dims; i++) {
     if (caml_umul_overflow(num_elts, dimcopy[i], &num_elts))
       caml_raise_out_of_memory();
   }
@@ -257,7 +258,7 @@ caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim)
   b->num_dims = num_dims;
   b->flags = flags;
   b->proxy = NULL;
-  for (i = 0; i < num_dims; i++) b->dim[i] = dimcopy[i];
+  for (int i = 0; i < num_dims; i++) b->dim[i] = dimcopy[i];
   return res;
 }
 
@@ -268,12 +269,11 @@ CAMLexport value caml_ba_alloc_dims(int flags, int num_dims, void * data, ...)
 {
   va_list ap;
   intnat dim[CAML_BA_MAX_NUM_DIMS];
-  int i;
   value res;
 
   CAMLassert(num_dims <= CAML_BA_MAX_NUM_DIMS);
   va_start(ap, data);
-  for (i = 0; i < num_dims; i++) dim[i] = va_arg(ap, intnat);
+  for (int i = 0; i < num_dims; i++) dim[i] = va_arg(ap, intnat);
   va_end(ap);
   res = caml_ba_alloc(flags, num_dims, data, dim);
   return res;
@@ -285,7 +285,7 @@ CAMLexport void caml_ba_finalize(value v)
 {
   struct caml_ba_array * b = Caml_ba_array_val(v);
 
-  switch (b->flags & CAML_BA_MANAGED_MASK) {
+  switch ((enum caml_ba_managed)(b->flags & CAML_BA_MANAGED_MASK)) {
   case CAML_BA_EXTERNAL:
     break;
   case CAML_BA_MANAGED:
@@ -300,9 +300,7 @@ CAMLexport void caml_ba_finalize(value v)
     break;
   case CAML_BA_MAPPED_FILE:
     /* Bigarrays for mapped files use a different finalization method */
-    /* fallthrough */
-  default:
-    CAMLassert(0);
+    CAMLunreachable();
   }
 }
 
@@ -312,9 +310,8 @@ CAMLexport int caml_ba_compare(value v1, value v2)
 {
   struct caml_ba_array * b1 = Caml_ba_array_val(v1);
   struct caml_ba_array * b2 = Caml_ba_array_val(v2);
-  uintnat n, num_elts;
+  uintnat num_elts;
   intnat flags1, flags2;
-  int i;
 
   /* Compare kind & layout in case the arguments are of different types */
   flags1 = b1->flags & (CAML_BA_KIND_MASK | CAML_BA_LAYOUT_MASK);
@@ -323,7 +320,7 @@ CAMLexport int caml_ba_compare(value v1, value v2)
   /* Compare number of dimensions */
   if (b1->num_dims != b2->num_dims) return b2->num_dims - b1->num_dims;
   /* Same number of dimensions: compare dimensions lexicographically */
-  for (i = 0; i < b1->num_dims; i++) {
+  for (int i = 0; i < b1->num_dims; i++) {
     intnat d1 = b1->dim[i];
     intnat d2 = b2->dim[i];
     if (d1 != d2) return d1 < d2 ? -1 : 1;
@@ -333,7 +330,7 @@ CAMLexport int caml_ba_compare(value v1, value v2)
 
 #define DO_INTEGER_COMPARISON(type) \
   { type * p1 = b1->data; type * p2 = b2->data; \
-    for (n = 0; n < num_elts; n++) { \
+    for (uintnat n = 0; n < num_elts; n++) { \
       type e1 = *p1++; type e2 = *p2++; \
       if (e1 < e2) return -1; \
       if (e1 > e2) return 1; \
@@ -342,7 +339,7 @@ CAMLexport int caml_ba_compare(value v1, value v2)
   }
 #define DO_GENERIC_UNORDERED_COMPARISON(ptype, etype, conv) \
   { ptype * p1 = b1->data; ptype * p2 = b2->data; \
-    for (n = 0; n < num_elts; n++) { \
+    for (uintnat n = 0; n < num_elts; n++) { \
       etype e1 = conv(*p1++); etype e2 = conv(*p2++); \
       if (e1 < e2) return -1; \
       if (e1 > e2) return 1; \
@@ -357,15 +354,15 @@ CAMLexport int caml_ba_compare(value v1, value v2)
 #define DO_FLOAT_COMPARISON(type) \
   DO_GENERIC_UNORDERED_COMPARISON(type, type, )
 
-  switch (b1->flags & CAML_BA_KIND_MASK) {
+  switch ((enum caml_ba_kind)(b1->flags & CAML_BA_KIND_MASK)) {
   case CAML_BA_FLOAT16:
     DO_GENERIC_UNORDERED_COMPARISON(uint16, float, caml_float16_to_float);
   case CAML_BA_COMPLEX32:
-    num_elts *= 2; /*fallthrough*/
+    num_elts *= 2; fallthrough;
   case CAML_BA_FLOAT32:
     DO_FLOAT_COMPARISON(float);
   case CAML_BA_COMPLEX64:
-    num_elts *= 2; /*fallthrough*/
+    num_elts *= 2; fallthrough;
   case CAML_BA_FLOAT64:
     DO_FLOAT_COMPARISON(double);
   case CAML_BA_CHAR:
@@ -385,9 +382,7 @@ CAMLexport int caml_ba_compare(value v1, value v2)
   case CAML_BA_CAML_INT:
   case CAML_BA_NATIVE_INT:
     DO_INTEGER_COMPARISON(intnat);
-  default:
-    CAMLassert(0);
-    return 0;                   /* should not happen */
+  default: CAMLunreachable();
   }
 #undef DO_INTEGER_COMPARISON
 #undef DO_FLOAT_COMPARISON
@@ -398,28 +393,27 @@ CAMLexport int caml_ba_compare(value v1, value v2)
 CAMLexport intnat caml_ba_hash(value v)
 {
   struct caml_ba_array * b = Caml_ba_array_val(v);
-  intnat num_elts, n;
+  intnat num_elts;
   uint32_t h, w;
-  int i;
 
   num_elts = 1;
-  for (i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
+  for (int i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
   h = 0;
 
-  switch (b->flags & CAML_BA_KIND_MASK) {
+  switch ((enum caml_ba_kind)(b->flags & CAML_BA_KIND_MASK)) {
   case CAML_BA_CHAR:
   case CAML_BA_SINT8:
   case CAML_BA_UINT8: {
     caml_ba_uint8 * p = b->data;
     if (num_elts > 256) num_elts = 256;
-    for (n = 0; n + 4 <= num_elts; n += 4, p += 4) {
+    for (intnat n = 0; n + 4 <= num_elts; n += 4, p += 4) {
       w = p[0] | (p[1] << 8) | (p[2] << 16) | (p[3] << 24);
       h = caml_hash_mix_uint32(h, w);
     }
     w = 0;
     switch (num_elts & 3) {
-    case 3: w  = p[2] << 16;    /* fallthrough */
-    case 2: w |= p[1] << 8;     /* fallthrough */
+    case 3: w  = p[2] << 16; fallthrough;
+    case 2: w |= p[1] << 8;  fallthrough;
     case 1: w |= p[0];
             h = caml_hash_mix_uint32(h, w);
     }
@@ -429,7 +423,7 @@ CAMLexport intnat caml_ba_hash(value v)
   case CAML_BA_UINT16: {
     caml_ba_uint16 * p = b->data;
     if (num_elts > 128) num_elts = 128;
-    for (n = 0; n + 2 <= num_elts; n += 2, p += 2) {
+    for (intnat n = 0; n + 2 <= num_elts; n += 2, p += 2) {
       w = p[0] | (p[1] << 16);
       h = caml_hash_mix_uint32(h, w);
     }
@@ -441,7 +435,7 @@ CAMLexport intnat caml_ba_hash(value v)
   {
     uint32_t * p = b->data;
     if (num_elts > 64) num_elts = 64;
-    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_uint32(h, *p);
+    for (intnat n = 0; n < num_elts; n++, p++) h = caml_hash_mix_uint32(h, *p);
     break;
   }
   case CAML_BA_CAML_INT:
@@ -449,41 +443,44 @@ CAMLexport intnat caml_ba_hash(value v)
   {
     intnat * p = b->data;
     if (num_elts > 64) num_elts = 64;
-    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_intnat(h, *p);
+    for (intnat n = 0; n < num_elts; n++, p++) h = caml_hash_mix_intnat(h, *p);
     break;
   }
   case CAML_BA_INT64:
   {
     int64_t * p = b->data;
     if (num_elts > 32) num_elts = 32;
-    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_int64(h, *p);
+    for (intnat n = 0; n < num_elts; n++, p++) h = caml_hash_mix_int64(h, *p);
     break;
   }
   case CAML_BA_FLOAT16:
   {
     uint16 * p = b->data;
     if (num_elts > 128) num_elts = 128;
-    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_float16(h, *p);
+    for (intnat n = 0; n < num_elts; n++, p++) h = caml_hash_mix_float16(h, *p);
     break;
   }
   case CAML_BA_COMPLEX32:
-    num_elts *= 2;              /* fallthrough */
+    num_elts *= 2;
+    fallthrough;
   case CAML_BA_FLOAT32:
   {
     float * p = b->data;
     if (num_elts > 64) num_elts = 64;
-    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_float(h, *p);
+    for (intnat n = 0; n < num_elts; n++, p++) h = caml_hash_mix_float(h, *p);
     break;
   }
   case CAML_BA_COMPLEX64:
-    num_elts *= 2;              /* fallthrough */
+    num_elts *= 2;
+    fallthrough;
   case CAML_BA_FLOAT64:
   {
     double * p = b->data;
     if (num_elts > 32) num_elts = 32;
-    for (n = 0; n < num_elts; n++, p++) h = caml_hash_mix_double(h, *p);
+    for (intnat n = 0; n < num_elts; n++, p++) h = caml_hash_mix_double(h, *p);
     break;
   }
+  default: CAMLunreachable();
   }
   return h;
 }
@@ -494,8 +491,7 @@ static void caml_ba_serialize_longarray(void * data,
 {
 #ifdef ARCH_SIXTYFOUR
   int overflow_32 = 0;
-  intnat * p, n;
-  for (n = 0, p = data; n < num_elts; n++, p++) {
+  for (intnat n = 0, *p = data; n < num_elts; n++, p++) {
     if (*p < min_val || *p > max_val) { overflow_32 = 1; break; }
   }
   if (overflow_32) {
@@ -503,7 +499,7 @@ static void caml_ba_serialize_longarray(void * data,
     caml_serialize_block_8(data, num_elts);
   } else {
     caml_serialize_int_1(0);
-    for (n = 0, p = data; n < num_elts; n++, p++)
+    for (intnat n = 0, *p = data; n < num_elts; n++, p++)
       caml_serialize_int_4((int32_t) *p);
   }
 #else
@@ -518,12 +514,11 @@ CAMLexport void caml_ba_serialize(value v,
 {
   struct caml_ba_array * b = Caml_ba_array_val(v);
   intnat num_elts;
-  int i;
 
   /* Serialize header information */
   caml_serialize_int_4(b->num_dims);
   caml_serialize_int_4(b->flags & (CAML_BA_KIND_MASK | CAML_BA_LAYOUT_MASK));
-  for (i = 0; i < b->num_dims; i++) {
+  for (int i = 0; i < b->num_dims; i++) {
     intnat len = b->dim[i];
     if (len < 0xffff) {
       caml_serialize_int_2(len);
@@ -534,9 +529,9 @@ CAMLexport void caml_ba_serialize(value v,
   }
   /* Compute total number of elements */
   num_elts = 1;
-  for (i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
+  for (int i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
   /* Serialize elements */
-  switch (b->flags & CAML_BA_KIND_MASK) {
+  switch ((enum caml_ba_kind)(b->flags & CAML_BA_KIND_MASK)) {
   case CAML_BA_CHAR:
   case CAML_BA_SINT8:
   case CAML_BA_UINT8:
@@ -556,15 +551,16 @@ CAMLexport void caml_ba_serialize(value v,
   case CAML_BA_COMPLEX64:
     caml_serialize_block_8(b->data, num_elts * 2); break;
   case CAML_BA_CAML_INT:
-    caml_ba_serialize_longarray(b->data, num_elts, -0x40000000, 0x3FFFFFFF);
+    caml_ba_serialize_longarray(b->data, num_elts, INT32_MIN/2, INT32_MAX/2);
     break;
   case CAML_BA_NATIVE_INT:
-    caml_ba_serialize_longarray(b->data, num_elts, -0x80000000, 0x7FFFFFFF);
+    caml_ba_serialize_longarray(b->data, num_elts, INT32_MIN, INT32_MAX);
     break;
+  default: CAMLunreachable();
   }
   /* Compute required size in OCaml heap.  Assumes struct caml_ba_array
      is exactly 4 + num_dims words */
-  CAMLassert(SIZEOF_BA_ARRAY == 4 * sizeof(value));
+  static_assert(SIZEOF_BA_ARRAY == 4 * sizeof(value), "");
   *wsize_32 = (4 + b->num_dims) * 4;
   *wsize_64 = (4 + b->num_dims) * 8;
 }
@@ -576,8 +572,7 @@ static void caml_ba_deserialize_longarray(void * dest, intnat num_elts)
   if (sixty) {
     caml_deserialize_block_8(dest, num_elts);
   } else {
-    intnat * p, n;
-    for (n = 0, p = dest; n < num_elts; n++, p++)
+    for (intnat n = 0, *p = dest; n < num_elts; n++, p++)
       *p = caml_deserialize_sint_4();
   }
 #else
@@ -591,7 +586,6 @@ static void caml_ba_deserialize_longarray(void * dest, intnat num_elts)
 CAMLexport uintnat caml_ba_deserialize(void * dst)
 {
   struct caml_ba_array * b = dst;
-  int i;
   uintnat num_elts, size;
 
   /* Read back header information */
@@ -600,14 +594,14 @@ CAMLexport uintnat caml_ba_deserialize(void * dst)
     caml_deserialize_error("input_value: wrong number of bigarray dimensions");
   b->flags = caml_deserialize_uint_4() | CAML_BA_MANAGED;
   b->proxy = NULL;
-  for (i = 0; i < b->num_dims; i++) {
+  for (int i = 0; i < b->num_dims; i++) {
     intnat len = caml_deserialize_uint_2();
     if (len == 0xffff) len = caml_deserialize_uint_8();
     b->dim[i] = len;
   }
   /* Compute total number of elements.  Watch out for overflows (MPR#7765). */
   num_elts = 1;
-  for (i = 0; i < b->num_dims; i++) {
+  for (int i = 0; i < b->num_dims; i++) {
     if (caml_umul_overflow(num_elts, b->dim[i], &num_elts))
       caml_deserialize_error("input_value: size overflow for bigarray");
   }
@@ -623,7 +617,7 @@ CAMLexport uintnat caml_ba_deserialize(void * dst)
   if (b->data == NULL)
     caml_deserialize_error("input_value: out of memory for bigarray");
   /* Read data */
-  switch (b->flags & CAML_BA_KIND_MASK) {
+  switch ((enum caml_ba_kind)(b->flags & CAML_BA_KIND_MASK)) {
   case CAML_BA_CHAR:
   case CAML_BA_SINT8:
   case CAML_BA_UINT8:
@@ -645,6 +639,7 @@ CAMLexport uintnat caml_ba_deserialize(void * dst)
   case CAML_BA_CAML_INT:
   case CAML_BA_NATIVE_INT:
     caml_ba_deserialize_longarray(b->data, num_elts); break;
+  default: CAMLunreachable();
   }
   /* PR#5516: use C99's flexible array types if possible */
   return SIZEOF_BA_ARRAY + b->num_dims * sizeof(intnat);
@@ -656,13 +651,13 @@ CAMLprim value caml_ba_create(value vkind, value vlayout, value vdim)
 {
   intnat dim[CAML_BA_MAX_NUM_DIMS];
   mlsize_t num_dims;
-  int i, flags;
+  int flags;
 
   num_dims = Wosize_val(vdim);
   /* here num_dims is unsigned (mlsize_t) so no need to check (num_dims >= 0) */
   if (num_dims > CAML_BA_MAX_NUM_DIMS)
     caml_invalid_argument("Bigarray.create: bad number of dimensions");
-  for (i = 0; i < num_dims; i++) {
+  for (int i = 0; i < num_dims; i++) {
     dim[i] = Long_val(Field(vdim, i));
     if (dim[i] < 0)
       caml_invalid_argument("Bigarray.create: negative dimension");
@@ -678,23 +673,25 @@ CAMLprim value caml_ba_create(value vkind, value vlayout, value vdim)
 static intnat caml_ba_offset(struct caml_ba_array * b, intnat * index)
 {
   intnat offset;
-  int i;
 
   offset = 0;
-  if ((b->flags & CAML_BA_LAYOUT_MASK) == CAML_BA_C_LAYOUT) {
+  switch ((enum caml_ba_layout)(b->flags & CAML_BA_LAYOUT_MASK)) {
+  case CAML_BA_C_LAYOUT:
     /* C-style layout: row major, indices start at 0 */
-    for (i = 0; i < b->num_dims; i++) {
+    for (int i = 0; i < b->num_dims; i++) {
       if ((uintnat) index[i] >= (uintnat) b->dim[i])
         caml_array_bound_error();
       offset = offset * b->dim[i] + index[i];
     }
-  } else {
+    break;
+  case CAML_BA_FORTRAN_LAYOUT:
     /* Fortran-style layout: column major, indices start at 1 */
-    for (i = b->num_dims - 1; i >= 0; i--) {
+    for (int i = b->num_dims - 1; i >= 0; i--) {
       if ((uintnat) (index[i] - 1) >= (uintnat) b->dim[i])
         caml_array_bound_error();
       offset = offset * b->dim[i] + (index[i] - 1);
     }
+    break;
   }
   return offset;
 }
@@ -715,7 +712,6 @@ value caml_ba_get_N(value vb, volatile value * vind, int nind)
 {
   struct caml_ba_array * b = Caml_ba_array_val(vb);
   intnat index[CAML_BA_MAX_NUM_DIMS];
-  int i;
   intnat offset;
 
   /* Check number of indices = number of dimensions of array
@@ -723,12 +719,10 @@ value caml_ba_get_N(value vb, volatile value * vind, int nind)
   if (nind != b->num_dims)
     caml_invalid_argument("Bigarray.get: wrong number of indices");
   /* Compute offset and check bounds */
-  for (i = 0; i < b->num_dims; i++) index[i] = Long_val(vind[i]);
+  for (int i = 0; i < b->num_dims; i++) index[i] = Long_val(vind[i]);
   offset = caml_ba_offset(b, index);
   /* Perform read */
-  switch ((b->flags) & CAML_BA_KIND_MASK) {
-  default:
-    CAMLassert(0);
+  switch ((enum caml_ba_kind)((b->flags) & CAML_BA_KIND_MASK)) {
   case CAML_BA_FLOAT16:
     return caml_copy_double(
       (double) caml_float16_to_float(((uint16 *) b->data)[offset]));
@@ -760,6 +754,7 @@ value caml_ba_get_N(value vb, volatile value * vind, int nind)
       return copy_two_doubles(p[0], p[1]); }
   case CAML_BA_CHAR:
     return Val_int(((unsigned char *) b->data)[offset]);
+  default: CAMLunreachable();
   }
 }
 
@@ -860,7 +855,6 @@ static value caml_ba_set_aux(value vb, volatile value * vind,
 {
   struct caml_ba_array * b = Caml_ba_array_val(vb);
   intnat index[CAML_BA_MAX_NUM_DIMS];
-  int i;
   intnat offset;
 
   /* Check number of indices = number of dimensions of array
@@ -868,12 +862,10 @@ static value caml_ba_set_aux(value vb, volatile value * vind,
   if (nind != b->num_dims)
     caml_invalid_argument("Bigarray.set: wrong number of indices");
   /* Compute offset and check bounds */
-  for (i = 0; i < b->num_dims; i++) index[i] = Long_val(vind[i]);
+  for (int i = 0; i < b->num_dims; i++) index[i] = Long_val(vind[i]);
   offset = caml_ba_offset(b, index);
   /* Perform write */
-  switch (b->flags & CAML_BA_KIND_MASK) {
-  default:
-    CAMLassert(0);
+  switch ((enum caml_ba_kind)(b->flags & CAML_BA_KIND_MASK)) {
   case CAML_BA_FLOAT16:
     ((uint16 *) b->data)[offset] =
       caml_float_to_float16(Double_val(newval)); break;
@@ -906,6 +898,7 @@ static value caml_ba_set_aux(value vb, volatile value * vind,
       p[0] = Double_flat_field(newval, 0);
       p[1] = Double_flat_field(newval, 1);
       break; }
+  default: CAMLunreachable();
   }
   return Val_unit;
 }
@@ -1107,7 +1100,7 @@ CAMLprim value caml_ba_slice(value vb, value vind)
   #define b (Caml_ba_array_val(vb))
   CAMLlocal1 (res);
   intnat index[CAML_BA_MAX_NUM_DIMS];
-  int num_inds, i;
+  int num_inds;
   intnat offset;
   intnat * sub_dims;
   char * sub_data;
@@ -1117,19 +1110,25 @@ CAMLprim value caml_ba_slice(value vb, value vind)
   if (num_inds > b->num_dims)
     caml_invalid_argument("Bigarray.slice: too many indices");
   /* Compute offset and check bounds */
-  if ((b->flags & CAML_BA_LAYOUT_MASK) == CAML_BA_C_LAYOUT) {
+  switch ((enum caml_ba_layout)(b->flags & CAML_BA_LAYOUT_MASK)) {
+  case CAML_BA_C_LAYOUT: {
+    int i;
     /* We slice from the left */
     for (i = 0; i < num_inds; i++) index[i] = Long_val(Field(vind, i));
     for (/*nothing*/; i < b->num_dims; i++) index[i] = 0;
     offset = caml_ba_offset(b, index);
     sub_dims = b->dim + num_inds;
-  } else {
+    break;
+  }
+  case CAML_BA_FORTRAN_LAYOUT:
     /* We slice from the right */
-    for (i = 0; i < num_inds; i++)
+    for (int i = 0; i < num_inds; i++)
       index[b->num_dims - num_inds + i] = Long_val(Field(vind, i));
-    for (i = 0; i < b->num_dims - num_inds; i++) index[i] = 1;
+    for (int i = 0; i < b->num_dims - num_inds; i++) index[i] = 1;
     offset = caml_ba_offset(b, index);
     sub_dims = b->dim;
+    break;
+  default: CAMLunreachable();
   }
   sub_data =
     (char *) b->data +
@@ -1161,8 +1160,8 @@ CAMLprim value caml_ba_change_layout(value vb, value vlayout)
                  | Caml_ba_layout_val(vlayout);
     /* reverse the dimensions */
     intnat new_dim[CAML_BA_MAX_NUM_DIMS];
-    unsigned int i;
-    for(i = 0; i < b->num_dims; i++) new_dim[i] = b->dim[b->num_dims - i - 1];
+    for (unsigned int i = 0; i < b->num_dims; i++)
+      new_dim[i] = b->dim[b->num_dims - i - 1];
     res = caml_ba_alloc(flags | CAML_BA_SUBARRAY,
                         b->num_dims, b->data, new_dim);
     /* Copy the finalization function from the original array (PR#8568) */
@@ -1186,22 +1185,26 @@ CAMLprim value caml_ba_sub(value vb, value vofs, value vlen)
   #define b (Caml_ba_array_val(vb))
   intnat ofs = Long_val(vofs);
   intnat len = Long_val(vlen);
-  int i, changed_dim;
+  int changed_dim;
   intnat mul;
   char * sub_data;
 
   /* Compute offset and check bounds */
-  if ((b->flags & CAML_BA_LAYOUT_MASK) == CAML_BA_C_LAYOUT) {
+  switch ((enum caml_ba_layout)(b->flags & CAML_BA_LAYOUT_MASK)) {
+  case CAML_BA_C_LAYOUT:
     /* We reduce the first dimension */
     mul = 1;
-    for (i = 1; i < b->num_dims; i++) mul *= b->dim[i];
+    for (int i = 1; i < b->num_dims; i++) mul *= b->dim[i];
     changed_dim = 0;
-  } else {
+    break;
+  case CAML_BA_FORTRAN_LAYOUT:
     /* We reduce the last dimension */
     mul = 1;
-    for (i = 0; i < b->num_dims - 1; i++) mul *= b->dim[i];
+    for (int i = 0; i < b->num_dims - 1; i++) mul *= b->dim[i];
     changed_dim = b->num_dims - 1;
     ofs--;                      /* Fortran arrays start at 1 */
+    break;
+  default: CAMLunreachable();
   }
   if (ofs < 0 || len < 0 || ofs + len > b->dim[changed_dim])
     caml_invalid_argument("Bigarray.sub: bad sub-array");
@@ -1235,13 +1238,12 @@ CAMLprim value caml_ba_blit(value vsrc, value vdst)
   struct caml_ba_array * dst = Caml_ba_array_val(vdst);
   void *src_data = src->data;
   void *dst_data = dst->data;
-  int i;
   intnat num_bytes;
   int leave_runtime;
 
   /* Check same numbers of dimensions and same dimensions */
   if (src->num_dims != dst->num_dims) goto blit_error;
-  for (i = 0; i < src->num_dims; i++)
+  for (int i = 0; i < src->num_dims; i++)
     if (src->dim[i] != dst->dim[i]) goto blit_error;
   /* Compute number of bytes in array data */
   num_bytes =
@@ -1272,13 +1274,13 @@ CAMLprim value caml_ba_blit(value vsrc, value vdst)
   if (leave_runtime) caml_leave_blocking_section();                          \
 }while(0)
 
-#define FILL_SCALAR_LOOP                                        \
+#define FILL_SCALAR_LOOP(T)                                     \
   FILL_GEN_LOOP(num_elts,                                       \
-    for (p = data; num_elts > 0; p++, num_elts--) *p = init)
+    for (T p = data; num_elts > 0; p++, num_elts--) *p = init)
 
-#define FILL_COMPLEX_LOOP                                                    \
+#define FILL_COMPLEX_LOOP(T)                                                 \
   FILL_GEN_LOOP(num_elts + num_elts,                                         \
-    for (p = data; num_elts > 0; num_elts--) { *p++ = init0; *p++ = init1; })
+    for (T p = data; num_elts > 0; num_elts--) { *p++ = init0; *p++ = init1; })
 
 CAMLprim value caml_ba_fill(value vb, value vinit)
 {
@@ -1287,80 +1289,68 @@ CAMLprim value caml_ba_fill(value vb, value vinit)
   void *data = b->data;
   intnat num_elts = caml_ba_num_elts(b);
 
-  switch (b->flags & CAML_BA_KIND_MASK) {
-  default:
-    CAMLassert(0);
+  switch ((enum caml_ba_kind)(b->flags & CAML_BA_KIND_MASK)) {
   case CAML_BA_FLOAT16: {
     uint16 init = caml_float_to_float16(Double_val(vinit));
-    uint16 * p;
-    FILL_SCALAR_LOOP;
+    FILL_SCALAR_LOOP(uint16 *);
     break;
   }
   case CAML_BA_FLOAT32: {
     float init = Double_val(vinit);
-    float * p;
-    FILL_SCALAR_LOOP;
+    FILL_SCALAR_LOOP(float *);
     break;
   }
   case CAML_BA_FLOAT64: {
     double init = Double_val(vinit);
-    double * p;
-    FILL_SCALAR_LOOP;
+    FILL_SCALAR_LOOP(double *);
     break;
   }
   case CAML_BA_CHAR:
   case CAML_BA_SINT8:
   case CAML_BA_UINT8: {
     int init = Int_val(vinit);
-    unsigned char * p;
-    FILL_SCALAR_LOOP;
+    FILL_SCALAR_LOOP(unsigned char *);
     break;
   }
   case CAML_BA_SINT16:
   case CAML_BA_UINT16: {
     int init = Int_val(vinit);
-    int16 * p;
-    FILL_SCALAR_LOOP;
+    FILL_SCALAR_LOOP(int16 *);
     break;
   }
   case CAML_BA_INT32: {
     int32_t init = Int32_val(vinit);
-    int32_t * p;
-    FILL_SCALAR_LOOP;
+    FILL_SCALAR_LOOP(int32_t *);
     break;
   }
   case CAML_BA_INT64: {
     int64_t init = Int64_val(vinit);
-    int64_t * p;
-    FILL_SCALAR_LOOP;
+    FILL_SCALAR_LOOP(int64_t *);
     break;
   }
   case CAML_BA_NATIVE_INT: {
     intnat init = Nativeint_val(vinit);
-    intnat * p;
-    FILL_SCALAR_LOOP;
+    FILL_SCALAR_LOOP(intnat *);
     break;
   }
   case CAML_BA_CAML_INT: {
     intnat init = Long_val(vinit);
-    intnat * p;
-    FILL_SCALAR_LOOP;
+    FILL_SCALAR_LOOP(intnat *);
     break;
   }
   case CAML_BA_COMPLEX32: {
     float init0 = Double_flat_field(vinit, 0);
     float init1 = Double_flat_field(vinit, 1);
-    float * p;
-    FILL_COMPLEX_LOOP;
+    FILL_COMPLEX_LOOP(float *);
     break;
   }
   case CAML_BA_COMPLEX64: {
     double init0 = Double_flat_field(vinit, 0);
     double init1 = Double_flat_field(vinit, 1);
-    double * p;
-    FILL_COMPLEX_LOOP;
+    FILL_COMPLEX_LOOP(double *);
     break;
   }
+  default: CAMLunreachable();
   }
   CAMLreturn (Val_unit);
 }
@@ -1376,14 +1366,13 @@ CAMLprim value caml_ba_reshape(value vb, value vdim)
   intnat dim[CAML_BA_MAX_NUM_DIMS];
   mlsize_t num_dims;
   uintnat num_elts;
-  int i;
 
   num_dims = Wosize_val(vdim);
   /* here num_dims is unsigned (mlsize_t) so no need to check (num_dims >= 0) */
   if (num_dims > CAML_BA_MAX_NUM_DIMS)
     caml_invalid_argument("Bigarray.reshape: bad number of dimensions");
   num_elts = 1;
-  for (i = 0; i < num_dims; i++) {
+  for (int i = 0; i < num_dims; i++) {
     dim[i] = Long_val(Field(vdim, i));
     if (dim[i] < 0)
       caml_invalid_argument("Bigarray.reshape: negative dimension");

diff --git a/runtime/blake2.c b/runtime/blake2.c
index dde68ee0f0093fa6af982cba71cf915434a77a50..a7f0a2dbcd2e3bc4624cb158ec702fd1fc5b49be 100644 (file)
--- a/runtime/blake2.c
+++ b/runtime/blake2.c
@@ -171,7 +171,8 @@ CAMLexport void
 caml_BLAKE2Final(struct BLAKE2_context * s,
                  size_t hashlen, unsigned char * hash)
 {
-  CAMLassert (0 < hashlen && hashlen <= 64);
+  CAMLassert(0 < hashlen);
+  CAMLassert(hashlen <= 64);
   /* The final block is composed of the remaining data padded with zeros. */
   memset(s->buffer + s->numbytes, 0, BLAKE2_BLOCKSIZE - s->numbytes);
   caml_BLAKE2Compress(s, s->buffer, s->numbytes, 1);
@@ -243,3 +244,9 @@ CAMLprim value caml_blake2_string(value hashlen, value key,
   caml_BLAKE2Final(&ctx, hlen, &Byte_u(hash, 0));
   return hash;
 }
+
+CAMLprim value caml_blake2_bytes(value hashlen, value key,
+                                  value buf, value ofs, value len)
+{
+  return caml_blake2_string(hashlen, key, buf, ofs, len);
+}

diff --git a/runtime/callback.c b/runtime/callback.c
index 4db417a12548e24410d8bc3c677d8ebe7c48b192..6e9d3dd46c21f2f75093c0e98b2b3c62a26fda26 100644 (file)
--- a/runtime/callback.c
+++ b/runtime/callback.c
@@ -55,20 +55,25 @@
 Caml_inline value alloc_and_clear_stack_parent(caml_domain_state* domain_state)
 {
   struct stack_info* parent_stack = Stack_parent(domain_state->current_stack);
-  value cont = caml_alloc_2(Cont_tag, Val_ptr(parent_stack), Val_long(0));
-  Stack_parent(domain_state->current_stack) = NULL;
-  return cont;
+  if (parent_stack == NULL) {
+    return Val_unit;
+  } else {
+    value cont = caml_alloc_2(Cont_tag, Val_ptr(parent_stack), Val_long(0));
+    Stack_parent(domain_state->current_stack) = NULL;
+    return cont;
+  }
 }
 
 Caml_inline void restore_stack_parent(caml_domain_state* domain_state,
                                       value cont)
 {
-  struct stack_info* parent_stack = Ptr_val(Op_val(cont)[0]);
   CAMLassert(Stack_parent(domain_state->current_stack) == NULL);
-  Stack_parent(domain_state->current_stack) = parent_stack;
+  if (Is_block(cont)) {
+    struct stack_info* parent_stack = Ptr_val(Op_val(cont)[0]);
+    Stack_parent(domain_state->current_stack) = parent_stack;
+  }
 }
 
-
 #ifndef NATIVE_CODE
 
 /* Bytecode callbacks */
@@ -294,27 +299,68 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[]) {
 
 #endif
 
+/* Result-returning variants of the above */
+
+Caml_inline caml_result Result_encoded(value encoded)
+{
+  if (Is_exception_result(encoded))
+    return Result_exception(Extract_exception(encoded));
+  else
+    return Result_value(encoded);
+}
+
+CAMLexport caml_result caml_callbackN_res(
+  value closure, int narg, value args[])
+{
+  return Result_encoded(caml_callbackN_exn(closure, narg, args));
+}
+
+CAMLexport caml_result caml_callback_res(
+  value closure, value arg)
+{
+  return Result_encoded(caml_callback_exn(closure, arg));
+}
+
+CAMLexport caml_result caml_callback2_res(
+  value closure, value arg1, value arg2)
+{
+  return Result_encoded(caml_callback2_exn(closure, arg1, arg2));
+}
+
+CAMLexport caml_result caml_callback3_res(
+  value closure, value arg1, value arg2, value arg3)
+{
+  return Result_encoded(caml_callback3_exn(closure, arg1, arg2, arg3));
+}
+
+
 /* Exception-propagating variants of the above */
 
+static value encoded_value_or_raise(value res)
+{
+  if (Is_exception_result(res)) caml_raise(Extract_exception(res));
+  return res;
+}
+
 CAMLexport value caml_callback (value closure, value arg)
 {
-  return caml_raise_if_exception(caml_callback_exn(closure, arg));
+  return encoded_value_or_raise(caml_callback_exn(closure, arg));
 }
 
 CAMLexport value caml_callback2 (value closure, value arg1, value arg2)
 {
-  return caml_raise_if_exception(caml_callback2_exn(closure, arg1, arg2));
+  return encoded_value_or_raise(caml_callback2_exn(closure, arg1, arg2));
 }
 
 CAMLexport value caml_callback3 (value closure, value arg1, value arg2,
                                  value arg3)
 {
-  return caml_raise_if_exception(caml_callback3_exn(closure, arg1, arg2, arg3));
+  return encoded_value_or_raise(caml_callback3_exn(closure, arg1, arg2, arg3));
 }
 
 CAMLexport value caml_callbackN (value closure, int narg, value args[])
 {
-  return caml_raise_if_exception(caml_callbackN_exn(closure, narg, args));
+  return encoded_value_or_raise(caml_callbackN_exn(closure, narg, args));
 }
 
 /* Naming of OCaml values */
@@ -340,14 +386,15 @@ static unsigned int hash_value_name(char const *name)
 
 CAMLprim value caml_register_named_value(value vname, value val)
 {
-  struct named_value * nv;
   const char * name = String_val(vname);
   size_t namelen = strlen(name);
   unsigned int h = hash_value_name(name);
   int found = 0;
 
-  caml_plat_lock(&named_value_lock);
-  for (nv = named_value_table[h]; nv != NULL; nv = nv->next) {
+  caml_plat_lock_blocking(&named_value_lock);
+  for (struct named_value *nv = named_value_table[h];
+       nv != NULL;
+       nv = nv->next) {
     if (strcmp(name, nv->name) == 0) {
       caml_modify_generational_global_root(&nv->val, val);
       found = 1;
@@ -355,7 +402,7 @@ CAMLprim value caml_register_named_value(value vname, value val)
     }
   }
   if (!found) {
-    nv = (struct named_value *)
+    struct named_value * nv = (struct named_value *)
       caml_stat_alloc(sizeof(struct named_value) + namelen);
     memcpy(nv->name, name, namelen + 1);
     nv->val = val;
@@ -369,9 +416,8 @@ CAMLprim value caml_register_named_value(value vname, value val)
 
 CAMLexport const value* caml_named_value(char const *name)
 {
-  struct named_value * nv;
-  caml_plat_lock(&named_value_lock);
-  for (nv = named_value_table[hash_value_name(name)];
+  caml_plat_lock_blocking(&named_value_lock);
+  for (struct named_value *nv = named_value_table[hash_value_name(name)];
        nv != NULL;
        nv = nv->next) {
     if (strcmp(name, nv->name) == 0){
@@ -385,11 +431,11 @@ CAMLexport const value* caml_named_value(char const *name)
 
 CAMLexport void caml_iterate_named_values(caml_named_action f)
 {
-  int i;
-  caml_plat_lock(&named_value_lock);
-  for(i = 0; i < Named_value_size; i++){
-    struct named_value * nv;
-    for (nv = named_value_table[i]; nv != NULL; nv = nv->next) {
+  caml_plat_lock_blocking(&named_value_lock);
+  for (int i = 0; i < Named_value_size; i++){
+    for (struct named_value *nv = named_value_table[i];
+         nv != NULL;
+         nv = nv->next) {
       f( Op_val(nv->val), nv->name );
     }
   }

diff --git a/runtime/caml/address_class.h b/runtime/caml/address_class.h
index 3ac411cda91c19866c7b62d83725e58e59c38d52..cd5a19fa25b7226d19cc1f153149ca5b5cead186 100644 (file)
--- a/runtime/caml/address_class.h
+++ b/runtime/caml/address_class.h
@@ -43,6 +43,10 @@
 #include "misc.h"
 #include "mlvalues.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 CAMLextern uintnat caml_minor_heaps_start;
 CAMLextern uintnat caml_minor_heaps_end;
 
@@ -59,4 +63,8 @@ CAMLextern uintnat caml_minor_heaps_end;
 #define Is_in_heap_or_young(a) 1
 #define Is_in_value_area(a) 1
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* CAML_ADDRESS_CLASS_H */

diff --git a/runtime/caml/addrmap.h b/runtime/caml/addrmap.h
index 64e4dacec8cebf19462223f65a5b8e6c0db7df6f..b1e418085560d3024bfdd7a7c09908f682230c7d 100644 (file)
--- a/runtime/caml/addrmap.h
+++ b/runtime/caml/addrmap.h
@@ -11,11 +11,16 @@
 /*   special exception on linking described in the file LICENSE.          */
 /*                                                                        */
 /**************************************************************************/
-#include "mlvalues.h"
 
 #ifndef CAML_ADDRMAP_H
 #define CAML_ADDRMAP_H
 
+#include "mlvalues.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 /* An addrmap is a value -> value hashmap, where
    the values are blocks */
 
@@ -94,5 +99,8 @@ Caml_inline addrmap_iterator caml_addrmap_iterator(struct addrmap* t)
   return caml_addrmap_next(t, (uintnat)(-1));
 }
 
-
+#ifdef __cplusplus
+}
 #endif
+
+#endif /* CAML_ADDRMAP_H */

diff --git a/runtime/caml/alloc.h b/runtime/caml/alloc.h
index 11339faf91f2dfa81775651fea9eec95debd320c..f4a6837dd026fccbfd490884c664e01d563d5d3c 100644 (file)
--- a/runtime/caml/alloc.h
+++ b/runtime/caml/alloc.h
@@ -16,7 +16,6 @@
 #ifndef CAML_ALLOC_H
 #define CAML_ALLOC_H
 
-
 #include "misc.h"
 #include "mlvalues.h"
 

diff --git a/runtime/caml/asm.h b/runtime/caml/asm.h
new file mode 100644 (file)
index 0000000..b3c9b2b
--- /dev/null
+++ b/runtime/caml/asm.h
@@ -0,0 +1,62 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           */
+/*             Bart Jacobs, KU Leuven                                     */
+/*             Tom Kelly, OCaml Labs Consultancy, UK                      */
+/*                                                                        */
+/*   Copyright 2012 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Call Frame Information directives */
+
+#ifdef ASM_CFI_SUPPORTED
+#define CFI_ADJUST(n)           .cfi_adjust_cfa_offset n
+#define CFI_DEF_CFA_OFFSET(n)   .cfi_def_cfa_offset n
+#define CFI_DEF_CFA_REGISTER(r) .cfi_def_cfa_register r
+#define CFI_ENDPROC             .cfi_endproc
+#define CFI_OFFSET(r, n)        .cfi_offset r, n
+#define CFI_REGISTER(r1, r2)    .cfi_register r1, r2
+#define CFI_REMEMBER_STATE      .cfi_remember_state
+#define CFI_RESTORE(r)          .cfi_restore r
+#define CFI_RESTORE_STATE       .cfi_restore_state
+#define CFI_SAME_VALUE(r)       .cfi_same_value r
+#define CFI_SIGNAL_FRAME        .cfi_signal_frame
+#define CFI_STARTPROC           .cfi_startproc
+#else
+#define CFI_ADJUST(n)
+#define CFI_DEF_CFA_OFFSET(n)
+#define CFI_DEF_CFA_REGISTER(r)
+#define CFI_ENDPROC
+#define CFI_OFFSET(r, n)
+#define CFI_REGISTER(r1, r2)
+#define CFI_REMEMBER_STATE
+#define CFI_RESTORE(r)
+#define CFI_RESTORE_STATE
+#define CFI_SAME_VALUE(r)
+#define CFI_SIGNAL_FRAME
+#define CFI_STARTPROC
+#endif
+
+/******************************************************************************/
+/* DWARF */
+/******************************************************************************/
+
+/* These constants are taken from:
+
+     DWARF Debugging Information Format, Version 3
+     http://dwarfstd.org/doc/Dwarf3.pdf
+
+ */
+
+#define DW_CFA_def_cfa_expression 0x0f
+#define DW_OP_breg                0x70
+#define DW_OP_deref               0x06
+#define DW_OP_plus_uconst         0x23

diff --git a/runtime/caml/backtrace.h b/runtime/caml/backtrace.h
index 85f48f8e717ce5b2f466353ba7d9662eda58e9ce..40bbb637d6f752976a7aa4de5d0e50bec98e4f76 100644 (file)
--- a/runtime/caml/backtrace.h
+++ b/runtime/caml/backtrace.h
@@ -18,6 +18,10 @@
 
 #include "mlvalues.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 /* [caml_record_backtraces] controls backtrace recording.
  * This function can be called at runtime by user-code, or during
  * initialization if backtraces were requested.
@@ -27,6 +31,10 @@
  */
 CAMLextern void caml_record_backtraces(int);
 
+#ifdef __cplusplus
+}
+#endif
+
 #ifdef CAML_INTERNALS
 
 #include "exec.h"

diff --git a/runtime/caml/bigarray.h b/runtime/caml/bigarray.h
index 5489433e8d61ae51615b9f3ef6cef710c07175fc..53d12e331f01251372fc469aaacdbb1fcd254b2d 100644 (file)
--- a/runtime/caml/bigarray.h
+++ b/runtime/caml/bigarray.h
@@ -21,15 +21,8 @@
 
 typedef signed char caml_ba_int8;
 typedef unsigned char caml_ba_uint8;
-#if defined(HAS_STDINT_H)
 typedef int16_t caml_ba_int16;
 typedef uint16_t caml_ba_uint16;
-#elif SIZEOF_SHORT == 2
-typedef short caml_ba_int16;
-typedef unsigned short caml_ba_uint16;
-#else
-#error "No 16-bit integer type available"
-#endif
 
 #define CAML_BA_MAX_NUM_DIMS 16
 
@@ -49,8 +42,8 @@ enum caml_ba_kind {
   CAML_BA_CHAR,                /* Characters */
   CAML_BA_FLOAT16,             /* Half-precision floats */
   CAML_BA_FIRST_UNIMPLEMENTED_KIND,
-  CAML_BA_KIND_MASK = 0xFF     /* Mask for kind in flags field */
 };
+#define CAML_BA_KIND_MASK 0xFF /* Mask for kind in flags field */
 
 #define Caml_ba_kind_val(v) Int_val(v)
 
@@ -59,9 +52,9 @@ enum caml_ba_kind {
 enum caml_ba_layout {
   CAML_BA_C_LAYOUT = 0,           /* Row major, indices start at 0 */
   CAML_BA_FORTRAN_LAYOUT = 0x100, /* Column major, indices start at 1 */
-  CAML_BA_LAYOUT_MASK = 0x100,    /* Mask for layout in flags field */
-  CAML_BA_LAYOUT_SHIFT = 8        /* Bit offset of layout flag */
 };
+#define CAML_BA_LAYOUT_SHIFT 8    /* Bit offset of layout flag */
+#define CAML_BA_LAYOUT_MASK 0x100 /* Mask for layout in flags field */
 
 #define Caml_ba_layout_val(v) (Int_val(v) << CAML_BA_LAYOUT_SHIFT)
 
@@ -71,8 +64,8 @@ enum caml_ba_managed {
   CAML_BA_EXTERNAL = 0,        /* Data is not allocated by OCaml */
   CAML_BA_MANAGED = 0x200,     /* Data is allocated by OCaml */
   CAML_BA_MAPPED_FILE = 0x400, /* Data is a memory mapped file */
-  CAML_BA_MANAGED_MASK = 0x600 /* Mask for "managed" bits in flags field */
 };
+#define CAML_BA_MANAGED_MASK 0x600 /* Mask for "managed" bits in flags field */
 
 enum caml_ba_subarray {
   CAML_BA_SUBARRAY = 0x800     /* Data is shared with another bigarray */
@@ -123,6 +116,6 @@ CAMLextern intnat caml_ba_hash(value v);
 CAMLextern void caml_ba_serialize(value, uintnat *, uintnat *);
 CAMLextern uintnat caml_ba_deserialize(void * dst);
 
-#endif
+#endif  /* CAML_INTERNALS */
 
 #endif /* CAML_BIGARRAY_H */

diff --git a/runtime/caml/callback.h b/runtime/caml/callback.h
index 805feebf09c3499ca226518bbb1267ce921d6910..b20d80cad04985870897715f5e296b5087ac193e 100644 (file)
--- a/runtime/caml/callback.h
+++ b/runtime/caml/callback.h
@@ -35,9 +35,22 @@ CAMLextern value caml_callback3 (value closure, value arg1, value arg2,
                                  value arg3);
 CAMLextern value caml_callbackN (value closure, int narg, value args[]);
 
-/* If the callback raises an exception, the functions
-   caml_callback{,2,3,N}_exn do not propagate it, they return the exception
-   as an 'encoded exceptional result value' (see mlvalues.h) */
+/* The functions caml_callback{,2,3,N}_res return
+   a caml_result structure containing either the value or an exception,
+   they do not propagate exceptions directly to their caller. */
+CAMLextern caml_result caml_callback_res (value closure, value arg);
+CAMLextern caml_result caml_callback2_res (
+  value closure, value arg1, value arg2);
+CAMLextern caml_result caml_callback3_res (
+  value closure, value arg1, value arg2, value arg3);
+CAMLextern caml_result caml_callbackN_res (
+  value closure, int narg, value args[]);
+
+/* These functions are similar to the caml_callback*_res variants
+   above, but they return an 'encoded exceptional value' (see mlvalues.h)
+   which represents either a value or an exception. This interface is unsafe
+   and it is easy to make mistakes due to the lack of type information,
+   we strongly recommend the *_res variants instead. */
 CAMLextern value caml_callback_exn (value closure, value arg);
 CAMLextern value caml_callback2_exn (value closure, value arg1, value arg2);
 CAMLextern value caml_callback3_exn (value closure,

diff --git a/runtime/caml/camlatomic.h b/runtime/caml/camlatomic.h
index 7206f0579ac0d939801e00db1ff48bda8da696a3..ea4f91bddebfc45a61b787a6b2f5483e58463272 100644 (file)
--- a/runtime/caml/camlatomic.h
+++ b/runtime/caml/camlatomic.h
@@ -13,22 +13,20 @@
 /*   special exception on linking described in the file LICENSE.          */
 /*                                                                        */
 /**************************************************************************/
+
 #ifndef CAML_ATOMIC_H
 #define CAML_ATOMIC_H
 
 #include "config.h"
 
-/* On platforms supporting C11 atomics, this file just includes <stdatomic.h>.
-
-   On other platforms, this file includes platform-specific stubs for
-   the subset of C11 atomics needed by the OCaml runtime
+/*
+ * C11 atomics types and utility macros.
  */
 
 #ifdef __cplusplus
 
 extern "C++" {
 #include <atomic>
-#define ATOMIC_UINTNAT_INIT(x) (x)
 typedef std::atomic<uintnat> atomic_uintnat;
 typedef std::atomic<intnat> atomic_intnat;
 using std::memory_order_relaxed;
@@ -38,48 +36,27 @@ using std::memory_order_acq_rel;
 using std::memory_order_seq_cst;
 }
 
-#elif defined(HAS_STDATOMIC_H)
+#else
 
 #include <stdatomic.h>
-#define ATOMIC_UINTNAT_INIT(x) (x)
 typedef _Atomic uintnat atomic_uintnat;
 typedef _Atomic intnat atomic_intnat;
 
-#elif defined(__GNUC__)
+#endif
 
-/* Support for versions of gcc which have built-in atomics but do not
-   expose stdatomic.h (e.g. gcc 4.8) */
-typedef enum memory_order {
-  memory_order_relaxed = __ATOMIC_RELAXED,
-  memory_order_acquire = __ATOMIC_ACQUIRE,
-  memory_order_release = __ATOMIC_RELEASE,
-  memory_order_acq_rel = __ATOMIC_ACQ_REL,
-  memory_order_seq_cst = __ATOMIC_SEQ_CST
-} memory_order;
+#ifdef CAML_INTERNALS
 
-#define ATOMIC_UINTNAT_INIT(x) { (x) }
-typedef struct { uintnat repr; } atomic_uintnat;
-typedef struct { intnat repr; } atomic_intnat;
+/* Loads and stores with acquire, release and relaxed semantics */
 
-#define atomic_load_explicit(x, m) __atomic_load_n(&(x)->repr, (m))
-#define atomic_load(x) atomic_load_explicit((x), memory_order_seq_cst)
-#define atomic_store_explicit(x, v, m) __atomic_store_n(&(x)->repr, (v), (m))
-#define atomic_store(x, v) atomic_store_explicit((x), (v), memory_order_seq_cst)
-#define atomic_compare_exchange_strong(x, oldv, newv) \
-  __atomic_compare_exchange_n( \
-    &(x)->repr, \
-    (oldv), (newv), 0, \
-    memory_order_seq_cst, memory_order_seq_cst)
-#define atomic_exchange(x, newv) \
-  __atomic_exchange_n(&(x)->repr, (newv), memory_order_seq_cst)
-#define atomic_fetch_add(x, n) \
-  __atomic_fetch_add(&(x)->repr, (n), memory_order_seq_cst)
-#define atomic_fetch_or(x, n) \
-  __atomic_fetch_or(&(x)->repr, (n), memory_order_seq_cst)
-#define atomic_thread_fence __atomic_thread_fence
+#define atomic_load_acquire(p)                    \
+  atomic_load_explicit((p), memory_order_acquire)
+#define atomic_load_relaxed(p)                    \
+  atomic_load_explicit((p), memory_order_relaxed)
+#define atomic_store_release(p, v)                      \
+  atomic_store_explicit((p), (v), memory_order_release)
+#define atomic_store_relaxed(p, v)                      \
+  atomic_store_explicit((p), (v), memory_order_relaxed)
 
-#else
-#error "C11 atomics are unavailable on this platform. See camlatomic.h"
-#endif
+#endif /* CAML_INTERNALS */
 
 #endif /* CAML_ATOMIC_H */

diff --git a/runtime/caml/codefrag.h b/runtime/caml/codefrag.h
index d0f9a629cf0180e825a08afb8db0c11a6f73f494..e04435951d479da102a919b8bbc331a9543cfa3c 100644 (file)
--- a/runtime/caml/codefrag.h
+++ b/runtime/caml/codefrag.h
@@ -90,6 +90,6 @@ extern unsigned char * caml_digest_of_code_fragment(struct code_fragment *);
 /* Cleans up (and frees) removed code fragments. */
 extern void caml_code_fragment_cleanup_from_stw_single(void);
 
-#endif
+#endif /* CAML_INTERNALS */
 
-#endif
+#endif /* CAML_CODEFRAG_H */

diff --git a/runtime/caml/compatibility.h b/runtime/caml/compatibility.h
new file mode 100644 (file)
index 0000000..5cfc12f
--- /dev/null
+++ b/runtime/caml/compatibility.h
@@ -0,0 +1,31 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                         Antonin Decimo, Tarides                        */
+/*                                                                        */
+/*   Copyright 2024 Tarides                                               */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+/* Definitions for compatibility with old identifiers. */
+
+#ifndef CAML_COMPATIBILITY_H
+#define CAML_COMPATIBILITY_H
+
+#define HAS_STDINT_H 1 /* Deprecated since OCaml 5.3 */
+
+/* HAS_NANOSECOND_STAT is deprecated since OCaml 5.3 */
+#if defined(HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC)
+#  define HAS_NANOSECOND_STAT 1
+#elif defined(HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC)
+#  define HAS_NANOSECOND_STAT 2
+#elif defined(HAVE_STRUCT_STAT_ST_ATIMENSEC)
+#  define HAS_NANOSECOND_STAT 3
+#endif
+
+#endif  /* CAML_COMPATIBILITY_H */

diff --git a/runtime/caml/config.h b/runtime/caml/config.h
index 3fea87d8ebf7a8c7f72d54c1c06bf1f6137e2248..5aa62d6714b63897c76a0c32735963824587318d 100644 (file)
--- a/runtime/caml/config.h
+++ b/runtime/caml/config.h
@@ -16,6 +16,10 @@
 #ifndef CAML_CONFIG_H
 #define CAML_CONFIG_H
 
+#include "m.h"
+#include "s.h"
+#include "compatibility.h"
+
 /* CAML_NAME_SPACE was introduced in OCaml 3.08 to declare compatibility with
    the newly caml_-prefixed names of C runtime functions and to disable the
    definition of compatibility macros for the un-prefixed names. The
@@ -25,8 +29,6 @@
 #define CAML_NAME_SPACE
 #endif
 
-#include "m.h"
-
 /* If supported, tell gcc that we can use 32-bit code addresses for
  * threaded code, unless we are compiled for a shared library (-fPIC option) */
 #ifdef HAS_ARCH_CODE32
@@ -38,25 +40,18 @@
 /* No longer used in the codebase, but kept because it was exported */
 #define INT64_LITERAL(s) s ## LL
 
-#if defined(_MSC_VER) && !defined(__cplusplus)
-#define Caml_inline static __inline
-#else
 #define Caml_inline static inline
-#endif
-
-#include "s.h"
 
 #ifndef CAML_CONFIG_H_NO_TYPEDEFS
 
 #include <stddef.h>
+#include <limits.h>
 
 #if defined(HAS_LOCALE_H) || defined(HAS_XLOCALE_H)
 #define HAS_LOCALE
 #endif
 
-#ifdef HAS_STDINT_H
 #include <stdint.h>
-#endif
 
 /* Disable the mingw-w64 *printf shims */
 #if defined(CAML_INTERNALS) && defined(__MINGW32__)
@@ -71,7 +66,7 @@
   #define __USE_MINGW_ANSI_STDIO 0
 #endif
 
-#if defined(__MINGW32__) || (defined(_MSC_VER) && _MSC_VER < 1800)
+#if defined(__MINGW32__)
 #define ARCH_SIZET_PRINTF_FORMAT "I"
 #else
 #define ARCH_SIZET_PRINTF_FORMAT "z"
@@ -98,7 +93,7 @@
 #endif
 #endif
 
-#if defined(__MINGW32__) && !__USE_MINGW_ANSI_STDIO
+#if defined(__MINGW32__) && !__USE_MINGW_ANSI_STDIO && !defined(_UCRT)
   #define ARCH_INT64_TYPE long long
   #define ARCH_UINT64_TYPE unsigned long long
   #define ARCH_INT64_PRINTF_FORMAT "I64"
@@ -120,21 +115,6 @@
   #endif
 #endif
 
-#ifndef HAS_STDINT_H
-/* Not a C99 compiler, typically MSVC.  Define the C99 types we use. */
-typedef ARCH_INT32_TYPE int32_t;
-typedef ARCH_UINT32_TYPE uint32_t;
-typedef ARCH_INT64_TYPE int64_t;
-typedef ARCH_UINT64_TYPE uint64_t;
-#if SIZEOF_SHORT == 2
-typedef short int16_t;
-typedef unsigned short uint16_t;
-#else
-#error "No 16-bit integer type available"
-#endif
-typedef unsigned char uint8_t;
-#endif
-
 #if SIZEOF_PTR == SIZEOF_LONG
 /* Standard models: ILP32 or I32LP64 */
 typedef long intnat;
@@ -154,7 +134,10 @@ typedef uint64_t uintnat;
 #error "No integer type available to represent pointers"
 #endif
 
-#define UINTNAT_MAX ((uintnat)-1)
+#define CAML_INTNAT_MIN INTPTR_MIN
+#define CAML_INTNAT_MAX INTPTR_MAX
+#define CAML_UINTNAT_MIN UINTPTR_MIN
+#define CAML_UINTNAT_MAX UINTPTR_MAX
 
 #endif /* CAML_CONFIG_H_NO_TYPEDEFS */
 
@@ -174,11 +157,9 @@ typedef uint64_t uintnat;
 #endif
 
 
-/* We use threaded code interpretation if the compiler provides labels
-   as first-class values (GCC 2.x). */
-
-#if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) \
-    && !defined (SHRINKED_GNUC)
+/* We use threaded code interpretation if the C compiler supports the labels as
+   values extension. */
+#if defined(HAVE_LABELS_AS_VALUES) && !defined(DEBUG)
 #define THREADED_CODE
 #endif
 

diff --git a/runtime/caml/custom.h b/runtime/caml/custom.h
index 3731b900dc5ddbb36a79f64662b87ba389fe66ae..cea9d3ae13573f6dc34406658af8796916c70d0f 100644 (file)
--- a/runtime/caml/custom.h
+++ b/runtime/caml/custom.h
@@ -51,7 +51,6 @@ struct custom_operations {
 extern "C" {
 #endif
 
-
 CAMLextern uintnat caml_custom_major_ratio;
 
 CAMLextern value caml_alloc_custom(const struct custom_operations * ops,
@@ -76,6 +75,10 @@ CAMLextern mlsize_t caml_custom_get_max_major (void);
 /* Global variable moved to Caml_state in 4.10 */
 #define caml_compare_unordered (Caml_state_field(compare_unordered))
 
+#ifdef __cplusplus
+}
+#endif
+
 #ifdef CAML_INTERNALS
 extern struct custom_operations *
           caml_find_custom_operations(const char * ident);
@@ -90,8 +93,4 @@ extern const struct custom_operations caml_int64_ops;
 extern const struct custom_operations caml_ba_ops;
 #endif /* CAML_INTERNALS */
 
-#ifdef __cplusplus
-}
-#endif
-
 #endif /* CAML_CUSTOM_H */

diff --git a/runtime/caml/domain.h b/runtime/caml/domain.h
index 4b9be80b41bdbcf21d43839a112ab0a938a80f19..7d3337e4c7cdcb1946b83aba680ce91f1fe7c5b8 100644 (file)
--- a/runtime/caml/domain.h
+++ b/runtime/caml/domain.h
@@ -17,26 +17,23 @@
 #ifndef CAML_DOMAIN_H
 #define CAML_DOMAIN_H
 
-#ifdef __cplusplus
-extern "C" {
-#endif
-
 #ifdef CAML_INTERNALS
 
 #include "camlatomic.h"
 #include "config.h"
 #include "mlvalues.h"
 #include "domain_state.h"
-#include "platform.h"
 
-/* The runtime currently has a hard limit on the number of domains.
-   This hard limit may go away in the future. */
 #ifdef ARCH_SIXTYFOUR
-#define Max_domains 128
+#define Max_domains_def 128
 #else
-#define Max_domains 16
+#define Max_domains_def 16
 #endif
 
+/* Upper limit for the number of domains. Chosen to be arbitrarily large. Used
+ * for sanity checking [max_domains] value in OCAMLRUNPARAM. */
+#define Max_domains_max 4096
+
 /* is the minor heap full or an external interrupt has been triggered */
 Caml_inline int caml_check_gc_interrupt(caml_domain_state * dom_st)
 {
@@ -86,7 +83,7 @@ CAMLextern void (*caml_domain_initialize_hook)(void);
 CAMLextern void (*caml_domain_stop_hook)(void);
 CAMLextern void (*caml_domain_external_interrupt_hook)(void);
 
-CAMLextern void caml_init_domains(uintnat minor_heap_wsz);
+CAMLextern void caml_init_domains(uintnat max_domains, uintnat minor_heap_wsz);
 CAMLextern void caml_init_domain_self(int);
 
 CAMLextern uintnat caml_minor_heap_max_wsz;
@@ -98,16 +95,32 @@ Caml_inline intnat caml_domain_alone(void)
   return atomic_load_acquire(&caml_num_domains_running) == 1;
 }
 
+/* The index of the current domain. It is an integer unique among
+   currently-running domains, in the interval [0; N-1] where N is the
+   peak number of domains running simultaneously so far. The index of
+   a terminated domain may be reused for a new domain.
+
+   This function requires the domain lock to be held.
+*/
+Caml_inline int caml_domain_index(void)
+{
+  return Caml_state->id;
+}
+
 #ifdef DEBUG
 int caml_domain_is_in_stw(void);
 #endif
 
+int caml_domain_terminating(caml_domain_state *);
+int caml_domain_is_terminating(void);
+
 int caml_try_run_on_all_domains_with_spin_work(
   int sync,
   void (*handler)(caml_domain_state*, void*, int, caml_domain_state**),
   void* data,
   void (*leader_setup)(caml_domain_state*),
-  void (*enter_spin_callback)(caml_domain_state*, void*),
+  /* return nonzero if there may still be useful work to do while spinning */
+  int (*enter_spin_callback)(caml_domain_state*, void*),
   void* enter_spin_data);
 int caml_try_run_on_all_domains(
   void (*handler)(caml_domain_state*, void*, int, caml_domain_state**),
@@ -120,7 +133,7 @@ int caml_try_run_on_all_domains(
    [caml_try_run_on_all_domains*] runners, it will
    run on all participant domains in parallel.
 
-   The "STW critical section" is the runtime interval betweeen the
+   The "STW critical section" is the runtime interval between the
    start of the execution of the STW callback and the last barrier in
    the callback. During this interval, mutator code from registered
    participants cannot be running in parallel.
@@ -168,21 +181,55 @@ int caml_try_run_on_all_domains(
 */
 
 
-/* barriers */
-typedef uintnat barrier_status;
-void caml_global_barrier(void);
-barrier_status caml_global_barrier_begin(void);
-int caml_global_barrier_is_final(barrier_status);
-void caml_global_barrier_end(barrier_status);
-int caml_global_barrier_num_domains(void);
+/* Barriers */
 
-int caml_domain_terminating(caml_domain_state *);
-int caml_domain_is_terminating(void);
-
-#endif /* CAML_INTERNALS */
+/* Get the number of parties expected to arrive into the barrier, i.e. the
+   number of domains participating in the STW section. In most cases the barrier
+   is used directly from an STW callback that already has the number of
+   participating domains at hand, which should be used instead. */
+int caml_global_barrier_num_participating(void);
 
-#ifdef __cplusplus
+/* Unconditionally arrive at the barrier and wait for all parties,
+   [caml_global_barrier] below should be used instead. */
+void caml_enter_global_barrier(int num_participating);
+/* Arrive at the barrier and wait iff there is more than one party */
+Caml_inline void caml_global_barrier(int num_participating) {
+  if (num_participating != 1) caml_enter_global_barrier(num_participating);
 }
-#endif
+
+typedef uintnat barrier_status;
+/* Arrive at the barrier; if we are the final party, immediately returns a
+   nonzero value to be passed to [caml_global_barrier_release_as_final]
+   later, otherwise blocks and returns zero. */
+barrier_status caml_global_barrier_and_check_final(int num_participating);
+/* Release the barrier with the given status */
+void caml_global_barrier_release_as_final(barrier_status status);
+/* Arrive at the global barrier and run the body if we are the final party.
+   Other threads will not be released from the barrier until the final party
+   finishes executing the body.
+
+   Example usage:
+
+   Caml_global_barrier_if_final(num_participating) {
+     do_something_in_final_domain();
+   }
+
+   Note: this expands to an [if] and [for] header, do not exit the body using
+   jumps or returns, and do not put an [else] immediately after.
+ */
+#define Caml_global_barrier_if_final(num_participating)                 \
+  /* fast path when alone */                                            \
+  int CAML_GENSYM(alone) = (num_participating) == 1;                    \
+  barrier_status CAML_GENSYM(b) = 0;                                    \
+  if (CAML_GENSYM(alone) ||                                             \
+      (CAML_GENSYM(b)                                                   \
+       = caml_global_barrier_and_check_final(num_participating)))       \
+    for (int CAML_GENSYM(continue) = 1; CAML_GENSYM(continue);          \
+         /* release the barrier after the body has executed once */     \
+         ((CAML_GENSYM(alone) ? (void)0 :                               \
+           caml_global_barrier_release_as_final(CAML_GENSYM(b))),       \
+          CAML_GENSYM(continue) = 0))
+
+#endif /* CAML_INTERNALS */
 
 #endif /* CAML_DOMAIN_H */

diff --git a/runtime/caml/domain_state.h b/runtime/caml/domain_state.h
index a89ae738b94518ee42b6266e78075108db13301b..89d62f33c554ab06677d2b8a19502586e109244b 100644 (file)
--- a/runtime/caml/domain_state.h
+++ b/runtime/caml/domain_state.h
@@ -22,6 +22,10 @@
 
 #include "misc.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 #define NUM_EXTRA_PARAMS 64
 typedef value extra_params_area[NUM_EXTRA_PARAMS];
 
@@ -67,4 +71,8 @@ CAMLnoret CAMLextern void caml_bad_caml_state(void);
 
 #define Caml_state_field(field) (Caml_state->field)
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* CAML_STATE_H */

diff --git a/runtime/caml/domain_state.tbl b/runtime/caml/domain_state.tbl
index 4d97da43e07244d2d17529faa38761a3828556a2..bbb956f2de98ce2cd4a0ddfcf06f72d19a420da3 100644 (file)
--- a/runtime/caml/domain_state.tbl
+++ b/runtime/caml/domain_state.tbl
@@ -74,6 +74,12 @@ DOMAIN_STATE(uintnat, sweeping_done)
 /* Is sweeping done for the current major cycle. */
 
 DOMAIN_STATE(uintnat, allocated_words)
+/* Number of words promoted or allocated directly to the major heap since
+   latest slice. */
+
+DOMAIN_STATE(uintnat, allocated_words_direct)
+/* Number of words allocated directly to the major heap since the latest
+   slice. (subset of allocated_words) */
 
 DOMAIN_STATE(uintnat, swept_words)
 
@@ -141,12 +147,15 @@ DOMAIN_STATE(struct caml_intern_state*, intern_state)
 /* These stats represent only the current domain's respective values. */
 /* Use the Gc module to get aggregated total program stats. */
 /*****************************************************************************/
+
 DOMAIN_STATE(uintnat, stat_minor_words)
 DOMAIN_STATE(uintnat, stat_promoted_words)
 DOMAIN_STATE(uintnat, stat_major_words)
 DOMAIN_STATE(intnat, stat_forced_major_collections)
 DOMAIN_STATE(uintnat, stat_blocks_marked)
 
+/*****************************************************************************/
+
 DOMAIN_STATE(int, inside_stw_handler)
 /* whether or not a domain is inside of a stop-the-world handler
    this is used for several debug assertions inside of methods

diff --git a/runtime/caml/fail.h b/runtime/caml/fail.h
index 4652bb896920c9e9542369e15468ada0cb5db1f4..4389240dae667ca05b207252b0074ddc0c853ea1 100644 (file)
--- a/runtime/caml/fail.h
+++ b/runtime/caml/fail.h
@@ -73,49 +73,84 @@ struct caml_exception_context {
 
 int caml_is_special_exception(value exn);
 
-CAMLextern value caml_raise_if_exception(value res);
-
 #endif /* CAML_INTERNALS */
 
 #ifdef __cplusplus
 extern "C" {
 #endif
 
-CAMLnoret CAMLextern void caml_raise (value bucket);
-
-CAMLnoret CAMLextern void caml_raise_constant (value tag);
-
-CAMLnoret CAMLextern void caml_raise_with_arg (value tag, value arg);
-
-CAMLnoret CAMLextern
-void caml_raise_with_args (value tag, int nargs, value arg[]);
-
-CAMLnoret CAMLextern void caml_raise_with_string (value tag, char const * msg);
-
+/* The following functions raise immediately into OCaml.
+
+   The argument [exn_constr] can be obtained using [caml_named_value]
+   from caml/callback.h after registering and naming an exception from
+   OCaml using [Callback.register_exception].
+*/
+CAMLnoret CAMLextern void caml_raise (value exception);
+CAMLnoret CAMLextern void caml_raise_constant (value exn_constr);
+CAMLnoret CAMLextern void caml_raise_with_arg (value exn_constr, value arg);
+CAMLnoret CAMLextern void caml_raise_with_args (value exn_constr,
+                                                int nargs, value arg[]);
+CAMLnoret CAMLextern void caml_raise_with_string (value exn_constr,
+                                                  char const * msg);
 CAMLnoret CAMLextern void caml_failwith (char const *msg);
-
 CAMLnoret CAMLextern void caml_failwith_value (value msg);
-
 CAMLnoret CAMLextern void caml_invalid_argument (char const *msg);
-
 CAMLnoret CAMLextern void caml_invalid_argument_value (value msg);
-
 CAMLnoret CAMLextern void caml_raise_out_of_memory (void);
-
 CAMLnoret CAMLextern void caml_raise_stack_overflow (void);
-
 CAMLnoret CAMLextern void caml_raise_sys_error (value);
-
 CAMLnoret CAMLextern void caml_raise_end_of_file (void);
-
 CAMLnoret CAMLextern void caml_raise_zero_divide (void);
-
 CAMLnoret CAMLextern void caml_raise_not_found (void);
-
 CAMLnoret CAMLextern void caml_array_bound_error (void);
-
 CAMLnoret CAMLextern void caml_raise_sys_blocked_io (void);
 
+/* Non-raising variants of the above functions. The exception is
+   returned as a normal value, which can be raised with [caml_raise],
+   or returned as a value of type [caml_result] using
+   [Result_exception], typically to allow resource clean-up before
+   raising the exception. */
+CAMLextern value caml_exception_constant (value exn_constr);
+CAMLextern value caml_exception_with_arg (value exn_constr, value arg);
+CAMLextern value caml_exception_with_args (value exn_constr,
+                                           int nargs, value arg[]);
+CAMLextern value caml_exception_with_string (value exn_constr,
+                                             char const * msg);
+CAMLextern value caml_exception_failure (char const *msg);
+CAMLextern value caml_exception_failure_value (value msg);
+CAMLextern value caml_exception_invalid_argument (char const *msg);
+CAMLextern value caml_exception_invalid_argument_value (value msg);
+CAMLextern value caml_exception_out_of_memory (void);
+CAMLextern value caml_exception_stack_overflow (void);
+CAMLextern value caml_exception_sys_error (value msg);
+CAMLextern value caml_exception_end_of_file (void);
+CAMLextern value caml_exception_zero_divide (void);
+CAMLextern value caml_exception_not_found (void);
+CAMLextern value caml_exception_array_bound_error (void);
+CAMLextern value caml_exception_sys_blocked_io (void);
+
+/* Returns the value of a [caml_result] or raises the exception.
+   This function replaced [caml_raise_if_exception] in 5.3. */
+Caml_inline value caml_get_value_or_raise (struct caml_result_private result)
+{
+  if (result.is_exception)
+    caml_raise(result.data);
+  else
+    return result.data;
+}
+
+#ifdef CAML_INTERNALS
+/* internals only, provided for backward-compatibility */
+Caml_inline value caml_result_get_encoded_exception(
+  struct caml_result_private result)
+{
+  if (result.is_exception)
+    return Make_exception_result(result.data);
+  else
+    return result.data;
+}
+#endif /* CAML_INTERNALS */
+
 #ifdef __cplusplus
 }
 #endif

diff --git a/runtime/caml/finalise.h b/runtime/caml/finalise.h
index 16d845b73155141d561e0c8e875c1b1f123e275f..3ecb23fc112df082296799244abfac0b75b93468 100644 (file)
--- a/runtime/caml/finalise.h
+++ b/runtime/caml/finalise.h
@@ -71,7 +71,7 @@ void caml_final_merge_finalisable (struct finalisable *source,
                                    struct finalisable *target);
 int caml_final_update_first (caml_domain_state* d);
 int caml_final_update_last (caml_domain_state* d);
-value caml_final_do_calls_exn (void);
+caml_result caml_final_do_calls_res (void);
 void caml_final_do_roots (
   scanning_action f, scanning_action_flags fflags, void* fdata,
   caml_domain_state* domain, int do_val);

diff --git a/runtime/caml/fix_code.h b/runtime/caml/fix_code.h
index 2eafaa814bbad6aee6ded400465dee615e0a37cb..1c16845d9452f5e37951762454a4884b1d45f548 100644 (file)
--- a/runtime/caml/fix_code.h
+++ b/runtime/caml/fix_code.h
@@ -34,7 +34,8 @@ void caml_set_instruction (code_t pos, opcode_t instr);
 int caml_is_instruction (opcode_t instr1, opcode_t instr2);
 
 #ifdef THREADED_CODE
-void caml_init_thread_code(void ** instr_table, void * instr_base);
+void caml_init_thread_code(const void * const * instr_table,
+                           const void * instr_base);
 void caml_thread_code (code_t code, asize_t len);
 #endif
 

diff --git a/runtime/caml/frame_descriptors.h b/runtime/caml/frame_descriptors.h
index 0c15ce911ff632067e1beaef6a236b5cc23dca23..67a407e7536dfc2479ba7506aeb5ce42fb6ee58b 100644 (file)
--- a/runtime/caml/frame_descriptors.h
+++ b/runtime/caml/frame_descriptors.h
@@ -100,13 +100,28 @@ Caml_inline bool frame_has_debug(frame_descr *d) {
 /* Used to compute offsets in frame tables.
    ty must have power-of-2 size */
 #define Align_to(p, ty) \
-  (void*)(((uintnat)(p) + sizeof(ty) - 1) & -sizeof(ty))
+  (void*)(((uintnat)(p) + sizeof(ty) - 1) & ~(sizeof(ty) - 1))
 
 #define Hash_retaddr(addr, mask)                          \
   (((uintnat)(addr) >> 3) & (mask))
 
 void caml_init_frame_descriptors(void);
+
 void caml_register_frametables(void **tables, int ntables);
+void caml_register_frametable(void *table);
+
+/* Create copies of the frametables and register them in the runtime.
+   It writes back the pointers of the new copies of the frametables.
+   Calling 'caml_unregister_frametable(s)' on these copies is safe
+   and will free the allocated memory. */
+void caml_copy_and_register_frametables(void **table, int *sizes, int ntables);
+void* caml_copy_and_register_frametable(void *table, int size);
+
+/* The unregistered frametables can still be in use after calling
+   this function. Thus, you should not free their memory.
+   Note: it may reorder the content of the array 'tables' */
+void caml_unregister_frametables(void **tables, int ntables);
+void caml_unregister_frametable(void *table);
 
 /* a linked list of frametables */
 typedef struct caml_frametable_list {
@@ -115,44 +130,20 @@ typedef struct caml_frametable_list {
 } caml_frametable_list;
 
 /* a hashtable of frame descriptors */
-typedef struct {
-  int num_descr;
-  int mask;
-  frame_descr** descriptors;
-  caml_frametable_list *frametables;
-} caml_frame_descrs;
-/* Let us call 'capacity' the length of the descriptors array.
-
-   We maintain the following invariants:
-     capacity = mask + 1
-     capacity = 0 || Is_power_of_2(capacity)
-     num_desc <= 2 * num_descr <= capacity
-
-   For an extensible array we would maintain
-      num_desc <= capacity,
-    but this is a linear-problem hash table, we need to ensure that
-    free slots are frequent enough, so we use a twice-larger capacity:
-      num_desc * 2 <= capacity
-
-   We keep the list of frametables that was used to build the hashtable.
-   We use it when rebuilding the table after resizing.
-
-   Some frame tables in the list may have been unregistered after the
-   hashtable was built, so in general [num_descrs] is an over-approximation
-   of the true number of frame descriptors in the [list].
-*/
-
-caml_frame_descrs caml_get_frame_descrs(void);
+typedef struct caml_frame_descrs caml_frame_descrs;
+
+caml_frame_descrs* caml_get_frame_descrs(void);
 
 /* Find the current table of frame descriptors.
    The resulting structure is only valid until the next GC */
-frame_descr* caml_find_frame_descr(caml_frame_descrs fds, uintnat pc);
+frame_descr* caml_find_frame_descr(caml_frame_descrs *fds, uintnat pc);
 
 
 /* Returns the next frame descriptor (or NULL if none is available),
    and updates *pc and *sp to point to the following one.  */
 frame_descr *caml_next_frame_descriptor
-    (caml_frame_descrs fds, uintnat * pc, char ** sp, struct stack_info* stack);
+    (caml_frame_descrs * fds, uintnat * pc, char ** sp,
+     struct stack_info* stack);
 
 #endif /* CAML_INTERNALS */
 

diff --git a/runtime/caml/gc_ctrl.h b/runtime/caml/gc_ctrl.h
index c56470b4f9362d13c43cad08d4cd8690138a808c..223bd50549dbadbf08f66e44bbde5f6c9fc88705 100644 (file)
--- a/runtime/caml/gc_ctrl.h
+++ b/runtime/caml/gc_ctrl.h
@@ -20,7 +20,7 @@
 
 #include "misc.h"
 
-CAMLextern uintnat caml_max_stack_wsize;
+CAMLextern atomic_uintnat caml_max_stack_wsize;
 CAMLextern uintnat caml_fiber_wsz;
 CAMLextern uintnat caml_major_cycles_completed;
 

diff --git a/runtime/caml/gc_stats.h b/runtime/caml/gc_stats.h
index 4cded2c8bec5b566f67eea3e1a7577a0d7ca8113..8aff709b6336ad2684cb6c7ec9f1936eebe2e811 100644 (file)
--- a/runtime/caml/gc_stats.h
+++ b/runtime/caml/gc_stats.h
@@ -83,6 +83,8 @@ void caml_collect_gc_stats_sample_stw(caml_domain_state *domain);
    current domain but the sampled stats of other domains. */
 void caml_compute_gc_stats(struct gc_stats* buf);
 
+void caml_init_gc_stats (uintnat max_domains);
+
 #endif /* CAML_INTERNALS */
 
 #endif /* CAML_GC_STATS_H */

diff --git a/runtime/caml/hooks.h b/runtime/caml/hooks.h
index ec171835647b93f8a7e90246f97f0343d553ed3a..7c6a74962b99e46b754d97d8c64410877135daee 100644 (file)
--- a/runtime/caml/hooks.h
+++ b/runtime/caml/hooks.h
@@ -19,10 +19,6 @@
 #include "misc.h"
 #include "memory.h"
 
-#ifdef __cplusplus
-extern "C" {
-#endif
-
 #ifdef CAML_INTERNALS
 
 #ifdef NATIVE_CODE
@@ -36,8 +32,4 @@ CAMLextern void (*caml_natdynlink_hook)(void* handle, const char* unit);
 
 #endif /* CAML_INTERNALS */
 
-#ifdef __cplusplus
-}
-#endif
-
 #endif /* CAML_HOOKS_H */

diff --git a/runtime/caml/instrtrace.h b/runtime/caml/instrtrace.h
index c0914fe925b18827375f516a201e5f08d0644423..b070b215e532b15a55e06baeefdd8017ec255870 100644 (file)
--- a/runtime/caml/instrtrace.h
+++ b/runtime/caml/instrtrace.h
@@ -15,8 +15,8 @@
 
 /* Trace the instructions executed */
 
-#ifndef _instrtrace_
-#define _instrtrace_
+#ifndef CAML_INSTRTRACE_H
+#define CAML_INSTRTRACE_H
 
 #ifdef CAML_INTERNALS
 
@@ -33,4 +33,4 @@ void caml_event_trace (code_t pc);
 
 #endif /* CAML_INTERNALS */
 
-#endif
+#endif /* CAML_INSTRTRACE_H */

diff --git a/runtime/caml/intext.h b/runtime/caml/intext.h
index 0ed2fc0b8b80ebfd64b308c5e4fb5fbc2b85cfb4..3b1288f1c8b6d2af56fed51895018159c08c93f2 100644 (file)
--- a/runtime/caml/intext.h
+++ b/runtime/caml/intext.h
@@ -131,6 +131,9 @@ void caml_free_extern_state (void);
 void caml_output_val (struct channel * chan, value v, value flags);
   /* Output [v] with flags [flags] on the channel [chan]. */
 
+value caml_input_val (struct channel * chan);
+  /* Read a structured value from the channel [chan]. */
+
 void caml_free_intern_state (void);
 
 /* Compression hooks */
@@ -160,11 +163,6 @@ CAMLextern intnat caml_output_value_to_block(value v, value flags,
      in bytes.  Return the number of bytes actually written in buffer.
      Raise [Failure] if buffer is too short. */
 
-#ifdef CAML_INTERNALS
-value caml_input_val (struct channel * chan);
-  /* Read a structured value from the channel [chan]. */
-#endif /* CAML_INTERNALS */
-
 CAMLextern value caml_input_val_from_string (value str, intnat ofs);
   /* Read a structured value from the OCaml string [str], starting
      at offset [ofs]. */

diff --git a/runtime/caml/io.h b/runtime/caml/io.h
index 8a9e592da292fa98ae575f3ee61a6d9bc523473b..4ff505d024e32bdf9508dca107240be8727ed690 100644 (file)
--- a/runtime/caml/io.h
+++ b/runtime/caml/io.h
@@ -23,7 +23,18 @@
 #include "camlatomic.h"
 #include "misc.h"
 #include "mlvalues.h"
+
+#ifndef _MSC_VER
 #include "platform.h"
+#else
+/* We avoid including platform.h (which is really only necessary here to declare
+   caml_plat_mutex) because that would end up pulling in pthread.h but we want
+   to hide it on the MSVC port as it is not the native way to handle threads.
+   So we inline here just the implementation of caml_plat_mutex on that port,
+   this should be kept in sync */
+#include <stdint.h>
+typedef intptr_t caml_plat_mutex;
+#endif
 
 #ifndef IO_BUFFER_SIZE
 #define IO_BUFFER_SIZE 65536

diff --git a/runtime/caml/lf_skiplist.h b/runtime/caml/lf_skiplist.h
index 1ba106158af1b850febb29581632ccd66840a903..3fd4a8308473137ebbf696ab8fc61712c16e7632 100644 (file)
--- a/runtime/caml/lf_skiplist.h
+++ b/runtime/caml/lf_skiplist.h
@@ -69,7 +69,7 @@ extern int caml_lf_skiplist_find(struct lf_skiplist *sk, uintnat key,
 extern int caml_lf_skiplist_find_below(struct lf_skiplist *sk, uintnat k,
                                        /*out*/ uintnat *key,
                                        /*out*/ uintnat *data);
-/* Insertion in a skip list. [key] must be between 1 and UINTNAT_MAX-1.
+/* Insertion in a skip list. [key] must be between 1 and CAML_UINTNAT_MAX-1.
    If [key] was already there, change the associated data and return 1.
    If [key] was not there, insert new [key, data] binding and return 0. */
 extern int caml_lf_skiplist_insert(struct lf_skiplist *sk, uintnat key,

diff --git a/runtime/caml/m.h.in b/runtime/caml/m.h.in
index f38404676e0281e87278337d2f9f3dad5bfa28ed..3e9ef4b0b99a1183dbdc8a4c65b9a2155656e9a9 100644 (file)
--- a/runtime/caml/m.h.in
+++ b/runtime/caml/m.h.in
@@ -53,22 +53,6 @@
    SIZEOF_LONGLONG to the sizes in bytes of the C types "int", "long",
    "char *", "short" and "long long" respectively. */
 
-#undef ARCH_INT64_TYPE
-#undef ARCH_UINT64_TYPE
-
-/* Define ARCH_INT64_TYPE and ARCH_UINT64_TYPE to 64-bit integer types,
-   typically "long long" and "unsigned long long" on 32-bit platforms,
-   and "long" and "unsigned long" on 64-bit platforms.
-   If the C compiler doesn't support any 64-bit integer type,
-   leave both ARCH_INT64_TYPE and ARCH_UINT64_TYPE undefined. */
-
-#undef ARCH_INT64_PRINTF_FORMAT
-
-/* Define ARCH_INT64_PRINTF_FORMAT to the printf format used for formatting
-   values of type ARCH_INT64_TYPE.  This is usually "ll" on 32-bit
-   platforms and "l" on 64-bit platforms.
-   Leave undefined if ARCH_INT64_TYPE is undefined.  */
-
 #undef ARCH_ALIGN_INT64
 
 /* Define ARCH_ALIGN_INT64 if the processor requires 64-bit integers to be

diff --git a/runtime/caml/major_gc.h b/runtime/caml/major_gc.h
index a4b36bff55679521f297fc28a32e5dbe57d04c78..b5127ef51fdf9e783a9c15d3ec1dc9ccc2b5cd3a 100644 (file)
--- a/runtime/caml/major_gc.h
+++ b/runtime/caml/major_gc.h
@@ -26,7 +26,7 @@ typedef enum {
 
 extern gc_phase_t caml_gc_phase;
 
-intnat caml_opportunistic_major_work_available (void);
+intnat caml_opportunistic_major_work_available (caml_domain_state*);
 void caml_opportunistic_major_collection_slice (intnat);
 /* auto-triggered slice from within the GC */
 #define AUTO_TRIGGERED_MAJOR_SLICE -1
@@ -61,8 +61,6 @@ void caml_finalise_heap (void);
    so it need not be atomic */
 extern uintnat caml_major_cycles_completed;
 
-double caml_mean_space_overhead(void);
-
 #endif /* CAML_INTERNALS */
 
 #endif /* CAML_MAJOR_GC_H */

diff --git a/runtime/caml/memory.h b/runtime/caml/memory.h
index ed87224520bc7dca4cf23cc221703d5e88f17135..1c3ef4836e88fa33d8920e5a4864a08b6a82a45b 100644 (file)
--- a/runtime/caml/memory.h
+++ b/runtime/caml/memory.h
@@ -45,12 +45,6 @@ CAMLextern void caml_modify (volatile value *, value);
 CAMLextern void caml_initialize (volatile value *, value);
 CAMLextern int caml_atomic_cas_field (value, intnat, value, value);
 CAMLextern value caml_check_urgent_gc (value);
-#ifdef CAML_INTERNALS
-CAMLextern char *caml_alloc_for_heap (asize_t request);   /* Size in bytes. */
-CAMLextern void caml_free_for_heap (char *mem);
-CAMLextern int caml_add_to_heap (char *mem);
-#endif /* CAML_INTERNALS */
-
 
 /* [caml_stat_*] functions below provide an interface to the static memory
    manager built into the runtime, which can be used for managing static
@@ -138,25 +132,31 @@ CAMLextern caml_stat_block caml_stat_resize(caml_stat_block, asize_t);
 CAMLextern caml_stat_block caml_stat_resize_noexc(caml_stat_block, asize_t);
 
 
-/* A [caml_stat_block] containing a NULL-terminated string */
+/* A [caml_stat_block] containing a null-terminated string */
 typedef char* caml_stat_string;
 
 /* [caml_stat_strdup(s)] returns a pointer to a heap-allocated string which is a
-   copy of the NULL-terminated string [s]. It throws an OCaml exception in case
+   copy of the null-terminated string [s]. It throws an OCaml exception in case
    the request fails, and so requires the runtime lock to be held.
 */
 CAMLextern caml_stat_string caml_stat_strdup(const char *s);
-#ifdef _WIN32
-CAMLextern wchar_t* caml_stat_wcsdup(const wchar_t *s);
-#endif
 
 /* [caml_stat_strdup_noexc] is a variant of [caml_stat_strdup] that returns NULL
    in case the request fails, and doesn't require the runtime lock.
 */
 CAMLextern caml_stat_string caml_stat_strdup_noexc(const char *s);
 
-/* [caml_stat_strconcat(nargs, strings)] concatenates NULL-terminated [strings]
-   (an array of [char*] of size [nargs]) into a new string, dropping all NULLs,
+#ifdef _WIN32
+/* On Windows, [caml_stat_wcsdup] and [caml_stat_wcsdup_noexc] are the
+ * obvious equivalents of [caml_stat_strdup] and
+ * [caml_stat_strdup_noexc] for wide characters.
+ */
+CAMLextern wchar_t* caml_stat_wcsdup(const wchar_t *s);
+CAMLextern wchar_t* caml_stat_wcsdup_noexc(const wchar_t *s);
+#endif
+
+/* [caml_stat_strconcat(nargs, strings)] concatenates null-terminated [strings]
+   (an array of [char*] of size [nargs]) into a new string, dropping all NULs,
    except for the very last one. It throws an OCaml exception in case the
    request fails, and so requires the runtime lock to be held.
 */
@@ -200,6 +200,9 @@ enum caml_alloc_small_flags {
 #define Alloc_small_enter_GC(dom_st, wosize)    \
   Alloc_small_enter_GC_flags(CAML_DO_TRACK | CAML_FROM_C, dom_st, wosize)
 
+#define Alloc_small_enter_GC_no_track(dom_st, wosize)    \
+  Alloc_small_enter_GC_flags(CAML_DONT_TRACK | CAML_FROM_C, dom_st, wosize)
+
 #define Alloc_small_with_reserved(result, wosize, tag, GC, reserved) do{    \
                                                 CAMLassert ((wosize) >= 1); \
                                           CAMLassert ((tag_t) (tag) < 256); \
@@ -374,6 +377,17 @@ struct caml__roots_block {
     0) \
   CAMLunused_end
 
+#define CAMLxparamresult(x) \
+  struct caml__roots_block caml__roots_##x; \
+  CAMLunused_start int caml__dummy_##x = ( \
+    (caml__roots_##x.next = *caml_local_roots_ptr), \
+    (*caml_local_roots_ptr = &caml__roots_##x), \
+    (caml__roots_##x.nitems = 1), \
+    (caml__roots_##x.ntables = 1), \
+    (caml__roots_##x.tables [0] = &(x.data)), \
+    0) \
+   CAMLunused_end
+
 #define CAMLlocal1(x) \
   value x = Val_unit; \
   CAMLxparam1 (x)
@@ -402,6 +416,10 @@ struct caml__roots_block {
     x[caml__i_##x] = Val_unit; \
   }
 
+#define CAMLlocalresult(res) \
+  caml_result res = Result_unit; \
+  CAMLxparamresult (res)
+
 #define CAMLdrop do{              \
   *caml_local_roots_ptr = caml__frame; \
 }while (0)

diff --git a/runtime/caml/memprof.h b/runtime/caml/memprof.h
index f81d8eddc37cb9f9ca9e7b4cd4c85dd8d997a820..23e7153f1d594cfc48cc7852f56380f9e974454d 100644 (file)
--- a/runtime/caml/memprof.h
+++ b/runtime/caml/memprof.h
@@ -22,27 +22,121 @@
 #include "mlvalues.h"
 #include "roots.h"
 
-/* Suspend or unsuspend profiling */
+/*** Sample allocations ***/
+
+/* [Gc.Memprof.allocation_source] */
+
+enum { CAML_MEMPROF_SRC_NORMAL = 0,
+       CAML_MEMPROF_SRC_MARSHAL = 1, /* interning */
+       CAML_MEMPROF_SRC_CUSTOM = 2 /* custom memory */ };
+
+/* Respond to the allocation of any block. Does not call callbacks.
+ * `block` is the allocated block, to be tracked by memprof if
+ * sampled. `allocated_words` is the number of words allocated, to be
+ * passed to the allocation callback. `sampled_words` is the number of
+ * words to use when computing the number of samples (this will
+ * normally be one more than `allocated words` due to the header word,
+ * but may not be for out-of-heap memory). `source` is one of the
+ * `CAML_MEMPROF_SRC_* constants above. */
+
+void caml_memprof_sample_block(value block, size_t allocated_words,
+                               size_t sampled_words, int source);
+
+/* Sample a minor heap "Comballoc" (combined allocation). Called when
+ * the memprof trigger is hit (before the allocation is actually
+ * performed, which may require a GC). `allocs` and `alloc_lens`
+ * describe the combined allocation. Runs allocation callbacks. */
+
+extern void caml_memprof_sample_young(uintnat wosize, int from_caml,
+                                      int allocs, unsigned char* alloc_lens);
+
+/* Suspend or unsuspend sampling (for the current thread). */
+
 extern void caml_memprof_update_suspended(_Bool);
 
-/* Freshly set sampling point on minor heap */
-extern void caml_memprof_renew_minor_sample(caml_domain_state *state);
 
-/* Multi-domain support. */
+/*** GC interface ***/
+
+/* Apply `f(fdata, r, &r)` to each GC root `r` within memprof data
+ * structures for the domain `state`.
+ *
+ * `fflags` is used to decide whether to only scan roots which may
+ * point to minor heaps (the `SCANNING_ONLY_YOUNG_VALUES` flag).
+ *
+ * If `weak` is false then only scan strong roots. If `weak`
+ * is true then also scan weak roots. */
+
+extern void caml_memprof_scan_roots(scanning_action f,
+                                    scanning_action_flags fflags,
+                                    void* fdata,
+                                    caml_domain_state *state,
+                                    _Bool weak);
+
+/* Update memprof data structures for the domain `state`, to reflect
+ * survival and promotion, after a minor GC is completed. */
+
+extern void caml_memprof_after_minor_gc(caml_domain_state *state);
+
+/* Update memprof data structures for the domain `state`, to reflect
+ * survival, after a minor GC is completed. */
+
+extern void caml_memprof_after_major_gc(caml_domain_state *state);
+
+/* Freshly computes state->memprof_young_trigger. *Does not* set the
+ * young limit. */
+
+extern void caml_memprof_set_trigger(caml_domain_state *state);
+
+/*** Callbacks ***/
+
+/* Run any pending callbacks for the current domain (or adopted from a
+ * terminated domain). */
+
+extern caml_result caml_memprof_run_callbacks_res(void);
+
+
+/*** Multi-domain support. ***/
+
+/* Notify memprof of the creation of a new domain `domain`. If there
+ * was an existing domain (from which to inherit profiling behaviour),
+ * it is passed in `parent`. Called before the new domain allocates
+ * anything, and before the parent domain continues. Also creates
+ * memprof thread state for the initial thread of the domain. */
 
 extern void caml_memprof_new_domain(caml_domain_state *parent,
                                     caml_domain_state *domain);
+
+/* Notify memprof that the domain `domain` is terminating. Called
+ * after the last allocation by the domain. */
+
 extern void caml_memprof_delete_domain(caml_domain_state *domain);
 
-/* Multi-thread support */
+
+/*** Multi-thread support ***/
+
+/* Opaque type of memprof state for a single thread. */
 
 typedef struct memprof_thread_s *memprof_thread_t;
 
-CAMLextern memprof_thread_t caml_memprof_main_thread(caml_domain_state *domain);
+/* Notify memprof that a new thread is being created. Returns a
+ * pointer to memprof state for the new thread. */
+
 CAMLextern memprof_thread_t caml_memprof_new_thread(caml_domain_state *domain);
+
+/* Obtain the memprof state for the initial thread of a domain. Called
+ * when there is only one such thread. */
+
+CAMLextern memprof_thread_t caml_memprof_main_thread(caml_domain_state *domain);
+
+/* Notify memprof that the current domain is switching to the given
+ * thread. */
+
 CAMLextern void caml_memprof_enter_thread(memprof_thread_t);
+
+/* Notify memprof that the given thread is being deleted. */
+
 CAMLextern void caml_memprof_delete_thread(memprof_thread_t);
 
-#endif
+#endif /* CAML_INTERNALS */
 
 #endif /* CAML_MEMPROF_H */

diff --git a/runtime/caml/minor_gc.h b/runtime/caml/minor_gc.h
index 1c85af63c2606e687d9d6d9011e36cfca7bafdd6..2a86e16ab8500b94cd0c9b2564e46d9eb8458e75 100644 (file)
--- a/runtime/caml/minor_gc.h
+++ b/runtime/caml/minor_gc.h
@@ -39,6 +39,10 @@
   asize_t reserve;             \
 }
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 /* Count of the total number of minor collections performed by the program */
 CAMLextern atomic_uintnat caml_minor_collections_count;
 
@@ -69,6 +73,10 @@ struct caml_minor_tables {
 
 CAMLextern void caml_minor_collection (void);
 
+#ifdef __cplusplus
+}
+#endif
+
 #ifdef CAML_INTERNALS
 extern void caml_set_minor_heap_size (asize_t); /* size in bytes */
 extern void caml_empty_minor_heap_no_major_slice_from_stw

diff --git a/runtime/caml/misc.h b/runtime/caml/misc.h
index ddccdc585dc6dab92dc0a28bde749d19ae3acfd1..8325cd8cfb26bc1bcc87ee1a859b6811b07519d2 100644 (file)
--- a/runtime/caml/misc.h
+++ b/runtime/caml/misc.h
@@ -29,12 +29,26 @@
 
 #include "camlatomic.h"
 
+/* Detection of available C attributes and compiler extensions */
+
+#ifndef __has_c_attribute
+#define __has_c_attribute(x) 0
+#endif
+
+#ifndef __has_attribute
+#define __has_attribute(x) 0
+#endif
+
+#ifndef __has_builtin
+#define __has_builtin(x) 0
+#endif
+
 /* Deprecation warnings */
 
 #if defined(__GNUC__) || defined(__clang__)
   /* Supported since at least GCC 3.1 */
   #define CAMLdeprecated_typedef(name, type) \
-    typedef type name __attribute ((deprecated))
+    typedef type name __attribute__ ((deprecated))
 #elif defined(_MSC_VER)
   #define CAMLdeprecated_typedef(name, type) \
     typedef __declspec(deprecated) type name
@@ -76,29 +90,25 @@ typedef size_t asize_t;
 CAMLdeprecated_typedef(addr, char *);
 #endif /* CAML_INTERNALS */
 
-/* Noreturn, CAMLnoreturn_start and CAMLnoreturn_end are preserved
-   for compatibility reasons.  Instead, we recommend using the CAMLnoret
-   macro, to be added as a modifier at the beginning of the
-   function definition or declaration.  It must occur first, before
-   "static", "extern", "CAMLexport", "CAMLextern".
+/* The CAMLnoret macro must be added as a modifier at the beginning of
+   the function definition or declaration.  It must occur first,
+   before "static", "extern", "CAMLexport", "CAMLextern".
+
+   Noreturn, CAMLnoreturn_start and CAMLnoreturn_end are preserved for
+   compatibility reasons.
 
    Note: CAMLnoreturn is a different macro defined in memory.h,
    to be used in function bodies rather than as a function attribute.
 */
-#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 202300L    \
-    || defined(__cplusplus) && __cplusplus >= 201103L
+#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 202311L || \
+    defined(__cplusplus)
   #define CAMLnoret [[noreturn]]
-#elif defined(__STDC_VERSION__) && __STDC_VERSION__ >= 201112L
-  #define CAMLnoret _Noreturn
-#elif defined(__GNUC__)
-  #define CAMLnoret  __attribute__ ((noreturn))
 #else
-  #define CAMLnoret
+  #define CAMLnoret _Noreturn
 #endif
 
 #define CAMLnoreturn_start CAMLnoret
 #define CAMLnoreturn_end
-
 #ifdef __GNUC__
   #define Noreturn __attribute__ ((noreturn))
 #else
@@ -141,17 +151,11 @@ CAMLdeprecated_typedef(addr, char *);
 /* by ocamlopt makes direct references into the domain state structure,*/
 /* which is stored in a register on many platforms. For this to work, */
 /* we need to be able to compute the exact offset of each member. */
-#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 201112L
-#define CAMLalign(n) _Alignas(n)
-#elif defined(__cplusplus) \
-   && (__cplusplus >= 201103L || defined(_MSC_VER) && _MSC_VER >= 1900)
+#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 202311L || \
+    defined(__cplusplus)
 #define CAMLalign(n) alignas(n)
-#elif defined(SUPPORTS_ALIGNED_ATTRIBUTE)
-#define CAMLalign(n) __attribute__((aligned(n)))
-#elif defined(_MSC_VER)
-#define CAMLalign(n) __declspec(align(n))
 #else
-#error "How do I align values on this platform?"
+#define CAMLalign(n) _Alignas(n)
 #endif
 
 #if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 202311L || \
@@ -164,9 +168,15 @@ CAMLdeprecated_typedef(addr, char *);
 /* Prefetching */
 
 #ifdef CAML_INTERNALS
-#if defined(__GNUC__) && (defined(__i386__) || defined(__x86_64__))
+#if (__has_builtin(__builtin_prefetch) || defined(__GNUC__)) && \
+    (defined(__i386__) || defined(__x86_64__) || \
+     defined(_M_IX86) || defined(_M_AMD64))
 #define caml_prefetch(p) __builtin_prefetch((p), 1, 3)
 /* 1 = intent to write; 3 = all cache levels */
+#elif defined(_MSC_VER) && (defined(_M_IX86) || defined(_M_AMD64))
+#include <intrin.h>
+#define caml_prefetch(p) _mm_prefetch((char const *) p, _MM_HINT_T0)
+/* PreFetchCacheLine(PF_TEMPORAL_LEVEL_1, p) */
 #else
 #define caml_prefetch(p)
 #endif
@@ -179,13 +189,18 @@ CAMLdeprecated_typedef(addr, char *);
      CAMLunused_start foo CAMLunused_end;
    which supports both GCC/Clang and MSVC.
 */
-#if defined(__GNUC__) && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ > 7))
-  #define CAMLunused_start __attribute__ ((unused))
+#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 202311L || \
+    defined(__cplusplus) && __cplusplus >= 201703L
+  #define CAMLunused [[maybe_unused]]
+  #define CAMLunused_start CAMLunused
   #define CAMLunused_end
+#elif __has_attribute(unused) || defined(__GNUC__)
   #define CAMLunused __attribute__ ((unused))
+  #define CAMLunused_start CAMLunused
+  #define CAMLunused_end
 #elif defined(_MSC_VER)
-  #define CAMLunused_start  __pragma( warning (push) )           \
-    __pragma( warning (disable:4189 ) )
+  #define CAMLunused_start __pragma( warning (push) )   \
+          __pragma( warning (disable:4189 ) )
   #define CAMLunused_end __pragma( warning (pop))
   #define CAMLunused
 #else
@@ -194,6 +209,17 @@ CAMLdeprecated_typedef(addr, char *);
   #define CAMLunused
 #endif
 
+#ifdef CAML_INTERNALS
+#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 202311L || \
+    defined(__cplusplus) && __cplusplus >= 201703L
+  #define fallthrough [[fallthrough]]
+#elif __has_attribute(fallthrough)
+  #define fallthrough __attribute__ ((fallthrough))
+#else
+  #define fallthrough ((void) 0)
+#endif
+#endif /* CAML_INTERNALS */
+
 /* GC timing hooks. These can be assigned by the user. These hooks
    must not allocate, change any heap value, nor call OCaml code. They
    can obtain the domain id with Caml_state->id. These functions must
@@ -248,14 +274,36 @@ typedef char char_os;
 #define __OSFILE__ __FILE__
 #endif
 
+/* Although caml_failed_assert never returns, it is not marked as such.
+   This prevents the C compiler optimising away all of the useful context
+   from the callsite, making debuggers able to see it. */
 #define CAMLassert(x) \
   (CAMLlikely(x) ? (void) 0 : caml_failed_assert ( #x , __OSFILE__, __LINE__))
-CAMLnoret CAMLextern void caml_failed_assert (char *, char_os *, int);
+CAMLextern void caml_failed_assert (char *, char_os *, int)
+#if defined(__has_feature)
+  /* However, we do inform clang-analyzer that this function never returns,
+     since that improves analysis without breaking debugging */
+  #if __has_feature(attribute_analyzer_noreturn)
+    __attribute__((analyzer_noreturn))
+  #endif
+#endif
+;
 #else
 #define CAMLassert(x) ((void) 0)
 #endif
 
-#ifdef __GNUC__
+#if __has_builtin(__builtin_trap) || defined(__GNUC__)
+  #define CAMLunreachable() (__builtin_trap())
+#elif defined(_MSC_VER)
+  #include <intrin.h>
+  CAMLnoret Caml_inline void caml_fastfail(unsigned int);
+  void caml_fastfail(unsigned int i) { __fastfail(i); }
+  #define CAMLunreachable() (caml_fastfail(7 /* FAST_FAIL_FATAL_APP_EXIT */))
+#else
+  #define CAMLunreachable() (CAMLassert(0))
+#endif
+
+#if __has_builtin(__builtin_expect) || defined(__GNUC__)
 #define CAMLlikely(e)   __builtin_expect(!!(e), 1)
 #define CAMLunlikely(e) __builtin_expect(!!(e), 0)
 #else
@@ -269,7 +317,8 @@ CAMLnoret CAMLextern void caml_failed_assert (char *, char_os *, int);
 
    CAMLnoalloc at the start of a block means that the GC must not be
    invoked during the block. */
-#if defined(__GNUC__) && defined(DEBUG)
+#if (__has_attribute(cleanup) && __has_attribute(unused) || defined(__GNUC__)) \
+    && defined(DEBUG)
 int caml_noalloc_begin(void);
 void caml_noalloc_end(int*);
 void caml_alloc_point_here(void);
@@ -302,19 +351,11 @@ extern _Atomic fatal_error_hook caml_fatal_error_hook;
 #endif
 
 CAMLnoret CAMLextern void caml_fatal_error (char *, ...)
-#ifdef __GNUC__
+#if __has_attribute(format) || defined(__GNUC__)
   __attribute__ ((format (printf, 1, 2)))
 #endif
 ;
 
-/* Detection of available C built-in functions, the Clang way. */
-
-#ifdef __has_builtin
-#define Caml_has_builtin(x) __has_builtin(x)
-#else
-#define Caml_has_builtin(x) 0
-#endif
-
 /* Integer arithmetic with overflow detection.
    The functions return 0 if no overflow, 1 if overflow.
    The result of the operation is always stored at [*res].
@@ -324,7 +365,7 @@ CAMLnoret CAMLextern void caml_fatal_error (char *, ...)
 
 Caml_inline int caml_uadd_overflow(uintnat a, uintnat b, uintnat * res)
 {
-#if __GNUC__ >= 5 || Caml_has_builtin(__builtin_add_overflow)
+#if __has_builtin(__builtin_add_overflow) || defined(__GNUC__) && __GNUC__ >= 5
   return __builtin_add_overflow(a, b, res);
 #else
   uintnat c = a + b;
@@ -335,7 +376,7 @@ Caml_inline int caml_uadd_overflow(uintnat a, uintnat b, uintnat * res)
 
 Caml_inline int caml_usub_overflow(uintnat a, uintnat b, uintnat * res)
 {
-#if __GNUC__ >= 5 || Caml_has_builtin(__builtin_sub_overflow)
+#if __has_builtin(__builtin_sub_overflow) || defined(__GNUC__) && __GNUC__ >= 5
   return __builtin_sub_overflow(a, b, res);
 #else
   uintnat c = a - b;
@@ -344,7 +385,7 @@ Caml_inline int caml_usub_overflow(uintnat a, uintnat b, uintnat * res)
 #endif
 }
 
-#if __GNUC__ >= 5 || Caml_has_builtin(__builtin_mul_overflow)
+#if __has_builtin(__builtin_mul_overflow) || defined(__GNUC__) && __GNUC__ >= 5
 Caml_inline int caml_umul_overflow(uintnat a, uintnat b, uintnat * res)
 {
   return __builtin_mul_overflow(a, b, res);
@@ -353,6 +394,17 @@ Caml_inline int caml_umul_overflow(uintnat a, uintnat b, uintnat * res)
 extern int caml_umul_overflow(uintnat a, uintnat b, uintnat * res);
 #endif
 
+#ifdef CAML_INTERNALS
+
+/* Rounding */
+
+Caml_inline uintnat caml_round_up(uintnat value, uintnat align) {
+  CAMLassert(Is_power_of_2(align));
+  return (value + align - 1) & ~(align - 1);
+}
+
+#endif
+
 /* From floats.c */
 extern double caml_log1p(double);
 
@@ -372,7 +424,7 @@ extern double caml_log1p(double);
 #define unlink_os _wunlink
 #define rename_os caml_win32_rename
 #define chdir_os _wchdir
-#define mkdir_os(path, perm) _wmkdir(path)
+#define mkdir_os(path, perm) ((void) (perm), _wmkdir(path))
 #define getcwd_os _wgetcwd
 #define system_os _wsystem
 #define rmdir_os _wrmdir
@@ -392,10 +444,12 @@ extern double caml_log1p(double);
 #define clock_os caml_win32_clock
 
 #define caml_stat_strdup_os caml_stat_wcsdup
+#define caml_stat_strdup_noexc_os caml_stat_wcsdup_noexc
 #define caml_stat_strconcat_os caml_stat_wcsconcat
 
 #define caml_stat_strdup_to_os caml_stat_strdup_to_utf16
 #define caml_stat_strdup_of_os caml_stat_strdup_of_utf16
+#define caml_stat_strdup_noexc_of_os caml_stat_strdup_noexc_of_utf16
 #define caml_copy_string_of_os caml_copy_string_of_utf16
 
 #else /* _WIN32 */
@@ -432,10 +486,12 @@ extern double caml_log1p(double);
 #define clock_os clock
 
 #define caml_stat_strdup_os caml_stat_strdup
+#define caml_stat_strdup_noexc_os caml_stat_strdup_noexc
 #define caml_stat_strconcat_os caml_stat_strconcat
 
 #define caml_stat_strdup_to_os caml_stat_strdup
 #define caml_stat_strdup_of_os caml_stat_strdup
+#define caml_stat_strdup_noexc_of_os caml_stat_strdup_noexc
 #define caml_copy_string_of_os caml_copy_string
 
 #endif /* _WIN32 */
@@ -487,13 +543,13 @@ CAMLextern int caml_read_directory(char_os * dirname,
 extern atomic_uintnat caml_verb_gc;
 
 void caml_gc_log (char *, ...)
-#ifdef __GNUC__
+#if __has_attribute(format) || defined(__GNUC__)
   __attribute__ ((format (printf, 1, 2)))
 #endif
 ;
 
 void caml_gc_message (int, char *, ...)
-#ifdef __GNUC__
+#if __has_attribute(format) || defined(__GNUC__)
   __attribute__ ((format (printf, 2, 3)))
 #endif
 ;
@@ -504,13 +560,13 @@ int caml_runtime_warnings_active(void);
 
 #ifdef DEBUG
 #ifdef ARCH_SIXTYFOUR
-#define Debug_tag(x) (0xD700D7D7D700D6D7ull \
+#define Debug_tag(x) (0xD700D7D7D700D6D8ull \
                       | ((uintnat) (x) << 16) \
                       | ((uintnat) (x) << 48))
-#define Is_debug_tag(x) (((x) & 0xff00ffffff00ffffull) == 0xD700D7D7D700D6D7ull)
+#define Is_debug_tag(x) (((x) & 0xff00ffffff00ffffull) == 0xD700D7D7D700D6D8ull)
 #else
-#define Debug_tag(x) (0xD700D6D7ul | ((uintnat) (x) << 16))
-#define Is_debug_tag(x) (((x) & 0xff00fffful) == 0xD700D6D7ul)
+#define Debug_tag(x) (0xD700D6D8ul | ((uintnat) (x) << 16))
+#define Is_debug_tag(x) (((x) & 0xff00fffful) == 0xD700D6D8ul)
 #endif /* ARCH_SIXTYFOUR */
 
 /*
@@ -576,6 +632,11 @@ CAMLextern int caml_snwprintf(wchar_t * buf,
 #  endif
 #endif
 
+/* Generate a named symbol that is unique within the current macro expansion */
+#define CAML_GENSYM_3(name, l) caml__##name##_##l
+#define CAML_GENSYM_2(name, l) CAML_GENSYM_3(name, l)
+#define CAML_GENSYM(name) CAML_GENSYM_2(name, __LINE__)
+
 #endif /* CAML_INTERNALS */
 
 /* The [backtrace_slot] type represents values stored in

diff --git a/runtime/caml/mlvalues.h b/runtime/caml/mlvalues.h
index 80265bce3f460de076d13fa0c2e2bd5c96872408..184fd9049a5dd1860ec1287f7ad1edde37e6c05b 100644 (file)
--- a/runtime/caml/mlvalues.h
+++ b/runtime/caml/mlvalues.h
@@ -84,12 +84,41 @@ typedef opcode_t * code_t;
 #define Unsigned_long_val(x) ((uintnat)(x) >> 1)
 #define Unsigned_int_val(x)  ((int) Unsigned_long_val(x))
 
-/* Encoded exceptional return values, when functions are suffixed with
-   _exn. Encoded exceptions are invalid values and must not be seen
-   by the garbage collector. */
-#define Make_exception_result(v) ((v) | 2)
-#define Is_exception_result(v) (((v) & 3) == 2)
-#define Extract_exception(v) ((v) & ~3)
+/* A 'result' type for OCaml computations. */
+
+/* The [caml_result] type represents the result of computing an OCaml
+   term -- either a value or an exception.
+
+   This plays a similar role to the [('a, exn) result] type in OCaml,
+   with a different representation. Returning this type, instead of
+   raising exceptions directly, lets the caller implement proper
+   cleanup and propagate the exception themselves.
+*/
+typedef struct caml_result_private caml_result;
+
+/* This structure should be considered internal, its definition may
+   change in the future. Its public interface is formed of
+   - Result_value, Result_exception
+   - caml_result_is_exception
+   - caml_get_value_or_raise (in fail.h)
+*/
+struct caml_result_private {
+  int is_exception;
+  value data;
+};
+
+#define Result_value(v) \
+  (struct caml_result_private){ .is_exception = 0, .data = v }
+#define Result_exception(exn) \
+  (struct caml_result_private){ .is_exception = 1, .data = exn }
+
+Caml_inline int caml_result_is_exception(struct caml_result_private result)
+{
+  return result.is_exception;
+}
+
+#define Result_unit Result_value(Val_unit)
+
 
 /* Structure of the header:
 
@@ -256,12 +285,16 @@ CAMLno_tsan_for_perf Caml_inline header_t Hd_val(value val)
 #define Object_tag 248
 #define Class_val(val) Field((val), 0)
 #define Oid_val(val) Long_val(Field((val), 1))
+/* Allow the bytecode linker to include mlvalues.h without the primitive
+   declarations. */
+#ifndef CAML_INTERNALS_NO_PRIM_DECLARATIONS
 CAMLextern value caml_get_public_method (value obj, value tag);
 /* Called as:
    caml_callback(caml_get_public_method(obj, caml_hash_variant(name)), obj) */
 /* caml_get_public_method returns 0 if tag not in the table.
    Note however that tags being hashed, same tag does not necessarily mean
    same method name. */
+#endif
 
 Caml_inline value Val_ptr(void* p)
 {
@@ -449,7 +482,11 @@ CAMLextern value caml_atom(tag_t);
 #define Is_none(v) ((v) == Val_none)
 #define Is_some(v) Is_block(v)
 
+/* Allow the bytecode linker to include mlvalues.h without the primitive
+   declarations. */
+#ifndef CAML_INTERNALS_NO_PRIM_DECLARATIONS
 CAMLextern value caml_set_oo_id(value obj);
+#endif
 
 /* Header for out-of-heap blocks. */
 
@@ -463,6 +500,21 @@ CAMLextern value caml_set_oo_id(value obj);
 #define Caml_out_of_heap_header(wosize, tag)                           \
         Caml_out_of_heap_header_with_reserved(wosize, tag, 0)
 
+
+/* Obsolete -- suppport for unsafe encoded exceptions.
+
+   Before caml_result was available, we used an unsafe encoding of it
+   into the 'value' type, where encoded exceptions have their second
+   bit set. These encoded exceptions are invalid values and must not
+   be seen by the garbage collector. This is unsafe, and the
+   C type-checker does not help. We strongly recommend using the
+   caml_result type above instead. It is GC-safe and more
+   type-safe. */
+
+#define Make_exception_result(v) ((v) | 2)
+#define Is_exception_result(v) (((v) & 3) == 2)
+#define Extract_exception(v) ((v) & ~3)
+
 #ifdef __cplusplus
 }
 #endif

diff --git a/runtime/caml/osdeps.h b/runtime/caml/osdeps.h
index cb907c1e8dbbb1737d4f6ae735e9196f48d01c13..7215668c397f5a83dde9b44e9a0a0f52c47af8c6 100644 (file)
--- a/runtime/caml/osdeps.h
+++ b/runtime/caml/osdeps.h
@@ -18,15 +18,6 @@
 #ifndef CAML_OSDEPS_H
 #define CAML_OSDEPS_H
 
-#ifdef _WIN32
-#include <time.h>
-
-extern unsigned short caml_win32_major;
-extern unsigned short caml_win32_minor;
-extern unsigned short caml_win32_build;
-extern unsigned short caml_win32_revision;
-#endif
-
 #ifdef CAML_INTERNALS
 
 #include "misc.h"
@@ -106,6 +97,8 @@ void caml_plat_mem_unmap(void *, uintnat);
 
 #ifdef _WIN32
 
+#include <time.h>
+
 /* Map a Win32 error code (as returned by GetLastError) to a POSIX error code
    (from <errno.h>).  Return 0 if no POSIX error code matches. */
 CAMLextern int caml_posixerr_of_win32err(unsigned int win32err);
@@ -159,7 +152,16 @@ extern void caml_init_os_params(void);
 
 #ifdef _WIN32
 
-/* [caml_stat_strdup_to_utf16(s)] returns a NULL-terminated copy of [s],
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern unsigned short caml_win32_major;
+extern unsigned short caml_win32_minor;
+extern unsigned short caml_win32_build;
+extern unsigned short caml_win32_revision;
+
+/* [caml_stat_strdup_to_utf16(s)] returns a null-terminated copy of [s],
    re-encoded in UTF-16.  The encoding of [s] is assumed to be UTF-8 if
    [caml_windows_unicode_runtime_enabled] is non-zero **and** [s] is valid
    UTF-8, or the current Windows code page otherwise.
@@ -169,12 +171,25 @@ extern void caml_init_os_params(void);
 */
 CAMLextern wchar_t* caml_stat_strdup_to_utf16(const char *s);
 
-/* [caml_stat_strdup_of_utf16(s)] returns a NULL-terminated copy of [s],
+/* [caml_stat_strdup_noexc_of_utf16(s)] returns a null-terminated copy of [s],
    re-encoded in UTF-8 if [caml_windows_unicode_runtime_enabled] is non-zero or
    the current Windows code page otherwise.
 
-   The returned string is allocated with [caml_stat_alloc], so it should be free
-   using [caml_stat_free].
+   The returned string is allocated with [caml_stat_alloc_noexc], so
+   it should be freed using [caml_stat_free].
+
+   If allocation fails, this returns NULL.
+*/
+CAMLextern char* caml_stat_strdup_noexc_of_utf16(const wchar_t *s);
+
+/* [caml_stat_strdup_of_utf16(s)] returns a null-terminated copy of [s],
+   re-encoded in UTF-8 if [caml_windows_unicode_runtime_enabled] is non-zero or
+   the current Windows code page otherwise.
+
+   The returned string is allocated with [caml_stat_alloc_noexc], so
+   it should be freed using [caml_stat_free].
+
+   If allocation fails, this raises Out_of_memory.
 */
 CAMLextern char* caml_stat_strdup_of_utf16(const wchar_t *s);
 
@@ -184,6 +199,10 @@ CAMLextern char* caml_stat_strdup_of_utf16(const wchar_t *s);
 */
 CAMLextern value caml_copy_string_of_utf16(const wchar_t *s);
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* _WIN32 */
 
 #endif /* CAML_OSDEPS_H */

diff --git a/runtime/caml/platform.h b/runtime/caml/platform.h
index e9eb45babc545d436183cb8014aac97077feea56..c8f654fdb294f390ef279de62a8dcf4dcaec9f84 100644 (file)
--- a/runtime/caml/platform.h
+++ b/runtime/caml/platform.h
@@ -14,9 +14,10 @@
 /*                                                                        */
 /**************************************************************************/
 
+/* Platform-specific concurrency and memory primitives */
+
 #ifndef CAML_PLAT_THREADS_H
 #define CAML_PLAT_THREADS_H
-/* Platform-specific concurrency and memory primitives */
 
 #ifdef CAML_INTERNALS
 
@@ -26,6 +27,9 @@
 #include "config.h"
 #include "mlvalues.h"
 #include "sys.h"
+#ifdef _MSC_VER
+#include <intrin.h>
+#endif
 
 #if defined(MAP_ANON) && !defined(MAP_ANONYMOUS)
 #define MAP_ANONYMOUS MAP_ANON
@@ -50,76 +54,376 @@ Caml_inline void cpu_relax(void) {
   /* Just a compiler barrier */
   __asm__ volatile ("" ::: "memory");
 #endif
+#elif defined(_MSC_VER)
+/* It would be better to use YieldProcessor to have a portable implementation
+   but this would require windows.h which we can't include here (it would
+   conflict with caml/instruct.h on ATOM, for instance)
+*/
+#if defined(_M_IX86) || defined(_M_X64)
+  _mm_pause();
+#endif
 #endif
 }
 
-/* Loads and stores with acquire, release and relaxed semantics */
-
-#define atomic_load_acquire(p)                    \
-  atomic_load_explicit((p), memory_order_acquire)
-#define atomic_load_relaxed(p)                    \
-  atomic_load_explicit((p), memory_order_relaxed)
-#define atomic_store_release(p, v)                      \
-  atomic_store_explicit((p), (v), memory_order_release)
-#define atomic_store_relaxed(p, v)                      \
-  atomic_store_explicit((p), (v), memory_order_relaxed)
-
-/* Spin-wait loops */
-
-#define Max_spins 1000
-
-CAMLextern unsigned caml_plat_spin_wait(unsigned spins,
-                                        const char* file, int line,
-                                        const char* function);
-
-#define GENSYM_3(name, l) name##l
-#define GENSYM_2(name, l) GENSYM_3(name, l)
-#define GENSYM(name) GENSYM_2(name, __LINE__)
-
-#define SPIN_WAIT                                                       \
-  unsigned GENSYM(caml__spins) = 0;                                     \
-  for (; 1; cpu_relax(),                                                \
-         GENSYM(caml__spins) =                                          \
-           CAMLlikely(GENSYM(caml__spins) < Max_spins) ?                \
-         GENSYM(caml__spins) + 1 :                                      \
-         caml_plat_spin_wait(GENSYM(caml__spins),                       \
-                             __FILE__, __LINE__, __func__))
-
-Caml_inline uintnat atomic_load_wait_nonzero(atomic_uintnat* p) {
-  SPIN_WAIT {
-    uintnat v = atomic_load_acquire(p);
-    if (v) return v;
-  }
-}
 
 /* Atomic read-modify-write instructions, with full fences */
 
-Caml_inline uintnat atomic_fetch_add_verify_ge0(atomic_uintnat* p, uintnat v) {
+Caml_inline uintnat atomic_fetch_add_verify_ge0(atomic_uintnat* p, intnat v) {
   uintnat result = atomic_fetch_add(p,v);
   CAMLassert ((intnat)result > 0);
   return result;
 }
 
+/* Warning: blocking functions.
+
+   Blocking functions are for use in the runtime outside of the
+   mutator, or when the domain lock is not held.
+
+   In order to use them inside the mutator and while holding the
+   domain lock, one must make sure that the wait is very short, and
+   that no deadlock can arise from the interaction with the domain
+   locks and the stop-the-world sections.
+
+   In particular one must not call [caml_plat_lock_blocking] on a
+   mutex while the domain lock is held:
+    - if any critical section of the mutex crosses an allocation, a
+      blocking section releasing the domain lock, or any other
+      potential STW section, nor
+    - if the same lock is acquired at any point using [Mutex.lock] or
+      [caml_plat_lock_non_blocking] on the same domain (circular
+      deadlock with the domain lock).
+
+   Hence, as a general rule, prefer [caml_plat_lock_non_blocking] to
+   lock a mutex when inside the mutator and holding the domain lock.
+   The domain lock must be held in order to call
+   [caml_plat_lock_non_blocking].
+
+   These functions never raise exceptions; errors are fatal. Thus, for
+   usages where bugs are susceptible to be introduced by users, the
+   functions from caml/sync.h should be used instead.
+*/
 
 typedef pthread_mutex_t caml_plat_mutex;
 #define CAML_PLAT_MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER
 CAMLextern void caml_plat_mutex_init(caml_plat_mutex*);
-Caml_inline void caml_plat_lock(caml_plat_mutex*);
+Caml_inline void caml_plat_lock_blocking(caml_plat_mutex*);
+Caml_inline void caml_plat_lock_non_blocking(caml_plat_mutex*);
 Caml_inline int caml_plat_try_lock(caml_plat_mutex*);
 void caml_plat_assert_locked(caml_plat_mutex*);
 void caml_plat_assert_all_locks_unlocked(void);
 Caml_inline void caml_plat_unlock(caml_plat_mutex*);
 void caml_plat_mutex_free(caml_plat_mutex*);
-typedef struct { pthread_cond_t cond; caml_plat_mutex* mutex; } caml_plat_cond;
-#define CAML_PLAT_COND_INITIALIZER(m) { PTHREAD_COND_INITIALIZER, m }
-void caml_plat_cond_init(caml_plat_cond*, caml_plat_mutex*);
-void caml_plat_wait(caml_plat_cond*);
-/* like caml_plat_wait, but if nanoseconds surpasses the second parameter
-   without a signal, then this function returns 1. */
+typedef pthread_cond_t caml_plat_cond;
+#define CAML_PLAT_COND_INITIALIZER PTHREAD_COND_INITIALIZER
+void caml_plat_cond_init(caml_plat_cond*);
+void caml_plat_wait(caml_plat_cond*, caml_plat_mutex*); /* blocking */
 void caml_plat_broadcast(caml_plat_cond*);
 void caml_plat_signal(caml_plat_cond*);
 void caml_plat_cond_free(caml_plat_cond*);
 
+/* Futexes
+
+   A futex is an integer that can be waited on and woken, used to build other
+   synchronisation primitives. Either uses OS facilities directly, or a
+   condition variable fallback.
+*/
+typedef struct caml_plat_futex /* {
+  // this field is available regardless of implementation
+  caml_plat_futex_word value;
+  <possibly other fields>; ...
+} */ caml_plat_futex;
+
+typedef uint32_t caml_plat_futex_value;
+typedef _Atomic caml_plat_futex_value caml_plat_futex_word;
+
+/* Block while [futex] has the value [undesired], until woken by [wake_all()] */
+void caml_plat_futex_wait(caml_plat_futex* futex,
+                          caml_plat_futex_value undesired);
+/* Wake all threads [wait()]-ing on [futex] */
+void caml_plat_futex_wake_all(caml_plat_futex* futex);
+/* Initialise the futex for the first time, use [CAML_PLAT_FUTEX_INITIALIZER] to
+   do this statically */
+void caml_plat_futex_init(caml_plat_futex* ftx, caml_plat_futex_value value);
+/* Deinitialise the futex; no-op if native futexes are used */
+void caml_plat_futex_free(caml_plat_futex*);
+
+/* [CAML_PLAT_FUTEX_FALLBACK] can be defined to use the condition variable
+   fallback, even if a futex implementation is available. */
+#ifndef CAML_PLAT_FUTEX_FALLBACK
+#  if defined(_WIN32)                                   \
+  || (defined(__linux__) && defined(HAS_LINUX_FUTEX_H)) \
+  || defined(__FreeBSD__) || defined(__OpenBSD__)
+/* TODO We have implementations for these platforms, but they are
+   currently untested, so use the fallback instead.
+  || defined(__NetBSD__) || defined(__DragonFly__) */
+#  else
+/* Use the fallback on platforms that we do not have an OS-specific
+   implementation for, such as macOS. */
+#    define CAML_PLAT_FUTEX_FALLBACK
+#  endif
+#endif
+
+#ifdef CAML_PLAT_FUTEX_FALLBACK
+struct caml_plat_futex {
+  caml_plat_futex_word value;
+  caml_plat_mutex mutex;
+  caml_plat_cond cond;
+};
+#  define CAML_PLAT_FUTEX_INITIALIZER(value) \
+  { (value), CAML_PLAT_MUTEX_INITIALIZER, CAML_PLAT_COND_INITIALIZER }
+#else
+struct caml_plat_futex {
+  caml_plat_futex_word value;
+};
+#  define CAML_PLAT_FUTEX_INITIALIZER(value) { (value) }
+#endif /* CAML_PLAT_FUTEX_FALLBACK */
+
+/* Latches
+
+   A binary latch is a boolean value with a [wait()] operation. It has two
+   states, "released" and "unreleased" (or "set"). [latch_set()] can be used to
+   set the latch to unreleased, [latch_release()] can be used to release it, and
+   [latch_wait()] can be used from the unreleased state to block until
+   [latch_release()] is called.
+
+                    [latch_set()]
+         +------------------------------------+
+         v                                    |
+     UNRELEASED                            RELEASED
+         |                                    ^
+         +-< unblock [latch_wait()] callers >-+
+                   [latch_release()]
+
+   This type of object is also called a manual-reset event in Windows APIs, or
+   it can be considered a special case of Java's [CountDownLatch] or C++'s
+   [std::latch] with the counter capped at one.
+ */
+typedef caml_plat_futex caml_plat_binary_latch;
+
+/* Released state */
+#define Latch_released 0 /* must be zero, see barrier initialisation */
+/* Unreleased state, no [latch_wait()] callers */
+#define Latch_unreleased 1
+/* Unreleased state, at least one [latch_wait()] caller */
+#define Latch_contested 2
+
+/* Initialise the latch to a released state */
+#define CAML_PLAT_LATCH_INITIALIZER CAML_PLAT_FUTEX_INITIALIZER(Latch_released)
+Caml_inline void caml_plat_latch_init(caml_plat_binary_latch* latch) {
+  caml_plat_futex_init(latch, Latch_released);
+}
+/* Release the latch, waking any waiters */
+void caml_plat_latch_release(caml_plat_binary_latch*);
+/* Block until released. This is no-op (but more expensive than checking with
+   [is_released()]) if the latch has already been released. */
+void caml_plat_latch_wait(caml_plat_binary_latch*);
+/* Check if a latch is released */
+Caml_inline int caml_plat_latch_is_released(caml_plat_binary_latch* latch) {
+  return atomic_load_acquire(&latch->value) == Latch_released;
+}
+/* Check if a latch is unreleased */
+Caml_inline int caml_plat_latch_is_set(caml_plat_binary_latch* latch) {
+  return !caml_plat_latch_is_released(latch);
+}
+/* Set the latch to unreleased */
+Caml_inline void caml_plat_latch_set(caml_plat_binary_latch* latch) {
+  atomic_store_release(&latch->value, Latch_unreleased);
+}
+
+/* Barriers
+
+   A barrier is an object used to synchronise a variable number of
+   threads/parties. Each party arrives at the barrier, and only once all parties
+   have arrived can any threads leave the barrier. There are two variants: the
+   "single-sense" barrier must be manually reset before it can be reused,
+   whereas the "sense-reversing" barrier can be reused immediately after it has
+   been released.
+
+   | Operation | [caml_plat_barrier_*] function      |
+   |           |---------------+---------------------|
+   |           | Single-sense  | Sense-reversing     |
+   |-----------|---------------+---------------------|
+   | Reset     | [reset]       | automatic at [flip] |
+   | Arrive    | [arrive]      | [arrive]            |
+   | Check     | [is_released] | [sense_has_flipped] |
+   | Block     | [wait]        | [wait_sense]        |
+   | Release   | [release]     | [flip]              |
+
+   The lifecycle is as follows:
+
+        Reset (1 thread)          (other threads)
+                |                       |
+                +----------+------------+
+                           |
+                        Arrive (all threads)
+                           |
+                           | check arrival number
+                +----------+------------+
+                |                       |
+         Check or Block              Release
+       (non-final threads)        (final thread)
+                |                       |
+
+   Leaving the barrier after [Block] or a nonzero [Check] result synchronises
+   with the [Release] of the barrier from the final thread, which in turn
+   synchronises with the non-final threads at the time they [Arrive]d.
+
+   That is, on non-final threads, anything performed before [Check]/[Block] may
+   race with code in other threads that happens before they [Arrive], and
+   anything performed after [Arrive] is entirely unsynchronised by the barrier,
+   so may race with code in other threads that happens after they [Arrive]. In
+   particular, code between [Arrive] and [Check]/[Block] may race with code
+   before or after the barrier in all other threads. The final thread is the
+   exception, and may execute code after [Arrive] but before [Release] that will
+   still be synchronised by the barrier.
+*/
+typedef struct caml_plat_barrier {
+  caml_plat_futex futex;
+  atomic_uintnat arrived; /* includes sense bit */
+} caml_plat_barrier;
+
+/* This initialises both a single-sense and sense-reversing barrier, for
+   single-sense this is the released state ([Latch_released], which must be 0)
+   and for sense-reversing it is just a valid initialised state. */
+#define CAML_PLAT_BARRIER_INITIALIZER \
+  { CAML_PLAT_FUTEX_INITIALIZER(Latch_released), 0 }
+
+typedef uintnat barrier_status;
+#define BARRIER_SENSE_BIT 0x100000
+/* Arrive at the barrier, returns the number of parties that have arrived at the
+   barrier (including this one); the caller should check whether it is the last
+   expected party to arrive, and release or flip the barrier if so.
+
+   In a sense-reversing barrier, this also encodes the current sense of the
+   barrier in [BARRIER_SENSE_BIT], which should be masked off if checking for
+   the last arrival. */
+Caml_inline barrier_status caml_plat_barrier_arrive(caml_plat_barrier* barrier)
+{
+  return 1 + atomic_fetch_add(&barrier->arrived, 1);
+}
+
+/* -- Single-sense --
+   [futex] is used as a binary latch. */
+
+/* Reset the barrier to 0 arrivals, block new waiters */
+Caml_inline void caml_plat_barrier_reset(caml_plat_barrier* barrier) {
+  caml_plat_latch_set(&barrier->futex);
+  atomic_store_release(&barrier->arrived, 0);
+}
+/* Check if the barrier has been released */
+Caml_inline int caml_plat_barrier_is_released(caml_plat_barrier* barrier) {
+  return caml_plat_latch_is_released(&barrier->futex);
+}
+/* Release the barrier unconditionally, letting all parties through */
+Caml_inline void caml_plat_barrier_release(caml_plat_barrier* barrier) {
+  caml_plat_latch_release(&barrier->futex);
+}
+/* Block until released */
+Caml_inline void caml_plat_barrier_wait(caml_plat_barrier* barrier) {
+  caml_plat_latch_wait(&barrier->futex);
+}
+
+/* -- Sense-reversing -- */
+/* Flip the sense of the barrier, releasing current waiters and
+   blocking new ones.
+
+   [current_sense] should be [(b & BARRIER_SENSE_BIT)] with [b] as
+   returned by [barrier_arrive()]. */
+void caml_plat_barrier_flip(caml_plat_barrier*, barrier_status current_sense);
+Caml_inline int
+caml_plat_barrier_sense_has_flipped(caml_plat_barrier* barrier,
+                                    barrier_status current_sense)
+{
+  return (atomic_load_acquire(&barrier->futex.value) & BARRIER_SENSE_BIT)
+    != current_sense;
+}
+/* Block until flipped */
+void caml_plat_barrier_wait_sense(caml_plat_barrier*,
+                                  barrier_status current_sense);
+
+/* Spin-wait loops
+
+   We provide the macros [SPIN_WAIT], [SPIN_WAIT_NTIMES(N)] and
+   [SPIN_WAIT_BOUNDED] that expand to [for]-loop headers for spin-wait
+   loops. The latter two are expected to be used alongside OS-based
+   synchronisation (e.g. latches, barriers).
+
+   Example usage:
+
+   SPIN_WAIT {
+     if (condition_has_come_true()) {
+       break; // or return;
+     }
+
+     perform_useful_spin_work();
+   }
+
+   [SPIN_WAIT] spins for unbounded time, and should only be used when hashing
+   out contention over a short critical section that only one thread needs to
+   run, where more complex synchronisation would be too expensive and
+   unnecessary.
+
+   [SPIN_WAIT_NTIMES(N)] should be used with one of the [Max_spins_*] constants
+   defined below (though the N expression doesn't need to be a constant), it
+   loops the body up to N times and then ends, even if the condition hasn't come
+   true. Exactly how much spinning is optimal can be tricky and may warrant
+   profiling, with the caveat that it is also probably machine-dependent.
+   Typically, [Max_spins_long] iterations are only useful when there are exactly
+   2 domains, otherwise [Max_spins_short] is best to yield to OS synchronisation
+   as fast as possible.
+
+   [SPIN_WAIT_BOUNDED] expands to [SPIN_WAIT_NTIMES(Max_spins_medium)] and
+   should be used when there is useful work to do in the body of the loop.
+ */
+
+/* The exact values here are estimates based on data from a specific machine,
+   and shouldn't be focused on too much. */
+#define Max_spins_long 1000
+#define Max_spins_medium 300
+#define Max_spins_short 30
+
+#define SPIN_WAIT_NTIMES(N)                             \
+  unsigned CAML_GENSYM(spins) = 0;                      \
+  unsigned CAML_GENSYM(max_spins) = (N);                \
+  for (; CAML_GENSYM(spins) < CAML_GENSYM(max_spins);   \
+       cpu_relax(), ++CAML_GENSYM(spins))
+#define SPIN_WAIT_BOUNDED SPIN_WAIT_NTIMES(Max_spins_medium)
+#define SPIN_WAIT SPIN_WAIT_BACK_OFF(Max_spins_long)
+
+/* [SPIN_WAIT_*] implementation details */
+
+struct caml_plat_srcloc {
+  const char* file;
+  int line;
+  const char* function;
+};
+
+/* Start/continue backing off, returns the next [sleep_ns] */
+CAMLextern unsigned caml_plat_spin_back_off(unsigned sleep_ns,
+                                            const struct caml_plat_srcloc* loc);
+
+Caml_inline unsigned caml_plat_spin_step(unsigned spins,
+                                         unsigned max_spins,
+                                         const struct caml_plat_srcloc *loc) {
+  cpu_relax();
+  if (CAMLlikely(spins < max_spins)) {
+    return spins + 1;
+  } else {
+    /* [spins] becomes [sleep_ns] at this point, which remains greater than
+       [max_spins] */
+    return caml_plat_spin_back_off(spins, loc);
+  }
+}
+
+#define SPIN_WAIT_BACK_OFF(max_spins)                                   \
+  unsigned CAML_GENSYM(spins) = 0;                                      \
+  unsigned CAML_GENSYM(max_spins) = (max_spins);                        \
+  static const struct caml_plat_srcloc CAML_GENSYM(loc) = {             \
+    __FILE__, __LINE__, __func__                                        \
+  };                                                                    \
+  for (; 1; CAML_GENSYM(spins) = caml_plat_spin_step(                   \
+         CAML_GENSYM(spins), CAML_GENSYM(max_spins), &CAML_GENSYM(loc)))
+
 /* Memory management primitives (mmap) */
 
 uintnat caml_mem_round_up_pages(uintnat size);
@@ -141,15 +445,15 @@ Caml_inline void check_err(const char* action, int err)
 }
 
 #ifdef DEBUG
-static CAMLthread_local int lockdepth;
-#define DEBUG_LOCK(m) (lockdepth++)
-#define DEBUG_UNLOCK(m) (lockdepth--)
+CAMLextern CAMLthread_local int caml_lockdepth;
+#define DEBUG_LOCK(m) (caml_lockdepth++)
+#define DEBUG_UNLOCK(m) (caml_lockdepth--)
 #else
 #define DEBUG_LOCK(m)
 #define DEBUG_UNLOCK(m)
 #endif
 
-Caml_inline void caml_plat_lock(caml_plat_mutex* m)
+Caml_inline void caml_plat_lock_blocking(caml_plat_mutex* m)
 {
   check_err("lock", pthread_mutex_lock(m));
   DEBUG_LOCK(m);
@@ -167,6 +471,15 @@ Caml_inline int caml_plat_try_lock(caml_plat_mutex* m)
   }
 }
 
+CAMLextern void caml_plat_lock_non_blocking_actual(caml_plat_mutex* m);
+
+Caml_inline void caml_plat_lock_non_blocking(caml_plat_mutex* m)
+{
+  if (!caml_plat_try_lock(m)) {
+    caml_plat_lock_non_blocking_actual(m);
+  }
+}
+
 Caml_inline void caml_plat_unlock(caml_plat_mutex* m)
 {
   DEBUG_UNLOCK(m);

diff --git a/runtime/caml/printexc.h b/runtime/caml/printexc.h
index 070318f47a056105c0daa6e1ac380166d4b68e0c..2a217a2babfc18f30f92096d548f155833c46d86 100644 (file)
--- a/runtime/caml/printexc.h
+++ b/runtime/caml/printexc.h
@@ -16,7 +16,6 @@
 #ifndef CAML_PRINTEXC_H
 #define CAML_PRINTEXC_H
 
-
 #include "misc.h"
 #include "mlvalues.h"
 
@@ -24,14 +23,14 @@
 extern "C" {
 #endif
 
-
 CAMLextern char * caml_format_exception (value);
-#ifdef CAML_INTERNALS
-CAMLnoret void caml_fatal_uncaught_exception (value);
-#endif /* CAML_INTERNALS */
 
 #ifdef __cplusplus
 }
 #endif
 
+#ifdef CAML_INTERNALS
+CAMLnoret void caml_fatal_uncaught_exception (value);
+#endif /* CAML_INTERNALS */
+
 #endif /* CAML_PRINTEXC_H */

diff --git a/runtime/caml/runtime_events.h b/runtime/caml/runtime_events.h
index df46f69a30588d496a868519e3a9c35252b80176..e64e6ef84945ba545cba2c4b5c06578b6f3203ba 100644 (file)
--- a/runtime/caml/runtime_events.h
+++ b/runtime/caml/runtime_events.h
@@ -29,7 +29,6 @@
 #define CAML_RUNTIME_EVENTS_H
 
 #include "mlvalues.h"
-#include <stdint.h>
 
 #ifdef CAML_INSTR
 #define CAML_EV_ALLOC(s) caml_ev_alloc(s)
@@ -59,6 +58,8 @@ typedef enum {
     EV_GC
 } ev_event_type;
 
+/* See runtime_events.mli for event documentation */
+
 typedef enum {
     EV_RING_START,
     EV_RING_STOP,
@@ -80,9 +81,12 @@ typedef enum {
     EV_MAJOR,
     EV_MAJOR_SWEEP,
     EV_MAJOR_MARK_ROOTS,
+    EV_MAJOR_MEMPROF_ROOTS,
     EV_MAJOR_MARK,
     EV_MINOR,
     EV_MINOR_LOCAL_ROOTS,
+    EV_MINOR_MEMPROF_ROOTS,
+    EV_MINOR_MEMPROF_CLEAN,
     EV_MINOR_FINALIZED,
     EV_EXPLICIT_GC_MAJOR_SLICE,
     EV_FINALISE_UPDATE_FIRST,
@@ -105,6 +109,7 @@ typedef enum {
     EV_STW_HANDLER,
     EV_STW_LEADER,
     EV_MAJOR_FINISH_SWEEPING,
+    EV_MAJOR_MEMPROF_CLEAN,
     EV_MINOR_FINALIZERS_ADMIN,
     EV_MINOR_REMEMBERED_SET,
     EV_MINOR_REMEMBERED_SET_PROMOTE,
@@ -122,19 +127,32 @@ typedef enum {
     EV_C_FORCE_MINOR_MAKE_VECT,
     EV_C_FORCE_MINOR_SET_MINOR_HEAP_SIZE,
     EV_C_FORCE_MINOR_MEMPROF,
+
     EV_C_MINOR_PROMOTED,
     EV_C_MINOR_ALLOCATED,
+
     EV_C_REQUEST_MAJOR_ALLOC_SHR,
     EV_C_REQUEST_MAJOR_ADJUST_GC_SPEED,
     EV_C_REQUEST_MINOR_REALLOC_REF_TABLE,
     EV_C_REQUEST_MINOR_REALLOC_EPHE_REF_TABLE,
     EV_C_REQUEST_MINOR_REALLOC_CUSTOM_TABLE,
+
     EV_C_MAJOR_HEAP_POOL_WORDS,
     EV_C_MAJOR_HEAP_POOL_LIVE_WORDS,
     EV_C_MAJOR_HEAP_LARGE_WORDS,
     EV_C_MAJOR_HEAP_POOL_FRAG_WORDS,
     EV_C_MAJOR_HEAP_POOL_LIVE_BLOCKS,
     EV_C_MAJOR_HEAP_LARGE_BLOCKS,
+
+    EV_C_MAJOR_HEAP_WORDS,
+    EV_C_MAJOR_ALLOCATED_WORDS,
+    EV_C_MAJOR_ALLOCATED_WORK,
+    EV_C_MAJOR_DEPENDENT_WORK,
+    EV_C_MAJOR_EXTRA_WORK,
+    EV_C_MAJOR_WORK_COUNTER,
+    EV_C_MAJOR_ALLOC_COUNTER,
+    EV_C_MAJOR_SLICE_TARGET,
+    EV_C_MAJOR_SLICE_BUDGET
 } ev_runtime_counter;
 
 typedef enum {
@@ -157,6 +175,10 @@ typedef enum {
   E_CURSOR_POLL_BUSY = -8,
 } runtime_events_error;
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 /* Starts runtime_events. Needs to be called before
    [caml_runtime_events_create_cursor]. Needs the runtime lock held to call and
    will trigger a stop-the-world pause. */
@@ -178,6 +200,10 @@ CAMLextern void caml_runtime_events_resume(void);
    [0] otherwise. */
 CAMLextern int caml_runtime_events_are_active(void);
 
+#ifdef __cplusplus
+}
+#endif
+
 #ifdef CAML_INTERNALS
 
 struct runtime_events_buffer_header {
@@ -276,8 +302,10 @@ void caml_runtime_events_destroy(void);
    in a forked child */
 CAMLextern void caml_runtime_events_post_fork(void);
 
-/* Returns the location of the runtime_events for the current process if started
-   or NULL otherwise */
+/* Return the path of the ring buffers file of this process, or NULL
+   if runtime events are not enabled. This is used in the consumer to
+   read the ring buffers of the current process. Always returns a
+   freshly-allocated string. */
 CAMLextern char_os* caml_runtime_events_current_location(void);
 
 /* Functions for putting runtime data on to the runtime_events. These are all
@@ -318,4 +346,4 @@ CAMLextern value caml_runtime_events_user_resolve(char* event_name,
 
 #endif /* CAML_INTERNALS */
 
-#endif /*CAML_RUNTIME_EVENTS_H*/
+#endif /* CAML_RUNTIME_EVENTS_H */

diff --git a/runtime/caml/s.h.in b/runtime/caml/s.h.in
index 0dc2ed76b4bdef42f72f1ebccad937483c60efce..bc6ced458da6455d211138f51be95951e95c8911 100644 (file)
--- a/runtime/caml/s.h.in
+++ b/runtime/caml/s.h.in
@@ -78,10 +78,10 @@
 
 #undef HAS_ISSETUGID
 
-#undef HAS_STDATOMIC_H
-
 #undef HAS_SYS_MMAN_H
 
+#undef HAS_LINUX_FUTEX_H
+
 /* 2. For the Unix library. */
 
 #undef HAS_SOCKETS
@@ -106,8 +106,6 @@
 
 #undef HAS_IPV6
 
-#undef HAS_STDINT_H
-
 #undef HAS_PTHREAD_NP_H
 
 #undef HAS_UNISTD
@@ -251,7 +249,15 @@
 
 #undef HAS_PWRITE
 
-#undef HAS_NANOSECOND_STAT
+#undef HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
+#undef HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC
+#undef HAVE_STRUCT_STAT_ST_ATIMENSEC
+
+/* Define either HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC,
+   HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC, or HAVE_STRUCT_STAT_ST_ATIMENSEC if
+   (respectively) the field struct stat.st_atim.tv_nsec,
+   struct stat.st_atimespec.tv_nsec, or struct stat.st_atimensec is available.
+*/
 
 #undef HAS_GETHOSTBYNAME_R
 
@@ -260,9 +266,9 @@
    gethostbyname_r(): either 5 or 6 depending on prototype.
    (5 is the Solaris version, 6 is the Linux version). */
 
-#undef HAS_GETHOSTBYADDR_R 8
+#undef HAS_GETHOSTBYADDR_R
 
-/* Define HAS_GETHOSTBYADDR_R if gethostbyname_r() is available.
+/* Define HAS_GETHOSTBYADDR_R if gethostbyaddr_r() is available.
    The value of this symbol is the number of arguments of
    gethostbyaddr_r(): either 7 or 8 depending on prototype.
    (7 is the Solaris version, 8 is the Linux version). */
@@ -299,8 +305,6 @@
 
 #undef HAS_BROKEN_PRINTF
 
-#undef HAS_STRERROR
-
 #undef HAS_POSIX_MONOTONIC_CLOCK
 
 #undef HAS_CLOCK_GETTIME_NSEC_NP
@@ -309,3 +313,11 @@
 #undef HAS_BSD_GETAFFINITY_NP
 
 #undef HAS_ZSTD
+
+#undef HAVE_MAX_ALIGN_T
+
+/* 3. Language extensions. */
+
+#undef HAVE_LABELS_AS_VALUES
+
+/* Define if the C compiler supports the labels as values extension. */

diff --git a/runtime/caml/shared_heap.h b/runtime/caml/shared_heap.h
index 9b98e01f4badfff5344570ec7ef54b82c16abe5c..9f7ec1dda2eaea6fb04042de6bef4a8b958a5be8 100644 (file)
--- a/runtime/caml/shared_heap.h
+++ b/runtime/caml/shared_heap.h
@@ -13,6 +13,7 @@
 /*   special exception on linking described in the file LICENSE.          */
 /*                                                                        */
 /**************************************************************************/
+
 #ifndef CAML_SHARED_HEAP_H
 #define CAML_SHARED_HEAP_H
 

diff --git a/runtime/caml/signals.h b/runtime/caml/signals.h
index 2a340cf2ee823b8b6d3a095284005f013d743756..823a7cbbadd0c30456724b5345d23b535b88dd32 100644 (file)
--- a/runtime/caml/signals.h
+++ b/runtime/caml/signals.h
@@ -37,16 +37,49 @@ CAMLextern void caml_process_pending_actions (void);
    finalisers, and Memprof callbacks. Assumes that the runtime lock is
    held. Can raise exceptions asynchronously into OCaml code. */
 
+/* Same as [caml_process_pending_actions], but returns the reified
+   result instead of raising exceptions directly (if any). */
+CAMLextern caml_result caml_process_pending_actions_res (void);
+
+/* Returns [Val_unit] or an encoded exception.
+   Superseded by the safer [_res] variant above,
+   kept around for compatibility. */
 CAMLextern value caml_process_pending_actions_exn (void);
-/* Same as [caml_process_pending_actions], but returns the encoded
-   exception (if any) instead of raising it directly (otherwise
-   returns [Val_unit]). */
 
 CAMLextern int caml_check_pending_actions (void);
 /* Returns 1 if there are pending actions, 0 otherwise. */
 
+#ifdef __cplusplus
+}
+#endif
+
 #ifdef CAML_INTERNALS
 
+value caml_process_pending_actions_with_root (value extra_root); // raises
+/* This is identical to [caml_process_pending_actions], except that it
+   registers its argument as a root and eventually returns it. This is
+   useful to safely process pending actions before returning from
+   functions that manipulate a 'value' without proper rooting.
+
+   This would be incorrect:
+     {
+       value ret;
+       ...
+       caml_process_pending_actions(); // this may call a GC
+       return ret; // 'ret' was not rooted and may have been moved
+     }
+
+   This is correct:
+     {
+       value ret;
+       ...
+       ret = caml_process_pending_actions_with_root(ret);
+       return ret;
+     }
+*/
+
+caml_result caml_process_pending_actions_with_root_res (value extra_root);
+
 #ifndef NSIG
 #define NSIG 65
 #endif
@@ -65,13 +98,11 @@ void caml_request_major_slice (int global);
 void caml_request_minor_gc (void);
 CAMLextern int caml_convert_signal_number (int);
 CAMLextern int caml_rev_convert_signal_number (int);
-value caml_execute_signal_exn(int signal_number);
+caml_result caml_execute_signal_res(int signal_number);
 CAMLextern void caml_record_signal(int signal_number);
-CAMLextern value caml_process_pending_signals_exn(void);
+CAMLextern caml_result caml_process_pending_signals_res(void);
 CAMLextern void caml_set_action_pending(caml_domain_state *);
-value caml_do_pending_actions_exn(void);
-value caml_process_pending_actions_with_root (value extra_root); // raises
-value caml_process_pending_actions_with_root_exn (value extra_root);
+caml_result caml_do_pending_actions_res(void);
 
 void caml_init_signal_handling(void);
 void caml_init_signals(void);
@@ -82,10 +113,7 @@ CAMLextern void caml_free_signal_stack(void *);
 /* These hooks are not modified after other threads are spawned. */
 CAMLextern void (*caml_enter_blocking_section_hook)(void);
 CAMLextern void (*caml_leave_blocking_section_hook)(void);
-#endif /* CAML_INTERNALS */
 
-#ifdef __cplusplus
-}
-#endif
+#endif /* CAML_INTERNALS */
 
 #endif /* CAML_SIGNALS_H */

diff --git a/runtime/caml/skiplist.h b/runtime/caml/skiplist.h
index b022d09c2dbcef1dc46e30c495c42c31b1eb739b..ba03ced7d69d47537710ce27cc76dcc0136afb69 100644 (file)
--- a/runtime/caml/skiplist.h
+++ b/runtime/caml/skiplist.h
@@ -87,12 +87,15 @@ extern void caml_skiplist_empty(struct skiplist * sk);
    Other operations performed over the skiplist during its traversal have
    unspecified effects on the traversal. */
 
-#define FOREACH_SKIPLIST_ELEMENT(var,sk,action) \
-  { struct skipcell * var, * caml__next; \
-    for (var = (sk)->forward[0]; var != NULL; var = caml__next) \
-    { caml__next = (var)->forward[0]; action; } \
+#define FOREACH_SKIPLIST_ELEMENT(var,sk,action) {               \
+    for (struct skipcell *var = (sk)->forward[0], *caml__next;  \
+         var != NULL;                                           \
+         var = caml__next) {                                    \
+      caml__next = (var)->forward[0];                           \
+      action;                                                   \
+    }                                                           \
   }
 
-#endif
+#endif /* CAML_INTERNALS */
 
-#endif
+#endif /* CAML_SKIPLIST_H */

diff --git a/runtime/caml/startup_aux.h b/runtime/caml/startup_aux.h
index 70660bb4566261e38638e0775e14d87dd32eb92a..b371ef09edf5d9ec7d31e7b6a4c1883a24c89259 100644 (file)
--- a/runtime/caml/startup_aux.h
+++ b/runtime/caml/startup_aux.h
@@ -45,13 +45,13 @@ struct caml_params {
   uintnat init_custom_major_ratio;
   uintnat init_custom_minor_ratio;
   uintnat init_custom_minor_max_bsz;
-
   uintnat init_max_stack_wsz;
 
   uintnat backtrace_enabled;
   uintnat runtime_warnings;
   uintnat cleanup_on_exit;
   uintnat event_trace;
+  uintnat max_domains;
 };
 
 extern const struct caml_params* const caml_params;

diff --git a/runtime/caml/sync.h b/runtime/caml/sync.h
index 0777549b5647725ec3007b1f008566c274dcdc1c..75712eabf985d56ed6ea3e1aeb5ac99d34ca64d4 100644 (file)
--- a/runtime/caml/sync.h
+++ b/runtime/caml/sync.h
@@ -21,10 +21,18 @@
 #ifdef CAML_INTERNALS
 
 #include "mlvalues.h"
+#include "platform.h"
 
-typedef pthread_mutex_t * sync_mutex;
+/* OCaml mutexes and condition variables can also be manipulated from
+   C code with non-raising primitives from caml/platform.h. In this
+   case, pairs of lock/unlock for a critical section must come from
+   the same header (sync.h or platform.h). */
+
+typedef caml_plat_mutex * sync_mutex;
+typedef caml_plat_cond * sync_condvar;
 
 #define Mutex_val(v) (* ((sync_mutex *) Data_custom_val(v)))
+#define Condition_val(v) (* (sync_condvar *) Data_custom_val(v))
 
 CAMLextern int caml_mutex_lock(sync_mutex mut);
 CAMLextern int caml_mutex_unlock(sync_mutex mut);

diff --git a/runtime/caml/sys.h b/runtime/caml/sys.h
index b6e6af870311e0ecb6f8db5f5da01217c8e8de1a..b2fe25a147d9d9590737d985c3a0a66c21a9f26a 100644 (file)
--- a/runtime/caml/sys.h
+++ b/runtime/caml/sys.h
@@ -20,10 +20,6 @@
 
 #include "misc.h"
 
-#ifdef __cplusplus
-extern "C" {
-#endif
-
 CAMLextern char * caml_strerror(int errnum, char * buf, size_t buflen);
 
 #define NO_ARG Val_int(0)
@@ -37,10 +33,6 @@ CAMLextern void caml_sys_init (char_os * exe_name, char_os ** argv);
 
 CAMLnoret CAMLextern void caml_do_exit (int);
 
-#ifdef __cplusplus
-}
-#endif
-
 #endif /* CAML_INTERNALS */
 
 #endif /* CAML_SYS_H */

diff --git a/runtime/caml/tsan.h b/runtime/caml/tsan.h
index 2f1df2f4fa5658a61f5b198a8b93ab00b367fb87..eb1bf9face11e2c8e6ae81737dc488178a6da994 100644 (file)
--- a/runtime/caml/tsan.h
+++ b/runtime/caml/tsan.h
@@ -15,6 +15,10 @@
 #ifndef CAML_TSAN_H
 #define CAML_TSAN_H
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 /* Macro used to deactivate thread sanitizer on some functions. */
 #define CAMLno_tsan
 /* __has_feature is Clang-specific, but GCC defines __SANITIZE_ADDRESS__ and
@@ -67,10 +71,13 @@ extern void AnnotateHappensAfter(const char *f, int l, void *addr);
 #  define CAMLno_tsan_for_perf CAMLno_tsan
 #endif
 
+#ifdef __cplusplus
+}
+#endif
 
 #ifdef CAML_INTERNALS
 
-#include "caml/mlvalues.h"
+#include "mlvalues.h"
 
 struct stack_info;
 
@@ -85,7 +92,6 @@ extern void __tsan_func_exit(void*);
 extern void __tsan_func_entry(void*);
 void __tsan_write8(void *location);
 
-
 #endif /* CAML_INTERNALS */
 
 #endif /* CAML_TSAN_H */

diff --git a/runtime/caml/weak.h b/runtime/caml/weak.h
index 0f5ae74c0a778cdae3dd25a543d39e7842007240..4569d14338ebdaebbd6e01477fe59634b5fbd062 100644 (file)
--- a/runtime/caml/weak.h
+++ b/runtime/caml/weak.h
@@ -19,13 +19,17 @@
 #define CAML_WEAK_H
 
 #include "mlvalues.h"
-#include "memory.h"
 
 #ifdef __cplusplus
 extern "C" {
 #endif
+
 extern value caml_ephe_none;
 
+#ifdef __cplusplus
+}
+#endif
+
 #ifdef CAML_INTERNALS
 
 struct caml_ephe_info {
@@ -79,8 +83,4 @@ void caml_ephe_clean(value e);
 
 #endif /* CAML_INTERNALS */
 
-#ifdef __cplusplus
-}
-#endif
-
 #endif /* CAML_WEAK_H */

diff --git a/runtime/codefrag.c b/runtime/codefrag.c
index 27e1459c04a32f910f42636bee0bed2966e14c0b..6014fb49faa47bc3f069ea38cd6428da4c9d5cfb 100644 (file)
--- a/runtime/codefrag.c
+++ b/runtime/codefrag.c
@@ -131,7 +131,7 @@ unsigned char *caml_digest_of_code_fragment(struct code_fragment *cf) {
      all cases. It would be possible to take a lock only in the
      DIGEST_LATER case, which occurs at most once per fragment, by
      using double-checked locking -- see #11791. */
-  caml_plat_lock(&cf->mutex);
+  caml_plat_lock_blocking(&cf->mutex);
   {
     if (cf->digest_status == DIGEST_IGNORE) {
       digest = NULL;

diff --git a/runtime/compare.c b/runtime/compare.c
index fd90087a40a8c798397d2860816d3d4ee30e7986..cda5100a4a9b7c111bc16a21141d34cc4122a5b8 100644 (file)
--- a/runtime/compare.c
+++ b/runtime/compare.c
@@ -99,18 +99,17 @@ static intnat compare_val(value v1, value v2, int total)
 static void run_pending_actions(struct compare_stack* stk,
                                 struct compare_item* sp)
 {
-  value exn;
+  caml_result result;
   value* roots_start = (value*)(stk->stack);
   size_t roots_length =
     (sp - stk->stack)
     * sizeof(struct compare_item) / sizeof(value);
   Begin_roots_block(roots_start, roots_length);
-  exn = caml_do_pending_actions_exn();
+  result = caml_do_pending_actions_res();
   End_roots();
-  if (Is_exception_result(exn)) {
-    exn = Extract_exception(exn);
+  if (caml_result_is_exception(result)) {
     compare_free_stack(stk);
-    caml_raise(exn);
+    (void) caml_get_value_or_raise(result);;
   }
 }
 
@@ -120,7 +119,7 @@ static void run_pending_actions(struct compare_stack* stk,
 #define LESS -1
 #define EQUAL 0
 #define GREATER 1
-#define UNORDERED ((intnat)1 << (8 * sizeof(value) - 1))
+#define UNORDERED CAML_INTNAT_MIN
 
 /* The return value of compare_val is as follows:
       > 0                 v1 is greater than v2
@@ -160,7 +159,7 @@ static intnat do_compare_val(struct compare_stack* stk,
             if (res != 0) return res;
             goto next_item;
           }
-          default: /*fallthrough*/;
+          default: break;
           }
 
         return LESS;                /* v1 long < v2 block */
@@ -181,7 +180,7 @@ static intnat do_compare_val(struct compare_stack* stk,
             if (res != 0) return res;
             goto next_item;
           }
-          default: /*fallthrough*/;
+          default: break;
           }
         return GREATER;            /* v1 block > v2 long */
       }
@@ -240,9 +239,8 @@ static intnat do_compare_val(struct compare_stack* stk,
       case Double_array_tag: {
         mlsize_t sz1 = Wosize_val(v1) / Double_wosize;
         mlsize_t sz2 = Wosize_val(v2) / Double_wosize;
-        mlsize_t i;
         if (sz1 != sz2) return sz1 - sz2;
-        for (i = 0; i < sz1; i++) {
+        for (mlsize_t i = 0; i < sz1; i++) {
           double d1 = Double_flat_field(v1, i);
           double d2 = Double_flat_field(v2, i);
           if (d1 < d2) return LESS;

diff --git a/runtime/custom.c b/runtime/custom.c
index dd746f213b5062c9280a313dda5c906cadef003b..7c9251d1bc19a1af87a312c7155c08b23527f8e1 100644 (file)
--- a/runtime/custom.c
+++ b/runtime/custom.c
@@ -112,7 +112,10 @@ CAMLexport value caml_alloc_custom_mem(const struct custom_operations * ops,
                                        uintnat bsz,
                                        mlsize_t mem)
 {
-  return alloc_custom_gen (ops, bsz, mem, 0, get_max_minor());
+  value v = alloc_custom_gen (ops, bsz, mem, 0, get_max_minor());
+  size_t mem_words = (mem + sizeof(value) - 1) / sizeof(value);
+  caml_memprof_sample_block(v, mem_words, mem_words, CAML_MEMPROF_SRC_CUSTOM);
+  return v;
 }
 
 struct custom_operations_list {
@@ -148,8 +151,9 @@ caml_register_custom_operations(const struct custom_operations * ops)
 
 struct custom_operations * caml_find_custom_operations(const char * ident)
 {
-  struct custom_operations_list * l;
-  for (l = atomic_load(&custom_ops_table); l != NULL; l = l->next)
+  for (struct custom_operations_list *l = atomic_load(&custom_ops_table);
+       l != NULL;
+       l = l->next)
     if (strcmp(l->ops->identifier, ident) == 0)
       return (struct custom_operations*)l->ops;
   return NULL;
@@ -159,9 +163,10 @@ static custom_operations_table custom_ops_final_table = NULL;
 
 struct custom_operations * caml_final_custom_operations(final_fun fn)
 {
-  struct custom_operations_list * l;
   struct custom_operations * ops;
-  for (l = atomic_load(&custom_ops_final_table); l != NULL; l = l->next)
+  for (struct custom_operations_list *l = atomic_load(&custom_ops_final_table);
+       l != NULL;
+       l = l->next)
     if (l->ops->finalize == fn) return (struct custom_operations*)l->ops;
   ops = caml_stat_alloc(sizeof(struct custom_operations));
   ops->identifier = "_final";

diff --git a/runtime/debugger.c b/runtime/debugger.c
index c840ac2b0bca0d92ed506f8e3a91d31d15f19c79..45ba7a6cbf595168d86e3a814f6531bbbb529a36 100644 (file)
--- a/runtime/debugger.c
+++ b/runtime/debugger.c
@@ -22,6 +22,7 @@
 #endif /* _WIN32 */
 
 #include <string.h>
+#include <stdbool.h>
 
 #include "caml/alloc.h"
 #include "caml/codefrag.h"
@@ -68,6 +69,7 @@ CAMLexport void caml_debugger_cleanup_fork(void)
 #else
 #define ATOM ATOM_WS
 #include <winsock2.h>
+#include <ws2tcpip.h>
 #undef ATOM
 /* Code duplication with otherlibs/unix/socketaddr.h is inevitable
  * because pulling winsock2.h creates many naming conflicts. */
@@ -94,11 +96,7 @@ struct sockaddr_un {
 static value marshal_flags;
 
 static int sock_domain;         /* Socket domain for the debugger */
-static union {                  /* Socket address for the debugger */
-  struct sockaddr s_gen;
-  struct sockaddr_un s_unix;
-  struct sockaddr_in s_inet;
-} sock_addr;
+static struct sockaddr_storage sock_addr; /* Socket address for the debugger */
 static int sock_addr_len;       /* Length of sock_addr */
 
 static int dbg_socket = -1;     /* The socket connected to the debugger */
@@ -120,17 +118,21 @@ static void open_connection(void)
                           NULL, 0,
                           0 /* not WSA_FLAG_OVERLAPPED */);
   if (sock == INVALID_SOCKET
-      || connect(sock, &sock_addr.s_gen, sock_addr_len) != 0)
+      || connect(sock, (struct sockaddr *)&sock_addr, sock_addr_len) != 0)
     caml_fatal_error("cannot connect to debugger at %s\n"
                      "WSA error code: %d",
                      (dbg_addr ? dbg_addr : "(none)"),
                      WSAGetLastError());
   dbg_socket = _open_osfhandle(sock, 0);
   if (dbg_socket == -1)
+#else
+#if defined(SOCK_CLOEXEC)
+  dbg_socket = socket(sock_domain, SOCK_STREAM | SOCK_CLOEXEC, 0);
 #else
   dbg_socket = socket(sock_domain, SOCK_STREAM, 0);
+#endif
   if (dbg_socket == -1 ||
-      connect(dbg_socket, &sock_addr.s_gen, sock_addr_len) == -1)
+      connect(dbg_socket, (struct sockaddr *)&sock_addr, sock_addr_len) == -1)
 #endif
     caml_fatal_error("cannot connect to debugger at %s\n"
                      "error: %s",
@@ -167,16 +169,40 @@ static void winsock_cleanup(void)
 {
   WSACleanup();
 }
+
+/* from Filename.is_implicit */
+static bool filename_is_implicit(const char *path)
+{
+  size_t len = strlen(path);
+  return (len < 1 || path[0] != '/')
+    && (len < 1 || path[0] != '\\')
+    && (len < 2 || path[1] != ':')
+    && strncmp(path, "./", 2) != 0
+    && strncmp(path, ".\\", 2) != 0
+    && strncmp(path, "../", 3) != 0
+    && strncmp(path, "..\\", 3) != 0;
+}
+#else
+/* from Filename.is_implicit */
+static bool filename_is_implicit(const char *path)
+{
+  size_t len = strlen(path);
+  return (len < 1 || path[0] != '/')
+    && strncmp(path, "./", 2) != 0
+    && strncmp(path, "../", 3) != 0;
+}
 #endif
+static bool is_likely_ipv6(const char *address, const char *port)
+{
+  return (port - address >= 4) && address[0] == '[' && port[-1] == ']';
+}
 
 void caml_debugger_init(void)
 {
   char * address;
   char_os * a;
-  char * port, * p;
-  struct hostent * host;
+  char * port;
   value flags;
-  int n;
 
   flags = caml_alloc(2, Tag_cons);
   Store_field(flags, 0, Val_int(1)); /* Marshal.Closures */
@@ -188,7 +214,6 @@ void caml_debugger_init(void)
   address = a ? caml_stat_strdup_of_os(a) : NULL;
   if (address == NULL) return;
   if (dbg_addr != NULL) caml_stat_free(dbg_addr);
-  dbg_addr = address;
 
   /* #8676: erase the CAML_DEBUG_SOCKET variable so that processes
      created by the program being debugged do not try to connect with
@@ -203,45 +228,83 @@ void caml_debugger_init(void)
   winsock_startup();
   (void)atexit(winsock_cleanup);
 #endif
+
+  if (*address == 0)
+    caml_fatal_error("cannot connect to debugger: empty address");
+
   /* Parse the address */
-  port = NULL;
-  for (p = address; *p != 0; p++) {
-    if (*p == ':') { *p = 0; port = p+1; break; }
-  }
-  if (port == NULL) {
-    size_t a_len;
+  port = strrchr(address, ':');
+  if (port == NULL
+      /* "./foo" is explicitly a path and not a network address */
+      || !filename_is_implicit(address)) {
     /* Unix domain */
+    struct sockaddr_un *s_unix = (struct sockaddr_un *)&sock_addr;
     sock_domain = PF_UNIX;
-    sock_addr.s_unix.sun_family = AF_UNIX;
-    a_len = strlen(address);
-    if (a_len >= sizeof(sock_addr.s_unix.sun_path)) {
+    s_unix->sun_family = AF_UNIX;
+    size_t a_len = strlen(address);
+    if (a_len >= sizeof(s_unix->sun_path)) {
       caml_fatal_error
       (
         "debug socket path length exceeds maximum permitted length"
       );
     }
-    strncpy(sock_addr.s_unix.sun_path, address,
-            sizeof(sock_addr.s_unix.sun_path) - 1);
-    sock_addr.s_unix.sun_path[sizeof(sock_addr.s_unix.sun_path) - 1] = '\0';
-    sock_addr_len =
-      ((char *)&(sock_addr.s_unix.sun_path) - (char *)&(sock_addr.s_unix))
-        + a_len;
+    strncpy(s_unix->sun_path, address, sizeof(s_unix->sun_path) - 1);
+    s_unix->sun_path[sizeof(s_unix->sun_path) - 1] = '\0';
+    sock_addr_len = offsetof(struct sockaddr_un, sun_path) + a_len;
+    dbg_addr = address;
   } else {
     /* Internet domain */
-    sock_domain = PF_INET;
-    for (p = (char *) &sock_addr.s_inet, n = sizeof(sock_addr.s_inet);
-         n > 0; n--) *p++ = 0;
-    sock_addr.s_inet.sin_family = AF_INET;
-    sock_addr.s_inet.sin_addr.s_addr = inet_addr(address);
-    if (sock_addr.s_inet.sin_addr.s_addr == -1) {
-      host = gethostbyname(address);
-      if (host == NULL)
-        caml_fatal_error("unknown debugging host %s", address);
-      memmove(&sock_addr.s_inet.sin_addr,
-              host->h_addr_list[0], host->h_length);
+    struct addrinfo hints;
+    struct addrinfo *host;
+
+    memset(&hints, 0, sizeof(hints));
+    hints.ai_family = AF_UNSPEC;
+    hints.ai_socktype = SOCK_STREAM;
+#ifdef AI_NUMERICSERV
+    hints.ai_flags = AI_NUMERICSERV;
+#else
+    for (int i = 1; port[i]; i++)
+      if (port[i] < '0' || '9' < port[i])
+        caml_fatal_error("the port number should be an integer");
+#endif
+
+    if (is_likely_ipv6(address, port)) {
+      *address++ = 0;
+      port[-1] = 0;
+    }
+    *port++ = 0;
+
+    if (*address == 0 || *port == 0)
+      caml_fatal_error("empty host or empty port");
+
+    int ret = getaddrinfo(address, port, &hints, &host);
+    if (ret != 0) {
+      char buffer[512];
+      const char *err;
+#ifdef _WIN32
+      DWORD error = WSAGetLastError();
+      if (FormatMessageA(
+            FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, NULL,
+            error, 0, buffer, sizeof(buffer), NULL))
+        caml_fatal_error("cannot connect to debugger at %s port %s\nerror: %lu",
+                         address, port, error);
+      err = buffer;
+#else
+      err = ret != EAI_SYSTEM ? gai_strerror(ret)
+          : caml_strerror(errno, buffer, sizeof(buffer));
+#endif
+      caml_fatal_error("cannot connect to debugger at %s port %s\nerror: %s",
+                       address, port, err);
     }
-    sock_addr.s_inet.sin_port = htons(atoi(port));
-    sock_addr_len = sizeof(sock_addr.s_inet);
+    if (host == NULL)
+      caml_fatal_error("unknown debugging host %s port %s", address, port);
+
+    sock_domain = host->ai_family;
+    memcpy(&sock_addr, host->ai_addr, host->ai_addrlen);
+    sock_addr_len = host->ai_addrlen;
+    dbg_addr = address;
+
+    freeaddrinfo(host);
   }
   open_connection();
   caml_debugger_in_use = 1;
@@ -506,7 +569,7 @@ void caml_debugger(enum event_kind event, value param)
     case REQ_INITIAL_FRAME:
       frame_block = Caml_state->current_stack;
       frame = frame_block->sp + 1;
-      /* Fall through */
+      fallthrough;
     case REQ_GET_FRAME:
       caml_putword(dbg_out, frame_block_number (frame_block));
       caml_putword(dbg_out, Stack_high(frame_block) - frame);

diff --git a/runtime/domain.c b/runtime/domain.c
index c4cd54469613fe528adb4091330a4a0606057860..fff28b50febe0677c0721b6d7bcb87b9031035b1 100644 (file)
--- a/runtime/domain.c
+++ b/runtime/domain.c
@@ -68,6 +68,7 @@ typedef cpuset_t cpu_set_t;
 #include "caml/shared_heap.h"
 #include "caml/signals.h"
 #include "caml/startup.h"
+#include "caml/startup_aux.h"
 #include "caml/sync.h"
 #include "caml/weak.h"
 
@@ -167,9 +168,17 @@ struct interruptor {
   /* unlike the domain ID, this ID number is not reused */
   uintnat unique_id;
 
+  /* indicates whether there is an interrupt pending */
   atomic_uintnat interrupt_pending;
 };
 
+Caml_inline int interruptor_has_pending(struct interruptor *s)
+{ return atomic_load_acquire(&s->interrupt_pending) != 0; }
+Caml_inline void interruptor_set_handled(struct interruptor *s)
+{ atomic_store_release(&s->interrupt_pending, 0); }
+Caml_inline void interruptor_set_pending(struct interruptor *s)
+{ atomic_store_release(&s->interrupt_pending, 1); }
+
 struct dom_internal {
   /* readonly fields, initialised and never modified */
   int id;
@@ -189,53 +198,54 @@ struct dom_internal {
 };
 typedef struct dom_internal dom_internal;
 
-
 static struct {
-  atomic_uintnat domains_still_running;
+  /* enter barrier for STW sections, participating domains arrive into
+     the barrier before executing the STW callback */
+  caml_plat_barrier domains_still_running;
+  /* the number of domains that have yet to return from the callback */
   atomic_uintnat num_domains_still_processing;
   void (*callback)(caml_domain_state*,
                    void*,
                    int participating_count,
                    caml_domain_state** others_participating);
   void* data;
-  void (*enter_spin_callback)(caml_domain_state*, void*);
+  int (*enter_spin_callback)(caml_domain_state*, void*);
   void* enter_spin_data;
 
-  /* barrier state */
+  /* global_barrier state */
   int num_domains;
-  atomic_uintnat barrier;
+  caml_plat_barrier barrier;
 
-  caml_domain_state* participating[Max_domains];
+  caml_domain_state** participating;
 } stw_request = {
-  ATOMIC_UINTNAT_INIT(0),
-  ATOMIC_UINTNAT_INIT(0),
+  CAML_PLAT_BARRIER_INITIALIZER,
+  0,
   NULL,
   NULL,
   NULL,
   NULL,
   0,
-  ATOMIC_UINTNAT_INIT(0),
-  { 0 },
+  CAML_PLAT_BARRIER_INITIALIZER,
+  NULL
 };
 
 static caml_plat_mutex all_domains_lock = CAML_PLAT_MUTEX_INITIALIZER;
-static caml_plat_cond all_domains_cond =
-    CAML_PLAT_COND_INITIALIZER(&all_domains_lock);
+static caml_plat_cond all_domains_cond = CAML_PLAT_COND_INITIALIZER;
 static atomic_uintnat /* dom_internal* */ stw_leader = 0;
-static dom_internal all_domains[Max_domains];
+static uintnat stw_requests_suspended = 0; /* protected by all_domains_lock */
+static caml_plat_cond requests_suspended_cond = CAML_PLAT_COND_INITIALIZER;
+static dom_internal* all_domains;
 
 CAMLexport atomic_uintnat caml_num_domains_running;
 
-
-
 /* size of the virtual memory reservation for the minor heap, per domain */
 uintnat caml_minor_heap_max_wsz;
 /*
   The amount of memory reserved for all minor heaps of all domains is
-  Max_domains * caml_minor_heap_max_wsz. Individual domains can allocate
-  smaller minor heaps, but when a domain calls Gc.set to allocate a bigger minor
-  heap than this reservation, we perform a new virtual memory reservation based
-  on the increased minor heap size.
+  caml_params->max_domains * caml_minor_heap_max_wsz. Individual domains can
+  allocate smaller minor heaps, but when a domain calls Gc.set to allocate a
+  bigger minor heap than this reservation, we perform a new virtual memory
+  reservation based on the increased minor heap size.
 
   New domains are created with a minor heap of size
   caml_params->init_minor_heap_wsz.
@@ -250,28 +260,29 @@ CAMLexport uintnat caml_minor_heaps_end;
 static CAMLthread_local dom_internal* domain_self;
 
 /*
- * This structure is protected by all_domains_lock
- * [0, participating_domains) are all the domains taking part in STW sections
- * [participating_domains, Max_domains) are all those domains free to be used
+ * This structure is protected by all_domains_lock.
+ * [0, participating_domains) are all the domains taking part in STW sections.
+ * [participating_domains, caml_params->max_domains) are all those domains free
+ * to be used.
  */
 static struct {
   int participating_domains;
-  dom_internal* domains[Max_domains];
+  dom_internal** domains;
 } stw_domains = {
   0,
-  { 0 }
+  NULL
 };
 
 static void add_next_to_stw_domains(void)
 {
-  CAMLassert(stw_domains.participating_domains < Max_domains);
+  CAMLassert(stw_domains.participating_domains < caml_params->max_domains);
   stw_domains.participating_domains++;
 #ifdef DEBUG
   /* Enforce here the invariant for early-exit in
      [caml_interrupt_all_signal_safe], because the latter must be
      async-signal-safe and one cannot CAMLassert inside it. */
   bool prev_has_interrupt_word = true;
-  for (int i = 0; i < Max_domains; i++) {
+  for (int i = 0; i < caml_params->max_domains; i++) {
     bool has_interrupt_word = all_domains[i].interruptor.interrupt_word != NULL;
     if (i < stw_domains.participating_domains) CAMLassert(has_interrupt_word);
     if (!prev_has_interrupt_word) CAMLassert(!has_interrupt_word);
@@ -283,7 +294,7 @@ static void add_next_to_stw_domains(void)
 static void remove_from_stw_domains(dom_internal* dom) {
   int i;
   for(i=0; stw_domains.domains[i]!=dom; ++i) {
-    CAMLassert(i<Max_domains);
+    CAMLassert(i<caml_params->max_domains);
   }
   CAMLassert(i < stw_domains.participating_domains);
 
@@ -295,10 +306,10 @@ static void remove_from_stw_domains(dom_internal* dom) {
 }
 
 static dom_internal* next_free_domain(void) {
-  if (stw_domains.participating_domains == Max_domains)
+  if (stw_domains.participating_domains == caml_params->max_domains)
     return NULL;
 
-  CAMLassert(stw_domains.participating_domains < Max_domains);
+  CAMLassert(stw_domains.participating_domains < caml_params->max_domains);
   return stw_domains.domains[stw_domains.participating_domains];
 }
 
@@ -315,27 +326,27 @@ CAMLexport caml_domain_state* caml_get_domain_state(void)
 Caml_inline void interrupt_domain(struct interruptor* s)
 {
   atomic_uintnat * interrupt_word = atomic_load_relaxed(&s->interrupt_word);
-  atomic_store_release(interrupt_word, UINTNAT_MAX);
+  atomic_store_release(interrupt_word, CAML_UINTNAT_MAX);
 }
 
 Caml_inline void interrupt_domain_local(caml_domain_state* dom_st)
 {
-  atomic_store_relaxed(&dom_st->young_limit, UINTNAT_MAX);
+  atomic_store_relaxed(&dom_st->young_limit, CAML_UINTNAT_MAX);
 }
 
 int caml_incoming_interrupts_queued(void)
 {
-  return atomic_load_acquire(&domain_self->interruptor.interrupt_pending);
+  return interruptor_has_pending(&domain_self->interruptor);
 }
 
 /* must NOT be called with s->lock held */
 static void stw_handler(caml_domain_state* domain);
-static uintnat handle_incoming(struct interruptor* s)
+static int handle_incoming(struct interruptor* s)
 {
-  uintnat handled = atomic_load_acquire(&s->interrupt_pending);
-  CAMLassert (s->running);
+  int handled = interruptor_has_pending(s);
   if (handled) {
-    atomic_store_release(&s->interrupt_pending, 0);
+    CAMLassert (s->running);
+    interruptor_set_handled(s);
 
     stw_handler(domain_self->state);
   }
@@ -356,11 +367,12 @@ void caml_handle_incoming_interrupts(void)
 int caml_send_interrupt(struct interruptor* target)
 {
   /* signal that there is an interrupt pending */
-  atomic_store_release(&target->interrupt_pending, 1);
+  interruptor_set_pending(target);
 
-  /* Signal the condition variable, in case the target is
-     itself waiting for an interrupt to be processed elsewhere */
-  caml_plat_lock(&target->lock);
+  /* Signal the condition variable, in case the target is itself
+     waiting for an interrupt to be processed elsewhere, or to wake up
+     the backup thread. */
+  caml_plat_lock_blocking(&target->lock);
   caml_plat_broadcast(&target->cond); // OPT before/after unlock? elide?
   caml_plat_unlock(&target->lock);
 
@@ -369,26 +381,6 @@ int caml_send_interrupt(struct interruptor* target)
   return 1;
 }
 
-static void caml_wait_interrupt_serviced(struct interruptor* target)
-{
-  int i;
-
-  /* Often, interrupt handlers are fast, so spin for a bit before waiting */
-  for (i=0; i<1000; i++) {
-    if (!atomic_load_acquire(&target->interrupt_pending)) {
-      return;
-    }
-    cpu_relax();
-  }
-
-  {
-    SPIN_WAIT {
-      if (!atomic_load_acquire(&target->interrupt_pending))
-        return;
-    }
-  }
-}
-
 asize_t caml_norm_minor_heap_size (intnat wsize)
 {
   asize_t bs;
@@ -401,7 +393,7 @@ asize_t caml_norm_minor_heap_size (intnat wsize)
 /* The current minor heap layout is as follows:
 
 - A contiguous memory block of size
-   [caml_minor_heap_max_wsz * Max_domains]
+   [caml_minor_heap_max_wsz * caml_params->max_domains]
   is reserved by [caml_init_domains]. The boundaries
   of this reserved area are stored in the globals
     [caml_minor_heaps_start]
@@ -479,6 +471,7 @@ static void free_minor_heap(void) {
   domain_state->young_end     = NULL;
   domain_state->young_ptr     = NULL;
   domain_state->young_trigger = NULL;
+  domain_state->memprof_young_trigger = NULL;
   atomic_store_release(&domain_state->young_limit,
                    (uintnat) domain_state->young_start);
 }
@@ -521,7 +514,7 @@ static int allocate_minor_heap(asize_t wsize) {
    * major slice is scheduled. */
   domain_state->young_trigger = domain_state->young_start
          + (domain_state->young_end - domain_state->young_start) / 2;
-  caml_memprof_renew_minor_sample(domain_state);
+  caml_memprof_set_trigger(domain_state);
   caml_reset_young_limit(domain_state);
 
   check_minor_heap();
@@ -571,13 +564,32 @@ static void domain_create(uintnat initial_minor_heap_wsize,
 
   /* take the all_domains_lock so that we can alter the STW participant
      set atomically */
-  caml_plat_lock(&all_domains_lock);
+  caml_plat_lock_blocking(&all_domains_lock);
 
+  /* How many STW sections we are willing to wait for, any more are
+     prevented from happening */
+#define Max_stws_before_suspend 2
+  int stws_waited = 1;
   /* Wait until any in-progress STW sections end. */
   while (atomic_load_acquire(&stw_leader)) {
-    /* [caml_plat_wait] releases [all_domains_lock] until the current
-       STW section ends, and then takes the lock again. */
-    caml_plat_wait(&all_domains_cond);
+    if (stws_waited++ < Max_stws_before_suspend) {
+      /* [caml_plat_wait] releases [all_domains_lock] until the current
+         STW section ends, and then takes the lock again. */
+      caml_plat_wait(&all_domains_cond, &all_domains_lock);
+    } else {
+      /* Prevent new STW requests to avoid our own starvation */
+      stw_requests_suspended++;
+      /* Wait for the current STW to end */
+      do {
+        caml_plat_wait(&all_domains_cond, &all_domains_lock);
+      } while (atomic_load_acquire(&stw_leader));
+      if (--stw_requests_suspended == 0) {
+        /* Notify threads that were trying to run an STW section.
+           We still hold the lock, so they won't wake up yet. */
+        caml_plat_broadcast(&requests_suspended_cond);
+      }
+      break;
+    }
   }
 
   d = next_free_domain();
@@ -587,7 +599,7 @@ static void domain_create(uintnat initial_minor_heap_wsize,
 
   s = &d->interruptor;
   CAMLassert(!s->running);
-  CAMLassert(!s->interrupt_pending);
+  CAMLassert(!interruptor_has_pending(s));
 
   /* If the chosen domain slot has not been previously used, allocate a fresh
      domain state. Otherwise, reuse it.
@@ -614,7 +626,7 @@ static void domain_create(uintnat initial_minor_heap_wsize,
    * shared with a domain which is terminating (see
    * domain_terminate). */
 
-  caml_plat_lock(&d->domain_lock);
+  caml_plat_lock_blocking(&d->domain_lock);
 
   /* Set domain_self if we have successfully allocated the
    * caml_domain_state. Otherwise domain_self will be NULL and it's up
@@ -630,15 +642,17 @@ static void domain_create(uintnat initial_minor_heap_wsize,
   atomic_store_explicit(&s->interrupt_word, &domain_state->young_limit,
                         memory_order_release);
 
+  domain_state->id = d->id;
+
   /* Tell memprof system about the new domain before either (a) new
    * domain can allocate anything or (b) parent domain can go away. */
+  CAMLassert(domain_state->memprof == NULL);
   caml_memprof_new_domain(parent, domain_state);
   if (!domain_state->memprof) {
     goto init_memprof_failure;
   }
 
-  domain_state->id = d->id;
-  CAMLassert(!s->interrupt_pending);
+  CAMLassert(!interruptor_has_pending(s));
 
   domain_state->extra_heap_resources = 0.0;
   domain_state->extra_heap_resources_minor = 0.0;
@@ -708,6 +722,7 @@ static void domain_create(uintnat initial_minor_heap_wsize,
   domain_state->gc_regs = NULL;
 
   domain_state->allocated_words = 0;
+  domain_state->allocated_words_direct = 0;
   domain_state->swept_words = 0;
 
   domain_state->local_roots = NULL;
@@ -738,7 +753,6 @@ static void domain_create(uintnat initial_minor_heap_wsize,
   domain_state->trap_barrier_block = -1;
 #endif
 
-  caml_reset_young_limit(domain_state);
   add_next_to_stw_domains();
   goto domain_init_complete;
 
@@ -781,7 +795,7 @@ CAMLexport void caml_reset_domain_lock(void)
        prior to calling fork and then init afterwards in both parent
        and child. */
   caml_plat_mutex_init(&self->domain_lock);
-  caml_plat_cond_init(&self->domain_cond, &self->domain_lock);
+  caml_plat_cond_init(&self->domain_cond);
 
   return;
 }
@@ -797,7 +811,7 @@ static void reserve_minor_heaps_from_stw_single(void) {
           == Bsize_wsize(caml_minor_heap_max_wsz));
 
   minor_heap_max_bsz = (uintnat)Bsize_wsize(caml_minor_heap_max_wsz);
-  minor_heap_reservation_bsize = minor_heap_max_bsz * Max_domains;
+  minor_heap_reservation_bsize = minor_heap_max_bsz * caml_params->max_domains;
 
   /* reserve memory space for minor heaps */
   heaps_base = caml_mem_map(minor_heap_reservation_bsize, 1 /* reserve_only */);
@@ -810,7 +824,7 @@ static void reserve_minor_heaps_from_stw_single(void) {
   caml_gc_log("new minor heap reserved from %p to %p",
               (value*)caml_minor_heaps_start, (value*)caml_minor_heaps_end);
 
-  for (int i = 0; i < Max_domains; i++) {
+  for (int i = 0; i < caml_params->max_domains; i++) {
     struct dom_internal* dom = &all_domains[i];
 
     uintnat domain_minor_heap_area = caml_minor_heaps_start +
@@ -829,7 +843,7 @@ static void unreserve_minor_heaps_from_stw_single(void) {
 
   caml_gc_log("unreserve_minor_heaps");
 
-  for (int i = 0; i < Max_domains; i++) {
+  for (int i = 0; i < caml_params->max_domains; i++) {
     struct dom_internal* dom = &all_domains[i];
 
     CAMLassert(
@@ -851,50 +865,54 @@ static void unreserve_minor_heaps_from_stw_single(void) {
   }
 
   size = caml_minor_heaps_end - caml_minor_heaps_start;
-  CAMLassert (Bsize_wsize(caml_minor_heap_max_wsz) * Max_domains == size);
+  CAMLassert (Bsize_wsize(caml_minor_heap_max_wsz) * caml_params->max_domains
+              == size);
   caml_mem_unmap((void *) caml_minor_heaps_start, size);
 }
 
-static void stw_resize_minor_heap_reservation(caml_domain_state* domain,
-                                       void* minor_wsz_data,
-                                       int participating_count,
-                                       caml_domain_state** participating) {
-  barrier_status b;
-  uintnat new_minor_wsz = (uintnat) minor_wsz_data;
+static
+void domain_resize_heap_reservation_from_stw_single(uintnat new_minor_wsz)
+{
+  CAML_EV_BEGIN(EV_DOMAIN_RESIZE_HEAP_RESERVATION);
+  caml_gc_log("stw_resize_minor_heap_reservation: "
+              "unreserve_minor_heaps");
 
+  unreserve_minor_heaps_from_stw_single();
+  /* new_minor_wsz is page-aligned because caml_norm_minor_heap_size has
+     been called to normalize it earlier.
+  */
+  caml_minor_heap_max_wsz = new_minor_wsz;
+  caml_gc_log("stw_resize_minor_heap_reservation: reserve_minor_heaps");
+  reserve_minor_heaps_from_stw_single();
+  /* The call to [reserve_minor_heaps_from_stw_single] makes a new
+     reservation, and it also updates the reservation boundaries of each
+     domain by mutating its [minor_heap_area_start{,_end}] variables.
+
+     These variables are synchronized by the fact that we are inside
+     a STW section: no other domains are running in parallel, and
+     the participating domains will synchronize with this write by
+     exiting the barrier, before they read those variables in
+     [allocate_minor_heap] below. */
+  CAML_EV_END(EV_DOMAIN_RESIZE_HEAP_RESERVATION);
+}
+
+static void
+stw_resize_minor_heap_reservation(caml_domain_state* domain,
+                                  void* minor_wsz_data,
+                                  int participating_count,
+                                  caml_domain_state** participating) {
   caml_gc_log("stw_resize_minor_heap_reservation: "
               "caml_empty_minor_heap_no_major_slice_from_stw");
-  caml_empty_minor_heap_no_major_slice_from_stw(domain, NULL,
-                                            participating_count, participating);
+  caml_empty_minor_heap_no_major_slice_from_stw(
+    domain, NULL, participating_count, participating);
 
   caml_gc_log("stw_resize_minor_heap_reservation: free_minor_heap");
   free_minor_heap();
 
-  b = caml_global_barrier_begin ();
-  if (caml_global_barrier_is_final(b)) {
-    CAML_EV_BEGIN(EV_DOMAIN_RESIZE_HEAP_RESERVATION);
-    caml_gc_log("stw_resize_minor_heap_reservation: "
-                "unreserve_minor_heaps");
-
-    unreserve_minor_heaps_from_stw_single();
-    /* new_minor_wsz is page-aligned because caml_norm_minor_heap_size has
-       been called to normalize it earlier.
-    */
-    caml_minor_heap_max_wsz = new_minor_wsz;
-    caml_gc_log("stw_resize_minor_heap_reservation: reserve_minor_heaps");
-    reserve_minor_heaps_from_stw_single();
-    /* The call to [reserve_minor_heaps_from_stw_single] makes a new
-       reservation, and it also updates the reservation boundaries of each
-       domain by mutating its [minor_heap_area_start{,_end}] variables.
-
-       These variables are synchronized by the fact that we are inside
-       a STW section: no other domains are running in parallel, and
-       the participating domains will synchronize with this write by
-       exiting the barrier, before they read those variables in
-       [allocate_minor_heap] below. */
-    CAML_EV_END(EV_DOMAIN_RESIZE_HEAP_RESERVATION);
+  Caml_global_barrier_if_final(participating_count) {
+    uintnat new_minor_wsz = (uintnat) minor_wsz_data;
+    domain_resize_heap_reservation_from_stw_single(new_minor_wsz);
   }
-  caml_global_barrier_end(b);
 
   caml_gc_log("stw_resize_minor_heap_reservation: "
               "allocate_minor_heap");
@@ -918,13 +936,27 @@ void caml_update_minor_heap_max(uintnat requested_wsz) {
   check_minor_heap();
 }
 
-void caml_init_domains(uintnat minor_heap_wsz) {
-  int i;
+void caml_init_domains(uintnat max_domains, uintnat minor_heap_wsz)
+{
+  /* Use [caml_stat_calloc_noexc] to zero initialize [all_domains]. */
+  all_domains = caml_stat_calloc_noexc(max_domains, sizeof(dom_internal));
+  if (all_domains == NULL)
+    caml_fatal_error("Failed to allocate all_domains");
+
+  stw_request.participating =
+      caml_stat_calloc_noexc(max_domains, sizeof(dom_internal*));
+  if (stw_request.participating == NULL)
+    caml_fatal_error("Failed to allocate stw_request.participating");
+
+  stw_domains.domains =
+      caml_stat_calloc_noexc(max_domains, sizeof(dom_internal*));
+  if (stw_domains.domains == NULL)
+    caml_fatal_error("Failed to allocate stw_domains.domains");
 
   reserve_minor_heaps_from_stw_single();
   /* stw_single: mutators and domains have not started yet. */
 
-  for (i = 0; i < Max_domains; i++) {
+  for (int i = 0; i < max_domains; i++) {
     struct dom_internal* dom = &all_domains[i];
 
     stw_domains.domains[i] = dom;
@@ -933,15 +965,14 @@ void caml_init_domains(uintnat minor_heap_wsz) {
 
     dom->interruptor.interrupt_word = NULL;
     caml_plat_mutex_init(&dom->interruptor.lock);
-    caml_plat_cond_init(&dom->interruptor.cond,
-                        &dom->interruptor.lock);
+    caml_plat_cond_init(&dom->interruptor.cond);
     dom->interruptor.running = 0;
     dom->interruptor.terminating = 0;
     dom->interruptor.unique_id = 0;
     dom->interruptor.interrupt_pending = 0;
 
     caml_plat_mutex_init(&dom->domain_lock);
-    caml_plat_cond_init(&dom->domain_cond, &dom->domain_lock);
+    caml_plat_cond_init(&dom->domain_cond);
     dom->backup_thread_running = 0;
     dom->backup_thread_msg = BT_INIT;
   }
@@ -954,7 +985,8 @@ void caml_init_domains(uintnat minor_heap_wsz) {
 }
 
 void caml_init_domain_self(int domain_id) {
-  CAMLassert (domain_id >= 0 && domain_id < Max_domains);
+  CAMLassert(0 <= domain_id);
+  CAMLassert(domain_id < caml_params->max_domains);
   domain_self = &all_domains[domain_id];
   caml_state = domain_self->state;
 }
@@ -1026,14 +1058,14 @@ static void* backup_thread_func(void* v)
             caml_plat_unlock(&di->domain_lock);
           }
         }
-        /* Wait safely if there is nothing to do.
-         * Will be woken from caml_leave_blocking_section
+        /* Wait safely if there is nothing to do. Will be woken from
+         * caml_send_interrupt and domain_terminate.
          */
-        caml_plat_lock(&s->lock);
+        caml_plat_lock_blocking(&s->lock);
         msg = atomic_load_acquire (&di->backup_thread_msg);
         if (msg == BT_IN_BLOCKING_SECTION &&
             !caml_incoming_interrupts_queued())
-          caml_plat_wait(&s->cond);
+          caml_plat_wait(&s->cond, &s->lock);
         caml_plat_unlock(&s->lock);
         break;
       case BT_ENTERING_OCAML:
@@ -1041,10 +1073,10 @@ static void* backup_thread_func(void* v)
          * Will be woken from caml_bt_exit_ocaml
          * or domain_terminate
          */
-        caml_plat_lock(&di->domain_lock);
+        caml_plat_lock_blocking(&di->domain_lock);
         msg = atomic_load_acquire (&di->backup_thread_msg);
         if (msg == BT_ENTERING_OCAML)
-          caml_plat_wait(&di->domain_cond);
+          caml_plat_wait(&di->domain_cond, &di->domain_lock);
         caml_plat_unlock(&di->domain_lock);
         break;
       default:
@@ -1077,7 +1109,7 @@ static void install_backup_thread (dom_internal* di)
       /* Give a chance for backup thread on this domain to terminate */
       caml_plat_unlock (&di->domain_lock);
       cpu_relax ();
-      caml_plat_lock (&di->domain_lock);
+      caml_plat_lock_blocking(&di->domain_lock);
       msg = atomic_load_acquire(&di->backup_thread_msg);
     }
 
@@ -1130,18 +1162,15 @@ CAMLexport _Atomic caml_timing_hook caml_domain_terminated_hook =
 
 static void domain_terminate(void);
 
-static value make_finished(value res_or_exn)
+static value make_finished(caml_result result)
 {
   CAMLparam0();
   CAMLlocal1(res);
-  if (Is_exception_result(res_or_exn)) {
-    res = Extract_exception(res_or_exn);
-    /* [Error res] */
-    res = caml_alloc_1(1, res);
-  } else {
-    /* [Ok res_of_exn] */
-    res = caml_alloc_1(0, res_or_exn);
-  }
+  res = caml_alloc_1(
+    (caml_result_is_exception(result) ?
+     1 /* Error */ :
+     0 /* Ok */),
+    result.data);
   /* [Finished res] */
   res = caml_alloc_1(0, res);
   CAMLreturn(res);
@@ -1187,7 +1216,7 @@ static void* domain_thread_func(void* v)
   p->newdom = domain_self;
 
   /* handshake with the parent domain */
-  caml_plat_lock(&p->parent->interruptor.lock);
+  caml_plat_lock_blocking(&p->parent->interruptor.lock);
   if (domain_self) {
     p->status = Dom_started;
     p->unique_id = domain_self->interruptor.unique_id;
@@ -1212,8 +1241,8 @@ static void* domain_thread_func(void* v)
        see the [note about callbacks and GC] in callback.c */
     value unrooted_callback = ml_values->callback;
     caml_modify_generational_global_root(&ml_values->callback, Val_unit);
-    value res_or_exn = caml_callback_exn(unrooted_callback, Val_unit);
-    value res = make_finished(res_or_exn);
+    value res =
+      make_finished(caml_callback_res(unrooted_callback, Val_unit));
     sync_result(ml_values->term_sync, res);
 
     sync_mutex mut = Mutex_val(*Term_mutex(ml_values->term_sync));
@@ -1270,17 +1299,18 @@ CAMLprim value caml_domain_spawn(value callback, value term_sync)
 
   /* While waiting for the child thread to start up, we need to service any
      stop-the-world requests as they come in. */
-  caml_plat_lock(&domain_self->interruptor.lock);
+  struct interruptor *interruptor = &domain_self->interruptor;
+  caml_plat_lock_blocking(&interruptor->lock);
   while (p.status == Dom_starting) {
     if (caml_incoming_interrupts_queued()) {
-      caml_plat_unlock(&domain_self->interruptor.lock);
-      handle_incoming(&domain_self->interruptor);
-      caml_plat_lock(&domain_self->interruptor.lock);
+      caml_plat_unlock(&interruptor->lock);
+      handle_incoming(interruptor);
+      caml_plat_lock_blocking(&interruptor->lock);
     } else {
-      caml_plat_wait(&domain_self->interruptor.cond);
+      caml_plat_wait(&interruptor->cond, &interruptor->lock);
     }
   }
-  caml_plat_unlock(&domain_self->interruptor.lock);
+  caml_plat_unlock(&interruptor->lock);
 
   if (p.status == Dom_started) {
     /* successfully created a domain.
@@ -1306,42 +1336,75 @@ CAMLprim value caml_ml_domain_id(value unit)
   return Val_long(domain_self->interruptor.unique_id);
 }
 
-/* sense-reversing barrier */
-#define BARRIER_SENSE_BIT 0x100000
+CAMLprim value caml_ml_domain_index(value unit)
+{
+  CAMLnoalloc;
+  return Val_long(domain_self->id);
+}
+
+/* Global barrier implementation */
 
-barrier_status caml_global_barrier_begin(void)
+Caml_inline int global_barrier_is_nth(barrier_status b, int n) {
+  return (b & ~BARRIER_SENSE_BIT) == n;
+}
+
+static barrier_status global_barrier_begin(void)
 {
-  uintnat b = 1 + atomic_fetch_add(&stw_request.barrier, 1);
-  return b;
+  return caml_plat_barrier_arrive(&stw_request.barrier);
 }
 
-int caml_global_barrier_is_final(barrier_status b)
+/* last domain into the barrier, flip sense */
+static void global_barrier_flip(barrier_status sense)
 {
-  return ((b & ~BARRIER_SENSE_BIT) == stw_request.num_domains);
+  caml_plat_barrier_flip(&stw_request.barrier, sense);
 }
 
-void caml_global_barrier_end(barrier_status b)
+/* wait until another domain flips the sense */
+static void global_barrier_wait(barrier_status sense, int num_participating)
 {
-  uintnat sense = b & BARRIER_SENSE_BIT;
-  if (caml_global_barrier_is_final(b)) {
-    /* last domain into the barrier, flip sense */
-    atomic_store_release(&stw_request.barrier, sense ^ BARRIER_SENSE_BIT);
-  } else {
-    /* wait until another domain flips the sense */
-    SPIN_WAIT {
-      uintnat barrier = atomic_load_acquire(&stw_request.barrier);
-      if ((barrier & BARRIER_SENSE_BIT) != sense) break;
+  /* it's not worth spinning for too long if there's more than one other domain
+   */
+  unsigned spins = num_participating == 2 ? Max_spins_long : Max_spins_medium;
+  SPIN_WAIT_NTIMES(spins) {
+    if (caml_plat_barrier_sense_has_flipped(&stw_request.barrier, sense)) {
+      return;
     }
   }
+  /* just block */
+  caml_plat_barrier_wait_sense(&stw_request.barrier, sense);
 }
 
-void caml_global_barrier(void)
+void caml_enter_global_barrier(int num_participating)
 {
-  barrier_status b = caml_global_barrier_begin();
-  caml_global_barrier_end(b);
+  CAMLassert(num_participating == stw_request.num_domains);
+  barrier_status b = global_barrier_begin();
+  barrier_status sense = b & BARRIER_SENSE_BIT;
+  if (global_barrier_is_nth(b, num_participating)) {
+    global_barrier_flip(sense);
+  } else {
+    global_barrier_wait(sense, num_participating);
+  }
+}
+
+barrier_status caml_global_barrier_and_check_final(int num_participating)
+{
+  CAMLassert(num_participating == stw_request.num_domains);
+  barrier_status b = global_barrier_begin();
+  if (global_barrier_is_nth(b, num_participating)) {
+    CAMLassert(b); /* always nonzero */
+    return b;
+  } else {
+    global_barrier_wait(b & BARRIER_SENSE_BIT, num_participating);
+    return 0;
+  }
+}
+
+void caml_global_barrier_release_as_final(barrier_status b)
+{
+  global_barrier_flip(b & BARRIER_SENSE_BIT);
 }
 
-int caml_global_barrier_num_domains(void)
+int caml_global_barrier_num_participating(void)
 {
   return stw_request.num_domains;
 }
@@ -1356,7 +1419,7 @@ static void decrement_stw_domains_still_processing(void)
 
   if( am_last ) {
     /* release the STW lock to allow new STW sections */
-    caml_plat_lock(&all_domains_lock);
+    caml_plat_lock_blocking(&all_domains_lock);
     atomic_store_release(&stw_leader, 0);
     caml_plat_broadcast(&all_domains_cond);
     caml_gc_log("clearing stw leader");
@@ -1364,20 +1427,58 @@ static void decrement_stw_domains_still_processing(void)
   }
 }
 
-static void stw_handler(caml_domain_state* domain)
+/* Wait for other running domains to stop, called by interrupted
+   domains before entering the STW section */
+static void stw_wait_for_running(caml_domain_state* domain)
 {
-  CAML_EV_BEGIN(EV_STW_HANDLER);
-  CAML_EV_BEGIN(EV_STW_API_BARRIER);
-  {
-    SPIN_WAIT {
-      if (atomic_load_acquire(&stw_request.domains_still_running) == 0)
+  /* The STW leader issues interrupts to all domains, then they all
+     arrive into this barrier, with the last one releasing it; this
+     tends to (and should) be fast, but we likely need to wait a bit
+     in any case */
+
+  if (stw_request.enter_spin_callback) {
+    /* Spin while there is useful work to do */
+    SPIN_WAIT_BOUNDED {
+      if (caml_plat_barrier_is_released(&stw_request.domains_still_running)) {
+        return;
+      }
+
+      if (!stw_request.enter_spin_callback
+            (domain, stw_request.enter_spin_data)) {
         break;
+      }
+    }
+  }
 
-      if (stw_request.enter_spin_callback)
-        stw_request.enter_spin_callback(domain, stw_request.enter_spin_data);
+  /* Spin a bit for the other domains */
+  SPIN_WAIT_NTIMES(Max_spins_long) {
+    if (caml_plat_barrier_is_released(&stw_request.domains_still_running)) {
+      return;
     }
   }
+
+  /* If we're still waiting, block */
+  caml_plat_barrier_wait(&stw_request.domains_still_running);
+}
+
+static void stw_api_barrier(caml_domain_state* domain)
+{
+  CAML_EV_BEGIN(EV_STW_API_BARRIER);
+  if (caml_plat_barrier_arrive(&stw_request.domains_still_running)
+      == stw_request.num_domains) {
+    caml_plat_barrier_release(&stw_request.domains_still_running);
+  } else {
+    stw_wait_for_running(domain);
+  }
   CAML_EV_END(EV_STW_API_BARRIER);
+}
+
+static void stw_handler(caml_domain_state* domain)
+{
+  CAML_EV_BEGIN(EV_STW_HANDLER);
+  if (!caml_plat_barrier_is_released(&stw_request.domains_still_running)) {
+    stw_api_barrier(domain);
+  }
 
   #ifdef DEBUG
   Caml_state->inside_stw_handler = 1;
@@ -1424,9 +1525,11 @@ int caml_domain_is_in_stw(void) {
      this function in a loop.)
 
    - Domain initialization code from [domain_create] will not run in
-     parallel with a STW section, as [domain_create] starts by
-     looping until (1) it has the [all_domains_lock] and (2) there is
-     no current STW section (using the [stw_leader] variable).
+     parallel with a STW section, as [domain_create] starts by looping
+     until (1) it has the [all_domains_lock] and (2) there is no
+     current STW section (using the [stw_leader] variable). To avoid
+     starvation, [domain_create] will prevent new STW sections if it
+     can't make progress.
 
    - Domain cleanup code runs after the terminating domain may run in
      parallel to a STW section, but only after that domain has safely
@@ -1474,7 +1577,7 @@ int caml_try_run_on_all_domains_with_spin_work(
   void (*handler)(caml_domain_state*, void*, int, caml_domain_state**),
   void* data,
   void (*leader_setup)(caml_domain_state*),
-  void (*enter_spin_callback)(caml_domain_state*, void*),
+  int (*enter_spin_callback)(caml_domain_state*, void*),
   void* enter_spin_data)
 {
   int i;
@@ -1496,11 +1599,24 @@ int caml_try_run_on_all_domains_with_spin_work(
     return 0;
   }
 
-  /* see if there is a stw_leader already */
-  if (atomic_load_acquire(&stw_leader)) {
-    caml_plat_unlock(&all_domains_lock);
-    caml_handle_incoming_interrupts();
-    return 0;
+  while (1) {
+    /* see if there is a stw_leader already */
+    if (atomic_load_acquire(&stw_leader)) {
+      caml_plat_unlock(&all_domains_lock);
+      caml_handle_incoming_interrupts();
+      return 0;
+    }
+
+    /* STW requests may be suspended by [domain_create], in which case, instead
+       of claiming the stw_leader, we should release the lock and wait for
+       requests to be unsuspended before trying again */
+    if (CAMLunlikely(stw_requests_suspended)) {
+      caml_plat_wait(&requests_suspended_cond, &all_domains_lock);
+      /* we hold the lock, but we must check for [stw_leader] again */
+      continue;
+    }
+
+    break;
   }
 
   /* we have the lock and can claim the stw_leader */
@@ -1509,17 +1625,23 @@ int caml_try_run_on_all_domains_with_spin_work(
   CAML_EV_BEGIN(EV_STW_LEADER);
   caml_gc_log("causing STW");
 
-  /* setup all fields for this stw_request, must have those needed
-     for domains waiting at the enter spin barrier */
+  /* set up all fields for this stw_request; they must be available
+     for domains when they get interrupted */
   stw_request.enter_spin_callback = enter_spin_callback;
   stw_request.enter_spin_data = enter_spin_data;
   stw_request.callback = handler;
   stw_request.data = data;
-  atomic_store_release(&stw_request.barrier, 0);
-  atomic_store_release(&stw_request.domains_still_running, sync);
   stw_request.num_domains = stw_domains.participating_domains;
+  /* stw_request.barrier doesn't need resetting */
   atomic_store_release(&stw_request.num_domains_still_processing,
-                   stw_domains.participating_domains);
+                       stw_domains.participating_domains);
+
+  int is_alone = stw_request.num_domains == 1;
+  int should_sync = sync && !is_alone;
+
+  if (should_sync) {
+    caml_plat_barrier_reset(&stw_request.domains_still_running);
+  }
 
   if( leader_setup ) {
     leader_setup(domain_state);
@@ -1528,7 +1650,7 @@ int caml_try_run_on_all_domains_with_spin_work(
 #ifdef DEBUG
   {
     int domains_participating = 0;
-    for(i=0; i<Max_domains; i++) {
+    for(i=0; i<caml_params->max_domains; i++) {
       if(all_domains[i].interruptor.running)
         domains_participating++;
     }
@@ -1541,7 +1663,7 @@ int caml_try_run_on_all_domains_with_spin_work(
   for(i = 0; i < stw_domains.participating_domains; i++) {
     dom_internal * d = stw_domains.domains[i];
     stw_request.participating[i] = d->state;
-    CAMLassert(!d->interruptor.interrupt_pending);
+    CAMLassert(!interruptor_has_pending(&d->interruptor));
     if (d->state != domain_state) caml_send_interrupt(&d->interruptor);
   }
 
@@ -1562,14 +1684,11 @@ int caml_try_run_on_all_domains_with_spin_work(
   */
   caml_plat_unlock(&all_domains_lock);
 
-  for(i = 0; i < stw_request.num_domains; i++) {
-    int id = stw_request.participating[i]->id;
-    caml_wait_interrupt_serviced(&all_domains[id].interruptor);
+  /* arrive at enter barrier */
+  if (should_sync) {
+    stw_api_barrier(domain_state);
   }
 
-  /* release from the enter barrier */
-  atomic_store_release(&stw_request.domains_still_running, 0);
-
   #ifdef DEBUG
   domain_state->inside_stw_handler = 1;
   #endif
@@ -1618,10 +1737,14 @@ void caml_interrupt_self(void)
   interrupt_domain_local(Caml_state);
 }
 
-/* async-signal-safe */
+/*  This function is async-signal-safe as [all_domains] and
+    [caml_params->max_domains] are set before signal handlers are installed and
+    do not change afterwards. */
 void caml_interrupt_all_signal_safe(void)
 {
-  for (dom_internal *d = all_domains; d < &all_domains[Max_domains]; d++) {
+  for (dom_internal *d = all_domains;
+       d < &all_domains[caml_params->max_domains];
+       d++) {
     /* [all_domains] is an array of values. So we can access
        [interrupt_word] directly without synchronisation other than
        with other people who access the same [interrupt_word].*/
@@ -1657,7 +1780,7 @@ void caml_reset_young_limit(caml_domain_state * dom_st)
   /* For non-delayable asynchronous actions, we immediately interrupt
      the domain again. */
   dom_internal * d = &all_domains[dom_st->id];
-  if (atomic_load_relaxed(&d->interruptor.interrupt_pending)
+  if (interruptor_has_pending(&d->interruptor)
       || dom_st->requested_minor_gc
       || dom_st->requested_major_slice
       || dom_st->major_slice_epoch < atomic_load (&caml_major_slice_epoch)) {
@@ -1806,7 +1929,7 @@ CAMLexport intnat caml_domain_is_multicore (void)
 CAMLexport void caml_acquire_domain_lock(void)
 {
   dom_internal* self = domain_self;
-  caml_plat_lock(&self->domain_lock);
+  caml_plat_lock_blocking(&self->domain_lock);
   caml_state = self->state;
 }
 
@@ -1896,7 +2019,7 @@ static void domain_terminate (void)
 
     /* take the all_domains_lock to try and exit the STW participant set
        without racing with a STW section being triggered */
-    caml_plat_lock(&all_domains_lock);
+    caml_plat_lock_blocking(&all_domains_lock);
 
     /* The interaction of termination and major GC is quite subtle.
 
@@ -1922,7 +2045,7 @@ static void domain_terminate (void)
       /* signal the interruptor condition variable
        * because the backup thread may be waiting on it
        */
-      caml_plat_lock(&s->lock);
+      caml_plat_lock_blocking(&s->lock);
       caml_plat_broadcast(&s->cond);
       caml_plat_unlock(&s->lock);
 
@@ -2052,8 +2175,8 @@ CAMLprim value caml_recommended_domain_count(value unused)
   /* At least one, even if system says zero */
   if (n <= 0)
     n = 1;
-  else if (n > Max_domains)
-    n = Max_domains;
+  else if (n > caml_params->max_domains)
+    n = caml_params->max_domains;
 
   return (Val_long(n));
 }

diff --git a/runtime/dynlink.c b/runtime/dynlink.c
index 4fe926c6e8e7319465606c329b7fa6e345d63f8e..c06f8adb9aac5f044c2e6f7d43668d3c84d895a5 100644 (file)
--- a/runtime/dynlink.c
+++ b/runtime/dynlink.c
@@ -26,6 +26,9 @@
 #ifdef HAS_UNISTD
 #include <unistd.h>
 #endif
+#ifdef _WIN32
+#include <io.h>
+#endif
 #include "caml/alloc.h"
 #include "caml/dynlink.h"
 #include "caml/fail.h"
@@ -62,14 +65,13 @@ struct ext_table caml_shared_libs_path;
    then in the opened shared libraries (shared_libs) */
 static c_primitive lookup_primitive(char * name)
 {
-  int i;
   void * res;
 
-  for (i = 0; caml_names_of_builtin_cprim[i] != NULL; i++) {
+  for (int i = 0; caml_names_of_builtin_cprim[i] != NULL; i++) {
     if (strcmp(name, caml_names_of_builtin_cprim[i]) == 0)
       return caml_builtin_cprim[i];
   }
-  for (i = 0; i < shared_libs.size; i++) {
+  for (int i = 0; i < shared_libs.size; i++) {
     res = caml_dlsym(shared_libs.contents[i], name);
     if (res != NULL) return (c_primitive) res;
   }
@@ -168,9 +170,6 @@ void caml_build_primitive_table(char_os * lib_path,
                                 char_os * libs,
                                 char * req_prims)
 {
-  char_os * p;
-  char * q;
-
   /* Initialize the search path for dynamic libraries:
      - directories specified on the command line with the -I option
      - directories specified in the CAML_LD_LIBRARY_PATH
@@ -182,19 +181,19 @@ void caml_build_primitive_table(char_os * lib_path,
   caml_decompose_path(&caml_shared_libs_path,
                       caml_secure_getenv(T("CAML_LD_LIBRARY_PATH")));
   if (lib_path != NULL)
-    for (p = lib_path; *p != 0; p += strlen_os(p) + 1)
+    for (char_os *p = lib_path; *p != 0; p += strlen_os(p) + 1)
       caml_ext_table_add(&caml_shared_libs_path, p);
   caml_parse_ld_conf();
   /* Open the shared libraries */
   caml_ext_table_init(&shared_libs, 8);
   if (libs != NULL)
-    for (p = libs; *p != 0; p += strlen_os(p) + 1)
+    for (char_os *p = libs; *p != 0; p += strlen_os(p) + 1)
       open_shared_lib(p);
   /* Build the primitive table */
   caml_ext_table_init(&caml_prim_table, 0x180);
   caml_ext_table_init(&caml_prim_name_table, 0x180);
   if (req_prims != NULL)
-    for (q = req_prims; *q != 0; q += strlen(q) + 1) {
+    for (char *q = req_prims; *q != 0; q += strlen(q) + 1) {
       c_primitive prim = lookup_primitive(q);
       if (prim == NULL)
             caml_fatal_error("unknown C primitive `%s'", q);
@@ -208,9 +207,8 @@ void caml_build_primitive_table(char_os * lib_path,
 
 void caml_build_primitive_table_builtin(void)
 {
-  int i;
   caml_build_primitive_table(NULL, NULL, NULL);
-  for (i = 0; caml_builtin_cprim[i] != 0; i++) {
+  for (int i = 0; caml_builtin_cprim[i] != 0; i++) {
     caml_ext_table_add(&caml_prim_table, (void *) caml_builtin_cprim[i]);
     caml_ext_table_add(&caml_prim_name_table,
                        caml_stat_strdup(caml_names_of_builtin_cprim[i]));
@@ -227,7 +225,6 @@ CAMLprim value caml_dynlink_get_bytecode_sections(value unit)
 {
   CAMLparam1(unit);
   CAMLlocal4(ret, tbl, list, str);
-  int i, j;
   ret = caml_alloc(4, 0);
 
   if (caml_params->section_table != NULL) {
@@ -235,8 +232,8 @@ CAMLprim value caml_dynlink_get_bytecode_sections(value unit)
     const char* sec_names[] = {"SYMB", "CRCS"};
     tbl = caml_input_value_from_block(caml_params->section_table,
                                       caml_params->section_table_size);
-    for (i = 0; i < sizeof(sec_names)/sizeof(sec_names[0]); i++) {
-      for (j = 0; j < Wosize_val(tbl); j++) {
+    for (int i = 0; i < sizeof(sec_names)/sizeof(sec_names[0]); i++) {
+      for (int j = 0; j < Wosize_val(tbl); j++) {
         value kv = Field(tbl, j);
         if (!strcmp(sec_names[i], String_val(Field(kv, 0))))
           Store_field(ret, i, Field(kv, 1));
@@ -281,14 +278,14 @@ CAMLprim value caml_dynlink_get_bytecode_sections(value unit)
   }
 
   list = Val_emptylist;
-  for (i = caml_prim_name_table.size - 1; i >= 0; i--) {
+  for (int i = caml_prim_name_table.size - 1; i >= 0; i--) {
     str = caml_copy_string(caml_prim_name_table.contents[i]);
     list = caml_alloc_2(Tag_cons, str, list);
   }
   Store_field(ret, 2, list);
 
   list = Val_emptylist;
-  for (i = caml_shared_libs_path.size - 1; i >= 0; i--) {
+  for (int i = caml_shared_libs_path.size - 1; i >= 0; i--) {
     str = caml_copy_string_of_os(caml_shared_libs_path.contents[i]);
     list = caml_alloc_2(Tag_cons, str, list);
   }
@@ -353,10 +350,9 @@ CAMLprim value caml_dynlink_get_current_libs(value unit)
 {
   CAMLparam0();
   CAMLlocal1(res);
-  int i;
 
   res = caml_alloc_tuple(shared_libs.size);
-  for (i = 0; i < shared_libs.size; i++) {
+  for (int i = 0; i < shared_libs.size; i++) {
     value v = caml_alloc_small(1, Abstract_tag);
     Handle_val(v) = shared_libs.contents[i];
     Store_field(res, i, v);

diff --git a/runtime/dynlink_nat.c b/runtime/dynlink_nat.c
index 1f1349f85786dc46224c48d7ecc1dbd848939028..bec1904aefe9841d713c3e51c257013b4298fd7a 100644 (file)
--- a/runtime/dynlink_nat.c
+++ b/runtime/dynlink_nat.c
@@ -111,14 +111,13 @@ CAMLprim value caml_natdynlink_open(value filename, value global)
 
 CAMLprim value caml_natdynlink_register(value handle_v, value symbols) {
   CAMLparam2 (handle_v, symbols);
-  int i;
   int nsymbols = Wosize_val(symbols);
   void* handle = Handle_val(handle_v);
   void** table;
 
   table = caml_stat_alloc(sizeof(void*) * nsymbols);
 
-  for (i = 0; i < nsymbols; i++) {
+  for (int i = 0; i < nsymbols; i++) {
     const char* unit = String_val(Field(symbols, i));
     table[i] = getsym(handle, unit, "frametable");
     if (table[i] == NULL) {
@@ -129,7 +128,7 @@ CAMLprim value caml_natdynlink_register(value handle_v, value symbols) {
   }
   caml_register_frametables(table, nsymbols);
 
-  for (i = 0; i < nsymbols; i++) {
+  for (int i = 0; i < nsymbols; i++) {
     const char* unit = String_val(Field(symbols, i));
     table[i] = getsym(handle, unit, "gc_roots");
     if (table[i] == NULL) {
@@ -140,7 +139,7 @@ CAMLprim value caml_natdynlink_register(value handle_v, value symbols) {
   }
   caml_register_dyn_globals(table, nsymbols);
 
-  for (i = 0; i < nsymbols; i++) {
+  for (int i = 0; i < nsymbols; i++) {
     const char* unit = String_val(Field(symbols, i));
     void* sym = getsym(handle, unit, "code_begin");
     void* sym2 = getsym(handle, unit, "code_end");

diff --git a/runtime/extern.c b/runtime/extern.c
index a7ea828123468032361aff1bade7c24d1433a874..a0374e9c0712a25bc2c63de09b8536b0d06ec46f 100644 (file)
--- a/runtime/extern.c
+++ b/runtime/extern.c
@@ -20,6 +20,8 @@
 /* The interface of this file is "caml/intext.h" */
 
 #include <string.h>
+#include <assert.h>
+
 #include "caml/alloc.h"
 #include "caml/codefrag.h"
 #include "caml/config.h"
@@ -271,7 +273,7 @@ static void extern_resize_position_table(struct caml_extern_state *s)
   int new_shift;
   uintnat * new_present;
   struct object_position * new_entries;
-  uintnat i, h;
+  uintnat h;
   struct position_table old = s->pos_table;
 
   /* Grow the table quickly (x 8) up to 10^6 entries,
@@ -303,7 +305,7 @@ static void extern_resize_position_table(struct caml_extern_state *s)
   s->pos_table.entries = new_entries;
 
   /* Insert every entry of the old table in the new table */
-  for (i = 0; i < old.size; i++) {
+  for (uintnat i = 0; i < old.size; i++) {
     if (! bitvect_test(old.present, i)) continue;
     h = Hash(old.entries[i].obj, s->pos_table.shift);
     while (bitvect_test(new_present, h)) {
@@ -381,10 +383,10 @@ static void close_extern_output(struct caml_extern_state* s)
 
 static void free_extern_output(struct caml_extern_state* s)
 {
-  struct caml_output_block * blk, * nextblk;
-
   if (s->extern_userprovided_output == NULL) {
-    for (blk = s->extern_output_first; blk != NULL; blk = nextblk) {
+    for (struct caml_output_block *blk = s->extern_output_first, *nextblk;
+         blk != NULL;
+         blk = nextblk) {
       nextblk = blk->next;
       caml_stat_free(blk);
     }
@@ -766,6 +768,9 @@ static void extern_rec(struct caml_extern_state* s, value v)
   uintnat h = 0;
   uintnat pos = 0;
 
+  /* for Double_tag and Double_array_tag */
+  static_assert(sizeof(double) == 8, "");
+
   extern_init_position_table(s);
   sp = s->extern_stack;
 
@@ -821,7 +826,6 @@ static void extern_rec(struct caml_extern_state* s, value v)
       break;
     }
     case Double_tag: {
-      CAMLassert(sizeof(double) == 8);
       extern_double(s, v);
       s->size_32 += 1 + 2;
       s->size_64 += 1 + 1;
@@ -830,7 +834,6 @@ static void extern_rec(struct caml_extern_state* s, value v)
     }
     case Double_array_tag: {
       mlsize_t nfloats;
-      CAMLassert(sizeof(double) == 8);
       nfloats = Wosize_val(v) / Double_wosize;
       extern_double_array(s, v, nfloats);
       s->size_32 += 1 + nfloats * 2;
@@ -1108,7 +1111,6 @@ CAMLexport void caml_output_value_to_malloc(value v, value flags,
   int header_len;
   intnat data_len;
   char * res;
-  struct caml_output_block * blk, * nextblk;
   struct caml_extern_state* s = init_extern_state ();
 
   init_extern_output(s);
@@ -1119,7 +1121,9 @@ CAMLexport void caml_output_value_to_malloc(value v, value flags,
   *len = header_len + data_len;
   memcpy(res, header, header_len);
   res += header_len;
-  for (blk = s->extern_output_first; blk != NULL; blk = nextblk) {
+  for (struct caml_output_block *blk = s->extern_output_first, *nextblk;
+       blk != NULL;
+       blk = nextblk) {
     intnat n = blk->end - blk->data;
     memcpy(res, blk->data, n);
     res += n;

diff --git a/runtime/fail.c b/runtime/fail.c
new file mode 100644 (file)
index 0000000..65c1101
--- /dev/null
+++ b/runtime/fail.c
@@ -0,0 +1,151 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 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 Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+/* Raising exceptions from C. */
+
+#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
+#include "caml/mlvalues.h"
+
+#define Assert_is_exn_constructor(v)                                    \
+  (CAMLassert(Is_block(v)), CAMLassert(Tag_val(v) == Object_tag))
+
+CAMLexport value caml_exception_constant(value exn_constr)
+{
+  Assert_is_exn_constructor(exn_constr);
+  return exn_constr;
+}
+
+CAMLexport value caml_exception_with_arg(value exn_constr, value arg)
+{
+  CAMLparam2 (exn_constr, arg);
+  CAMLlocal1 (bucket);
+  Assert_is_exn_constructor(exn_constr);
+
+  bucket = caml_alloc_small (2, 0);
+  Field(bucket, 0) = exn_constr;
+  Field(bucket, 1) = arg;
+  CAMLreturn(bucket);
+}
+
+CAMLexport value caml_exception_with_args(value exn_constr,
+                                          int nargs, value args[])
+{
+  CAMLparam1 (exn_constr);
+  CAMLxparamN (args, nargs);
+  Assert_is_exn_constructor(exn_constr);
+
+  value bucket;
+
+  CAMLassert(1 + nargs <= Max_young_wosize);
+  bucket = caml_alloc_small (1 + nargs, 0);
+  Field(bucket, 0) = exn_constr;
+  for (int i = 0; i < nargs; i++) Field(bucket, 1 + i) = args[i];
+  CAMLreturn(bucket);
+}
+
+CAMLexport value caml_exception_with_string(value exn_constr, char const *msg)
+{
+  CAMLparam1(exn_constr);
+  value v_msg = caml_copy_string(msg);
+  CAMLreturn(caml_exception_with_arg(exn_constr, v_msg));
+}
+
+
+/* Used by the stack overflow handler -> deactivate ASAN (see
+   segv_handler in signals_nat.c). */
+CAMLno_asan
+CAMLexport void caml_raise_constant(value exn_constr)
+{
+  caml_raise(caml_exception_constant(exn_constr));
+}
+
+CAMLexport void caml_raise_with_arg(value exn_constr, value arg)
+{
+  caml_raise(caml_exception_with_arg(exn_constr, arg));
+}
+
+CAMLexport void caml_raise_with_args(value exn_constr, int nargs, value arg[])
+{
+  caml_raise(caml_exception_with_args(exn_constr, nargs, arg));
+}
+
+CAMLexport void caml_raise_with_string(value exn_constr, char const * msg)
+{
+  caml_raise(caml_exception_with_string(exn_constr, msg));
+}
+
+CAMLexport void caml_failwith(char const *msg)
+{
+  caml_raise(caml_exception_failure(msg));
+}
+
+CAMLexport void caml_failwith_value(value msg)
+{
+  caml_raise(caml_exception_failure_value(msg));
+}
+
+CAMLexport void caml_invalid_argument(char const *msg)
+{
+  caml_raise(caml_exception_invalid_argument(msg));
+}
+
+CAMLexport void caml_invalid_argument_value(value msg)
+{
+  caml_raise(caml_exception_invalid_argument_value(msg));
+}
+
+CAMLexport void caml_raise_out_of_memory(void)
+{
+  caml_raise(caml_exception_out_of_memory());
+}
+
+CAMLexport void caml_raise_stack_overflow(void)
+{
+  caml_raise(caml_exception_stack_overflow());
+}
+
+CAMLexport void caml_raise_sys_error(value msg)
+{
+  caml_raise(caml_exception_sys_error(msg));
+}
+
+CAMLexport void caml_raise_end_of_file(void)
+{
+  caml_raise(caml_exception_end_of_file());
+}
+
+CAMLexport void caml_raise_zero_divide(void)
+{
+  caml_raise(caml_exception_zero_divide());
+}
+
+CAMLexport void caml_raise_not_found(void)
+{
+  caml_raise(caml_exception_not_found());
+}
+
+CAMLexport void caml_array_bound_error(void)
+{
+  caml_raise(caml_exception_array_bound_error());
+}
+
+CAMLexport void caml_raise_sys_blocked_io(void)
+{
+  caml_raise(caml_exception_sys_blocked_io());
+}

diff --git a/runtime/fail_byt.c b/runtime/fail_byt.c
index 76ea877f6dedb64a749d730d0f1a94303598e751..19e7a6b0294a5c0590f137c51e8c73692602832e 100644 (file)
--- a/runtime/fail_byt.c
+++ b/runtime/fail_byt.c
@@ -38,10 +38,11 @@ CAMLexport void caml_raise(value v)
 
   caml_channel_cleanup_on_raise();
 
-  // avoid calling caml_raise recursively
-  v = caml_process_pending_actions_with_root_exn(v);
-  if (Is_exception_result(v))
-    v = Extract_exception(v);
+  caml_result result = caml_process_pending_actions_with_root_res(v);
+  /* If the result is a value, we want to assign it to [v].
+     If the result is an exception, we want to raise it instead of [v].
+     The line below does both these things at once. */
+  v = result.data;
 
   if (Caml_state->external_raise == NULL) {
     caml_terminate_signals();
@@ -54,46 +55,6 @@ CAMLexport void caml_raise(value v)
   siglongjmp(Caml_state->external_raise->jmp->buf, 1);
 }
 
-CAMLexport void caml_raise_constant(value tag)
-{
-  caml_raise(tag);
-}
-
-CAMLexport void caml_raise_with_arg(value tag, value arg)
-{
-  CAMLparam2 (tag, arg);
-  CAMLlocal1 (bucket);
-
-  bucket = caml_alloc_small (2, 0);
-  Field(bucket, 0) = tag;
-  Field(bucket, 1) = arg;
-  caml_raise(bucket);
-  CAMLnoreturn;
-}
-
-CAMLexport void caml_raise_with_args(value tag, int nargs, value args[])
-{
-  CAMLparam1 (tag);
-  CAMLxparamN (args, nargs);
-  value bucket;
-  int i;
-
-  CAMLassert(1 + nargs <= Max_young_wosize);
-  bucket = caml_alloc_small (1 + nargs, 0);
-  Field(bucket, 0) = tag;
-  for (i = 0; i < nargs; i++) Field(bucket, 1 + i) = args[i];
-  caml_raise(bucket);
-  CAMLnoreturn;
-}
-
-CAMLexport void caml_raise_with_string(value tag, char const *msg)
-{
-  CAMLparam1(tag);
-  value v_msg = caml_copy_string(msg);
-  caml_raise_with_arg(tag, v_msg);
-  CAMLnoreturn;
-}
-
 /* PR#5115: Built-in exceptions can be triggered by input_value
    while reading the initial value of [caml_global_data].
 
@@ -121,95 +82,87 @@ static void check_global_data_param(char const *exception_name, char const *msg)
   }
 }
 
-Caml_inline value caml_get_failwith_tag (char const *msg)
+Caml_inline value caml_get_failwith_tag(char const *msg)
 {
   check_global_data_param("Failure", msg);
   return Field(caml_global_data, FAILURE_EXN);
 }
 
-CAMLexport void caml_failwith (char const *msg)
+CAMLexport value caml_exception_failure(char const *msg)
 {
-  caml_raise_with_string(caml_get_failwith_tag(msg), msg);
+  return caml_exception_with_string(caml_get_failwith_tag(msg), msg);
 }
 
-CAMLexport void caml_failwith_value (value msg)
+CAMLexport value caml_exception_failure_value(value msg)
 {
   CAMLparam1(msg);
   value tag = caml_get_failwith_tag(String_val(msg));
-  caml_raise_with_arg(tag, msg);
-  CAMLnoreturn;
+  CAMLreturn(caml_exception_with_arg(tag, msg));
 }
 
-Caml_inline value caml_get_invalid_argument_tag (char const *msg)
+Caml_inline value caml_get_invalid_argument_tag(char const *msg)
 {
   check_global_data_param("Invalid_argument", msg);
   return Field(caml_global_data, INVALID_EXN);
 }
 
-CAMLexport void caml_invalid_argument (char const *msg)
+CAMLexport value caml_exception_invalid_argument(char const *msg)
 {
-  caml_raise_with_string(caml_get_invalid_argument_tag(msg), msg);
+  return caml_exception_with_string(caml_get_invalid_argument_tag(msg), msg);
 }
 
-CAMLexport void caml_invalid_argument_value (value msg)
+CAMLexport value caml_exception_invalid_argument_value(value msg)
 {
   CAMLparam1(msg);
   value tag = caml_get_invalid_argument_tag(String_val(msg));
-  caml_raise_with_arg(tag, msg);
-  CAMLnoreturn;
+  CAMLreturn(caml_exception_with_arg(tag, msg));
 }
 
-CAMLexport void caml_array_bound_error(void)
+CAMLexport value caml_exception_array_bound_error(void)
 {
-  caml_invalid_argument("index out of bounds");
+  return caml_exception_invalid_argument("index out of bounds");
 }
 
-CAMLexport void caml_raise_out_of_memory(void)
+CAMLexport value caml_exception_out_of_memory(void)
 {
   check_global_data("Out_of_memory");
-  caml_raise_constant(Field(caml_global_data, OUT_OF_MEMORY_EXN));
+  return Field(caml_global_data, OUT_OF_MEMORY_EXN);
 }
 
-CAMLexport void caml_raise_stack_overflow(void)
+CAMLexport value caml_exception_stack_overflow(void)
 {
   check_global_data("Stack_overflow");
-  caml_raise_constant(Field(caml_global_data, STACK_OVERFLOW_EXN));
+  return Field(caml_global_data, STACK_OVERFLOW_EXN);
 }
 
-CAMLexport void caml_raise_sys_error(value msg)
+CAMLexport value caml_exception_sys_error(value msg)
 {
   check_global_data_param("Sys_error", String_val(msg));
-  caml_raise_with_arg(Field(caml_global_data, SYS_ERROR_EXN), msg);
+  return caml_exception_with_arg(Field(caml_global_data, SYS_ERROR_EXN), msg);
 }
 
-CAMLexport void caml_raise_end_of_file(void)
+CAMLexport value caml_exception_end_of_file(void)
 {
   check_global_data("End_of_file");
-  caml_raise_constant(Field(caml_global_data, END_OF_FILE_EXN));
+  return Field(caml_global_data, END_OF_FILE_EXN);
 }
 
-CAMLexport void caml_raise_zero_divide(void)
+CAMLexport value caml_exception_zero_divide(void)
 {
   check_global_data("Division_by_zero");
-  caml_raise_constant(Field(caml_global_data, ZERO_DIVIDE_EXN));
+  return Field(caml_global_data, ZERO_DIVIDE_EXN);
 }
 
-CAMLexport void caml_raise_not_found(void)
+CAMLexport value caml_exception_not_found(void)
 {
   check_global_data("Not_found");
-  caml_raise_constant(Field(caml_global_data, NOT_FOUND_EXN));
+  return Field(caml_global_data, NOT_FOUND_EXN);
 }
 
-CAMLexport void caml_raise_sys_blocked_io(void)
+CAMLexport value caml_exception_sys_blocked_io(void)
 {
   check_global_data("Sys_blocked_io");
-  caml_raise_constant(Field(caml_global_data, SYS_BLOCKED_IO));
-}
-
-CAMLexport value caml_raise_if_exception(value res)
-{
-  if (Is_exception_result(res)) caml_raise(Extract_exception(res));
-  return res;
+  return Field(caml_global_data, SYS_BLOCKED_IO);
 }
 
 int caml_is_special_exception(value exn) {

diff --git a/runtime/fail_nat.c b/runtime/fail_nat.c
index 744934fb09b1fead31072981551165f9dffe7c77..4db291e86acbbfe0bde5cbddbc7ec3f0a50abaab 100644 (file)
--- a/runtime/fail_nat.c
+++ b/runtime/fail_nat.c
@@ -64,10 +64,11 @@ void caml_raise(value v)
 
   caml_channel_cleanup_on_raise();
 
-  // avoid calling caml_raise recursively
-  v = caml_process_pending_actions_with_root_exn(v);
-  if (Is_exception_result(v))
-    v = Extract_exception(v);
+  caml_result result = caml_process_pending_actions_with_root_res(v);
+  /* If the result is a value, we want to assign it to [v].
+     If the result is an exception, we want to raise it instead of [v].
+     The line below does both these things at once. */
+  v = result.data;
 
   exception_pointer = (char*)Caml_state->c_stack;
 
@@ -88,119 +89,71 @@ void caml_raise(value v)
   caml_raise_exception(Caml_state, v);
 }
 
-/* Used by the stack overflow handler -> deactivate ASAN (see
-   segv_handler in signals_nat.c). */
-CAMLno_asan
-void caml_raise_constant(value tag)
-{
-  caml_raise(tag);
-}
-
-void caml_raise_with_arg(value tag, value arg)
+value caml_exception_failure(char const *msg)
 {
-  CAMLparam2 (tag, arg);
-  CAMLlocal1 (bucket);
-
-  bucket = caml_alloc_small (2, 0);
-  Field(bucket, 0) = tag;
-  Field(bucket, 1) = arg;
-  caml_raise(bucket);
-  CAMLnoreturn;
+  return caml_exception_with_string((value)caml_exn_Failure, msg);
 }
 
-void caml_raise_with_args(value tag, int nargs, value args[])
+value caml_exception_failure_value(value msg)
 {
-  CAMLparam1 (tag);
-  CAMLxparamN (args, nargs);
-  value bucket;
-  int i;
-
-  bucket = caml_alloc (1 + nargs, 0);
-  Field(bucket, 0) = tag;
-  for (i = 0; i < nargs; i++) Field(bucket, 1 + i) = args[i];
-  caml_raise(bucket);
-  CAMLnoreturn;
+  return caml_exception_with_arg((value)caml_exn_Failure, msg);
 }
 
-void caml_raise_with_string(value tag, char const *msg)
+value caml_exception_invalid_argument(char const *msg)
 {
-  CAMLparam1(tag);
-  value v_msg = caml_copy_string(msg);
-  caml_raise_with_arg(tag, v_msg);
-  CAMLnoreturn;
+  return caml_exception_with_string((value)caml_exn_Invalid_argument, msg);
 }
 
-void caml_failwith (char const *msg)
+value caml_exception_invalid_argument_value(value msg)
 {
-  caml_raise_with_string((value) caml_exn_Failure, msg);
+  return caml_exception_with_arg((value)caml_exn_Invalid_argument, msg);
 }
 
-void caml_failwith_value (value msg)
+value caml_exception_out_of_memory(void)
 {
-  caml_raise_with_arg((value) caml_exn_Failure, msg);
-}
-
-void caml_invalid_argument (char const *msg)
-{
-  caml_raise_with_string((value) caml_exn_Invalid_argument, msg);
-}
-
-void caml_invalid_argument_value (value msg)
-{
-  caml_raise_with_arg((value) caml_exn_Invalid_argument, msg);
-}
-
-void caml_raise_out_of_memory(void)
-{
-  caml_raise_constant((value) caml_exn_Out_of_memory);
+  return (value)caml_exn_Out_of_memory;
 }
 
 /* Used by the stack overflow handler -> deactivate ASAN (see
    segv_handler in signals_nat.c). */
 CAMLno_asan
-void caml_raise_stack_overflow(void)
-{
-  caml_raise_constant((value) caml_exn_Stack_overflow);
-}
-
-void caml_raise_sys_error(value msg)
+value caml_exception_stack_overflow(void)
 {
-  caml_raise_with_arg((value) caml_exn_Sys_error, msg);
+  return (value)caml_exn_Stack_overflow;
 }
 
-void caml_raise_end_of_file(void)
+value caml_exception_sys_error(value msg)
 {
-  caml_raise_constant((value) caml_exn_End_of_file);
+  return caml_exception_with_arg((value)caml_exn_Sys_error, msg);
 }
 
-void caml_raise_zero_divide(void)
+value caml_exception_end_of_file(void)
 {
-  caml_raise_constant((value) caml_exn_Division_by_zero);
+  return (value)caml_exn_End_of_file;
 }
 
-void caml_raise_not_found(void)
+value caml_exception_zero_divide(void)
 {
-  caml_raise_constant((value) caml_exn_Not_found);
+  return (value)caml_exn_Division_by_zero;
 }
 
-void caml_raise_sys_blocked_io(void)
+value caml_exception_not_found(void)
 {
-  caml_raise_constant((value) caml_exn_Sys_blocked_io);
+  return (value)caml_exn_Not_found;
 }
 
-CAMLexport value caml_raise_if_exception(value res)
+value caml_exception_sys_blocked_io(void)
 {
-  if (Is_exception_result(res)) caml_raise(Extract_exception(res));
-  return res;
+  return (value)caml_exn_Sys_blocked_io;
 }
 
 /* We use a pre-allocated exception because we can't
    do a GC before the exception is raised (lack of stack descriptors
    for the ccall to [caml_array_bound_error]).  */
-static value array_bound_exn(void)
+value caml_exception_array_bound_error(void)
 {
-  static atomic_uintnat exn_cache = ATOMIC_UINTNAT_INIT(0);
-  const value* exn = (const value*)atomic_load_acquire(&exn_cache);
+  static _Atomic(const value *) exn_cache = NULL;
+  const value *exn = atomic_load_acquire(&exn_cache);
   if (!exn) {
     exn = caml_named_value("Pervasives.array_bound_error");
     if (!exn) {
@@ -208,16 +161,11 @@ static value array_bound_exn(void)
         "Invalid_argument(\"index out of bounds\")\n");
       exit(2);
     }
-    atomic_store_release(&exn_cache, (uintnat)exn);
+    atomic_store_release(&exn_cache, exn);
   }
   return *exn;
 }
 
-void caml_array_bound_error(void)
-{
-  caml_raise(array_bound_exn());
-}
-
 void caml_array_bound_error_asm(void)
 {
 #if defined(WITH_THREAD_SANITIZER)
@@ -227,7 +175,7 @@ void caml_array_bound_error_asm(void)
 
   /* This exception is raised directly from ocamlopt-compiled OCaml,
      not C, so we jump directly to the OCaml handler (and avoid GC) */
-  caml_raise_exception(Caml_state, array_bound_exn());
+  caml_raise_exception(Caml_state, caml_exception_array_bound_error());
 }
 
 int caml_is_special_exception(value exn) {

diff --git a/runtime/fiber.c b/runtime/fiber.c
index 5525e26cadf0d06567edf6e83c473ee60d7fe236..721354042baec545382a7e36b98e8e6aa68ad51d 100644 (file)
--- a/runtime/fiber.c
+++ b/runtime/fiber.c
@@ -86,15 +86,13 @@ void caml_change_max_stack_size (uintnat new_max_wsize)
 
 struct stack_info** caml_alloc_stack_cache (void)
 {
-  int i;
-
   struct stack_info** stack_cache =
     (struct stack_info**)caml_stat_alloc_noexc(sizeof(struct stack_info*) *
                                                NUM_STACK_SIZE_CLASSES);
   if (stack_cache == NULL)
     return NULL;
 
-  for(i = 0; i < NUM_STACK_SIZE_CLASSES; i++)
+  for (int i = 0; i < NUM_STACK_SIZE_CLASSES; i++)
     stack_cache[i] = NULL;
 
   return stack_cache;
@@ -102,10 +100,27 @@ struct stack_info** caml_alloc_stack_cache (void)
 
 Caml_inline struct stack_info* alloc_for_stack (mlsize_t wosize)
 {
-  size_t len = sizeof(struct stack_info) +
-               sizeof(value) * wosize +
-               8 /* for alignment to 16-bytes, needed for arm64 */ +
-               sizeof(struct stack_handler);
+  size_t stack_len = sizeof(struct stack_info) + sizeof(value) * wosize;
+  size_t len;
+
+  /* Some platforms require 16-byte alignment of the stack pointer, which
+     will be _at the end_ of this allocation, so we need to ask for a bit more
+     memory to make sure that
+       caml_round_up(allocated stack base + stack_len, 16) + sizeof handler
+     will fit the allocated space.
+
+     When using mmap, we can rely upon the stack base being page-aligned
+     and thus aligned to a 16 byte boundary, and can round up here;
+     otherwise we need to always ask for 15 more bytes in order to cope with
+     all misalignment possibilities, even though it is likely that the
+     result of caml_stat_alloc_noexc() will be at least aligned to an
+     8-byte boundary. */
+#ifdef USE_MMAP_MAP_STACK
+  len = caml_round_up(stack_len, 16) + sizeof(struct stack_handler);
+#else
+  len = stack_len + (16 - 1) + sizeof(struct stack_handler);
+#endif
+
 #ifdef USE_MMAP_MAP_STACK
   struct stack_info* si;
   si = mmap(NULL, len, PROT_WRITE | PROT_READ,
@@ -168,10 +183,11 @@ alloc_size_class_stack_noexc(mlsize_t wosize, int cache_bucket, value hval,
 
     stack->cache_bucket = cache_bucket;
 
-    /* Ensure 16-byte alignment because some architectures require it */
-    hand = (struct stack_handler*)
-     (((uintnat)stack + sizeof(struct stack_info) + sizeof(value) * wosize + 15)
-      & ~((uintnat)15));
+    /* Ensure 16-byte alignment because some architectures (e.g. arm64)
+       require it. alloc_for_stack() has allocated extra room to prevent
+       this computation from overflowing. */
+    hand = (struct stack_handler*)caml_round_up(
+      (uintnat)stack + sizeof(struct stack_info) + sizeof(value) * wosize, 16);
     stack->handler = hand;
   }
 
@@ -239,7 +255,7 @@ Caml_inline void scan_stack_frames(
   int n, ofs;
   unsigned short * p;
   value *root;
-  caml_frame_descrs fds = caml_get_frame_descrs();
+  caml_frame_descrs * fds = caml_get_frame_descrs();
 
   sp = (char*)stack->sp;
   regs = gc_regs;
@@ -367,14 +383,14 @@ void caml_scan_stack(
   scanning_action f, scanning_action_flags fflags, void* fdata,
   struct stack_info* stack, value* v_gc_regs)
 {
-  value *low, *high, *sp;
+  value *low, *high;
 
   while (stack != NULL) {
     CAMLassert(stack->magic == 42);
 
     high = Stack_high(stack);
     low = stack->sp;
-    for (sp = low; sp < high; sp++) {
+    for (value *sp = low; sp < high; sp++) {
       value v = *sp;
       if (is_scannable(fflags, v)) {
         f(fdata, v, sp);
@@ -438,14 +454,16 @@ static void rewrite_frame_pointers(struct stack_info *old_stack,
   struct frame_walker {
     struct frame_walker *base_addr;
     uintnat return_addr;
-  } *frame, *next;
+  };
   ptrdiff_t delta;
-  void *top, **p;
 
   delta = (char*)Stack_high(new_stack) - (char*)Stack_high(old_stack);
 
   /* Walk the frame-pointers linked list */
-  for (frame = __builtin_frame_address(0); frame; frame = next) {
+  for (struct frame_walker *frame = __builtin_frame_address(0), *next;
+       frame;
+       frame = next) {
+    void *top, **p;
 
     top = (char*)&frame->return_addr
       + 1 * sizeof(value) /* return address */
@@ -496,8 +514,9 @@ int caml_try_realloc_stack(asize_t required_space)
   old_stack = Caml_state->current_stack;
   stack_used = Stack_high(old_stack) - (value*)old_stack->sp;
   wsize = Stack_high(old_stack) - Stack_base(old_stack);
+  uintnat max_stack_wsize = caml_max_stack_wsize;
   do {
-    if (wsize >= caml_max_stack_wsize) return 0;
+    if (wsize >= max_stack_wsize) return 0;
     wsize *= 2;
   } while (wsize < stack_used + required_space);
 
@@ -535,8 +554,9 @@ int caml_try_realloc_stack(asize_t required_space)
    * multiple c_stack_links to point to the same stack since callbacks are run
    * on existing stacks. */
   {
-    struct c_stack_link* link;
-    for (link = Caml_state->c_stack; link; link = link->prev) {
+    for (struct c_stack_link *link = Caml_state->c_stack;
+         link != NULL;
+         link = link->prev) {
       if (link->stack == old_stack) {
         link->stack = new_stack;
         link->sp = (void*)((char*)Stack_high(new_stack) -
@@ -603,7 +623,8 @@ CAMLprim value caml_continuation_use_noexc (value cont)
 
   fiber_debug_log("cont: is_block(%d) tag_val(%ul) is_young(%d)",
                   Is_block(cont), Tag_val(cont), Is_young(cont));
-  CAMLassert(Is_block(cont) && Tag_val(cont) == Cont_tag);
+  CAMLassert(Is_block(cont));
+  CAMLassert(Tag_val(cont) == Cont_tag);
 
   /* this forms a barrier between execution and any other domains
      that might be marking this continuation */
@@ -659,13 +680,6 @@ void caml_continuation_replace(value cont, struct stack_info* stk)
   (void)b; /* squash unused warning */
 }
 
-CAMLprim value caml_drop_continuation (value cont)
-{
-  struct stack_info* stk = Ptr_val(caml_continuation_use(cont));
-  caml_free_stack(stk);
-  return Val_unit;
-}
-
 static const value * _Atomic caml_unhandled_effect_exn = NULL;
 static const value * _Atomic caml_continuation_already_resumed_exn = NULL;
 

diff --git a/runtime/finalise.c b/runtime/finalise.c
index 67cb75b94d1f6428f912f8bd524701d952e5df78..fd8bdc55fb67af6c58f10fc37b6de16d4b6b3ae8 100644 (file)
--- a/runtime/finalise.c
+++ b/runtime/finalise.c
@@ -52,12 +52,11 @@ static void alloc_todo (caml_domain_state* d, int size)
 static void generic_final_update
   (caml_domain_state* d, struct finalisable *final, int darken_value)
 {
-  uintnat i, j, k;
   uintnat todo_count = 0;
   struct caml_final_info *f = d->final_info;
 
   CAMLassert (final->old <= final->young);
-  for (i = 0; i < final->old; i++) {
+  for (uintnat i = 0; i < final->old; i++) {
     CAMLassert (Is_block (final->table[i].val));
     if (is_unmarked (final->table[i].val)) {
       ++ todo_count;
@@ -74,6 +73,7 @@ static void generic_final_update
       - k : index in to_do_tl, next available slot.
   */
   if (todo_count > 0) {
+    uintnat i, j, k;
     caml_set_action_pending(d);
     alloc_todo (d, todo_count);
     j = k = 0;
@@ -142,13 +142,13 @@ int caml_final_update_last (caml_domain_state* d)
 /* Call the finalisation functions for the finalising set.
    Note that this function must be reentrant.
 */
-value caml_final_do_calls_exn(void)
+caml_result caml_final_do_calls_res(void)
 {
   struct final f;
-  value res;
+  caml_result res;
   struct caml_final_info *fi = Caml_state->final_info;
 
-  if (fi->running_finalisation_function) return Val_unit;
+  if (fi->running_finalisation_function) return Result_unit;
   if (fi->todo_head != NULL) {
     call_timing_hook(&caml_finalise_begin_hook);
     caml_gc_message (0x80, "Calling finalisation functions.\n");
@@ -164,14 +164,14 @@ value caml_final_do_calls_exn(void)
       --fi->todo_head->size;
       f = fi->todo_head->item[fi->todo_head->size];
       fi->running_finalisation_function = 1;
-      res = caml_callback_exn (f.fun, f.val + f.offset);
+      res = caml_callback_res (f.fun, f.val + f.offset);
       fi->running_finalisation_function = 0;
-      if (Is_exception_result(res)) return res;
+      if (caml_result_is_exception(res)) return res;
     }
     caml_gc_message (0x80, "Done calling finalisation functions.\n");
     call_timing_hook(&caml_finalise_end_hook);
   }
-  return Val_unit;
+  return Result_unit;
 }
 
 /* Call a scanning_action [f] on [x]. */
@@ -182,26 +182,26 @@ void caml_final_do_roots
   (scanning_action act, scanning_action_flags fflags, void* fdata,
    caml_domain_state* d, int do_val)
 {
-  uintnat i;
-  struct final_todo *todo;
   struct caml_final_info *f = d->final_info;
 
   CAMLassert (f->first.old <= f->first.young);
-  for (i = 0; i < f->first.young; i++) {
+  for (uintnat i = 0; i < f->first.young; i++) {
     Call_action (act, fdata, f->first.table[i].fun);
     if (do_val)
       Call_action (act, fdata, f->first.table[i].val);
   }
 
   CAMLassert (f->last.old <= f->last.young);
-  for (i = 0; i < f->last.young; i++) {
+  for (uintnat i = 0; i < f->last.young; i++) {
     Call_action (act, fdata, f->last.table[i].fun);
     if (do_val)
       Call_action (act, fdata, f->last.table[i].val);
   }
 
-  for (todo = f->todo_head; todo != NULL; todo = todo->next) {
-    for (i = 0; i < todo->size; i++) {
+  for (struct final_todo *todo = f->todo_head;
+       todo != NULL;
+       todo = todo->next) {
+    for (uintnat i = 0; i < todo->size; i++) {
       Call_action (act, fdata, todo->item[i].fun);
       Call_action (act, fdata, todo->item[i].val);
     }
@@ -213,17 +213,16 @@ void caml_final_do_young_roots
   (scanning_action act, scanning_action_flags fflags, void* fdata,
    caml_domain_state* d, int do_last_val)
 {
-  uintnat i;
   struct caml_final_info *f = d->final_info;
 
   CAMLassert (f->first.old <= f->first.young);
-  for (i = f->first.old; i < f->first.young; i++) {
+  for (uintnat i = f->first.old; i < f->first.young; i++) {
     Call_action (act, fdata, f->first.table[i].fun);
     Call_action (act, fdata, f->first.table[i].val);
   }
 
-  CAMLassert (f->last.old <= f->last.old);
-  for (i = f->last.old; i < f->last.young; i++) {
+  CAMLassert (f->last.old <= f->last.young);
+  for (uintnat i = f->last.old; i < f->last.young; i++) {
     Call_action (act, fdata, f->last.table[i].fun);
     if (do_last_val)
       Call_action (act, fdata, f->last.table[i].val);
@@ -233,12 +232,11 @@ void caml_final_do_young_roots
 static void generic_final_minor_update
   (caml_domain_state* d, struct finalisable * final)
 {
-  uintnat i, j, k;
   uintnat todo_count = 0;
   struct caml_final_info *fi = d->final_info;
 
   CAMLassert (final->old <= final->young);
-  for (i = final->old; i < final->young; i++){
+  for (uintnat i = final->old; i < final->young; i++){
     CAMLassert (Is_block (final->table[i].val));
     if (Is_young(final->table[i].val) &&
         caml_get_header_val(final->table[i].val) != 0){
@@ -255,6 +253,7 @@ static void generic_final_minor_update
       - k : index in to_do_tl, next available slot.
   */
   if (todo_count > 0) {
+    uintnat i, j, k;
     caml_set_action_pending(d);
     alloc_todo (d, todo_count);
     k = 0;
@@ -282,7 +281,7 @@ static void generic_final_minor_update
   }
 
   /** update the minor value to the copied major value */
-  for (i = final->old; i < final->young; i++) {
+  for (uintnat i = final->old; i < final->young; i++) {
     CAMLassert (Is_block (final->table[i].val));
     if (Is_young(final->table[i].val)) {
       CAMLassert (caml_get_header_val(final->table[i].val) == 0);

diff --git a/runtime/fix_code.c b/runtime/fix_code.c
index c84512baacdecd76143d55ffa2692b389bb2bde8..baefff889555341a2b20f5e0ae6d9358b6eaf34e 100644 (file)
--- a/runtime/fix_code.c
+++ b/runtime/fix_code.c
@@ -69,9 +69,8 @@ void caml_load_code(int fd, asize_t len)
 
 void caml_fixup_endianness(code_t code, asize_t len)
 {
-  code_t p;
   len /= sizeof(opcode_t);
-  for (p = code; p < code + len; p++) {
+  for (code_t p = code; p < code + len; p++) {
     Reverse_32(p, p);
   }
 }
@@ -82,13 +81,14 @@ void caml_fixup_endianness(code_t code, asize_t len)
 
 #ifdef THREADED_CODE
 
-static char ** caml_instr_table;
-static char * caml_instr_base;
+static const char * const * caml_instr_table;
+static const char * caml_instr_base;
 
-void caml_init_thread_code(void ** instr_table, void * instr_base)
+void caml_init_thread_code(const void * const * instr_table,
+                           const void * instr_base)
 {
-  caml_instr_table = (char **) instr_table;
-  caml_instr_base = (char *) instr_base;
+  caml_instr_table = (const char * const *) instr_table;
+  caml_instr_base = (const char *) instr_base;
 }
 
 static int* opcode_nargs = NULL;
@@ -96,9 +96,7 @@ int* caml_init_opcode_nargs(void)
 {
   if( opcode_nargs == NULL ){
     int* l = (int*)caml_stat_alloc(sizeof(int) * FIRST_UNIMPLEMENTED_OP);
-    int i;
-
-    for (i = 0; i < FIRST_UNIMPLEMENTED_OP; i++) {
+    for (int i = 0; i < FIRST_UNIMPLEMENTED_OP; i++) {
       l [i] = 0;
     }
     /* Instructions with one operand */

diff --git a/runtime/floats.c b/runtime/floats.c
index a174db132a2c91b25a013354efc4369df55da029..827b064c0e42cb99139a09df158dd4917f5cd0fc 100644 (file)
--- a/runtime/floats.c
+++ b/runtime/floats.c
@@ -29,6 +29,7 @@
 #include <string.h>
 #include <float.h>
 #include <limits.h>
+#include <assert.h>
 
 #include "caml/alloc.h"
 #include "caml/fail.h"
@@ -81,11 +82,12 @@
 
 #ifdef ARCH_ALIGN_DOUBLE
 
+static_assert(sizeof(double) == 2 * sizeof(value), "");
+
 CAMLexport double caml_Double_val(value val)
 {
   union { value v[2]; double d; } buffer;
 
-  CAMLassert(sizeof(double) == 2 * sizeof(value));
   buffer.v[0] = Field(val, 0);
   buffer.v[1] = Field(val, 1);
   return buffer.d;
@@ -95,7 +97,6 @@ CAMLexport void caml_Store_double_val(value val, double dbl)
 {
   union { value v[2]; double d; } buffer;
 
-  CAMLassert(sizeof(double) == 2 * sizeof(value));
   buffer.d = dbl;
   Field(val, 0) = buffer.v[0];
   Field(val, 1) = buffer.v[1];

diff --git a/runtime/frame_descriptors.c b/runtime/frame_descriptors.c
index 5fee51bb25ed7a85b0ef623d47c9c9adc7cc7c8f..a248cd203fb16a0945fe16622a6d1caf2547a729 100644 (file)
--- a/runtime/frame_descriptors.c
+++ b/runtime/frame_descriptors.c
@@ -26,6 +26,41 @@
 #include "caml/shared_heap.h"
 #include <stddef.h>
 
+struct caml_frame_descrs {
+  int num_descr;
+  int mask;
+  frame_descr** descriptors;
+  caml_frametable_list *frametables;
+  caml_frametable_list *zombies;
+  caml_plat_mutex mutex;
+};
+/* Let us call 'capacity' the length of the descriptors array.
+
+   We maintain the following invariants:
+     capacity = mask + 1
+     capacity = 0 || Is_power_of_2(capacity)
+     num_desc <= 2 * num_descr <= capacity
+
+   For an extensible array we would maintain
+      num_desc <= capacity,
+    but this is a linear-problem hash table, we need to ensure that
+    free slots are frequent enough, so we use a twice-larger capacity:
+      num_desc * 2 <= capacity
+
+   We keep the list of frametables that was used to build the hashtable.
+   We use it when rebuilding the table after resizing.
+
+   We keep the list of frametables which need to be removed (zombies).
+   We remove them in a STW handler before any new addition.
+
+   We allow the user to call functions for frametable removal at any
+   time, even inside a STW section (e.g. during custom block finalization).
+   To this end, we use a mutex to protect the frametable insertions in
+   the zombies list.
+
+   All other modifications should only happen in a STW section.
+*/
+
 /* Defined in code generated by ocamlopt */
 extern intnat * caml_frametable[];
 
@@ -105,6 +140,58 @@ static void fill_hashtable(
   }
 }
 
+static void remove_entry(caml_frame_descrs *table, frame_descr * d) {
+  uintnat i;
+  uintnat r;
+  uintnat j;
+
+  i = Hash_retaddr(d->retaddr, table->mask);
+  while (table->descriptors[i] != d) {
+    i = (i+1) & table->mask;
+  }
+
+ r1:
+  j = i;
+  table->descriptors[i] = NULL;
+ r2:
+  i = (i+1) & table->mask;
+  // r3
+  if(table->descriptors[i] == NULL) return;
+  r = Hash_retaddr(table->descriptors[i]->retaddr, table->mask);
+  /* If r is between i and j (cyclically), i.e. if
+     table->descriptors[i]->retaddr don't need to be moved */
+  if(( ( j < r )  && ( r <= i ) ) ||
+     ( ( i < j )  && ( j < r )  ) ||      /* i cycled, r not */
+     ( ( r <= i ) && ( i < j ) )     ) {  /* i and r cycled */
+    goto r2;
+  }
+  // r4
+  table->descriptors[j] = table->descriptors[i];
+  goto r1;
+}
+
+static void clean_frame_descriptors(caml_frame_descrs *table)
+{
+  intnat *tbl, len, decrease = 0;
+  frame_descr * d;
+  caml_frametable_list *cur = table->zombies, *rem;
+  while (cur != NULL) {
+    tbl = (intnat*) cur->frametable;
+    len = *tbl;
+    d = (frame_descr *)(tbl + 1);
+    for (intnat j = 0; j < len; j++) {
+      remove_entry(table, d);
+      d = next_frame_descr(d);
+    }
+    decrease += len;
+    rem = cur;
+    cur = cur->next;
+    caml_stat_free(rem);
+  }
+  table->num_descr -= decrease;
+  table->zombies = NULL;
+}
+
 static void add_frame_descriptors(
   caml_frame_descrs *table,
   caml_frametable_list *new_frametables)
@@ -125,9 +212,7 @@ static void add_frame_descriptors(
     tail->next = table->frametables;
     table->frametables = NULL;
 
-    /* [num_descr] can be less than [num_descr + increase] if frame
-       tables were unregistered */
-    intnat num_descr = count_descriptors(new_frametables);
+    intnat num_descr = table->num_descr + increase;
 
     tblsize = 4;
     while (tblsize < 2 * num_descr) tblsize *= 2;
@@ -151,7 +236,8 @@ static void add_frame_descriptors(
 }
 
 /* protected by STW sections */
-static caml_frame_descrs current_frame_descrs = { 0, -1, NULL, NULL };
+static caml_frame_descrs current_frame_descrs =
+  { 0, -1, NULL, NULL, NULL, PTHREAD_MUTEX_INITIALIZER };
 
 static caml_frametable_list *cons(
   intnat *frametable, caml_frametable_list *tl)
@@ -162,6 +248,27 @@ static caml_frametable_list *cons(
   return li;
 }
 
+/* This function not only creates a new caml_frametable_list cell but
+   also makes a copy of the new frametable.
+   Here, we allocate, in a single malloc call, the space for the cons
+   cell and the (appended) frametable copy. This way, we do not have
+   to change the code that unregisters the frametable since calling free
+   on the cons cell will automatically free the frametable copy at the
+   same time.
+*/
+static caml_frametable_list *copy_cons(
+  intnat **frametable, intnat size, caml_frametable_list *tl)
+{
+  caml_frametable_list *li =
+    caml_stat_alloc(sizeof(caml_frametable_list) + size);
+  intnat *frametable_copy = (intnat*)(li + 1);
+  memcpy(frametable_copy, *frametable, size);
+  *frametable = frametable_copy;
+  li->frametable = frametable_copy;
+  li->next = tl;
+  return li;
+}
+
 void caml_init_frame_descriptors(void)
 {
   caml_frametable_list *frametables = NULL;
@@ -174,18 +281,10 @@ void caml_init_frame_descriptors(void)
   add_frame_descriptors(&current_frame_descrs, frametables);
 }
 
-
-typedef struct frametable_array {
-  void **table;
-  int ntables;
-} frametable_array;
-
-static void register_frametables_from_stw_single(frametable_array *array)
+static void register_frametables_from_stw_single(
+  caml_frametable_list *new_frametables)
 {
-  caml_frametable_list *new_frametables = NULL;
-  for (int i = 0; i < array->ntables; i++)
-    new_frametables = cons((intnat*)array->table[i], new_frametables);
-
+  clean_frame_descriptors(&current_frame_descrs);
   add_frame_descriptors(&current_frame_descrs, new_frametables);
 }
 
@@ -195,37 +294,102 @@ static void stw_register_frametables(
     int participating_count,
     caml_domain_state** participating)
 {
-  barrier_status b = caml_global_barrier_begin ();
-
-  if (caml_global_barrier_is_final(b)) {
-    register_frametables_from_stw_single((frametable_array*) frametables);
+  Caml_global_barrier_if_final(participating_count) {
+    register_frametables_from_stw_single((caml_frametable_list*) frametables);
   }
-
-  caml_global_barrier_end(b);
 }
 
 void caml_register_frametables(void **table, int ntables) {
-  struct frametable_array frametables = { table, ntables };
+  caml_frametable_list *new_frametables = NULL;
+  for (int i = 0; i < ntables; i++)
+    new_frametables = cons(table[i], new_frametables);
+
+  do {} while (!caml_try_run_on_all_domains(
+                 &stw_register_frametables, new_frametables, 0));
+}
+
+void caml_copy_and_register_frametables(
+  void **table, int * sizes, int ntables)
+{
+  caml_frametable_list *new_frametables = NULL;
+  for (int i = 0; i < ntables; i++)
+    new_frametables = copy_cons((intnat **)(table + i),
+                                sizes[i], new_frametables);
+
   do {} while (!caml_try_run_on_all_domains(
-                 &stw_register_frametables, &frametables, 0));
+                 &stw_register_frametables, new_frametables, 0));
+}
+
+static void remove_frame_descriptors(
+  caml_frame_descrs * table, void ** frametables, int ntables)
+{
+  void *frametable;
+  caml_frametable_list ** previous;
+
+  caml_plat_lock_blocking(&table->mutex);
+
+  previous = &table->frametables;
+
+  iter_list(table->frametables, current) {
+  resume:
+    for (int i = 0; i < ntables; i++) {
+      if (current->frametable == frametables[i]) {
+        *previous = current->next;
+        current->next = table->zombies;
+        table->zombies = current;
+        ntables--;
+        if (ntables == 0) goto release;
+        current = *previous;
+        frametable = frametables[i];
+        frametables[i] = frametables[ntables];
+        frametables[ntables] = frametable;
+        goto resume;
+      }
+    }
+    previous = &current->next;
+  }
+
+ release:
+  caml_plat_unlock(&table->mutex);
+}
+
+void caml_unregister_frametables(void ** frametables, int ntables)
+{
+  remove_frame_descriptors(&current_frame_descrs, frametables, ntables);
+}
+
+void caml_register_frametable(void * frametables)
+{
+  caml_register_frametables(&frametables, 1);
+}
+
+void* caml_copy_and_register_frametable(void * frametable, int size)
+{
+  caml_copy_and_register_frametables(&frametable, &size, 1);
+  return frametable;
+}
+
+void caml_unregister_frametable(void * frametables)
+{
+  caml_unregister_frametables(&frametables, 1);
 }
 
-caml_frame_descrs caml_get_frame_descrs(void)
+caml_frame_descrs* caml_get_frame_descrs(void)
 {
-  return current_frame_descrs;
+  return &current_frame_descrs;
 }
 
-frame_descr* caml_find_frame_descr(caml_frame_descrs fds, uintnat pc)
+frame_descr* caml_find_frame_descr(caml_frame_descrs *fds, uintnat pc)
 {
   frame_descr * d;
   uintnat h;
 
-  h = Hash_retaddr(pc, fds.mask);
+  h = Hash_retaddr(pc, fds->mask);
   while (1) {
-    d = fds.descriptors[h];
+    d = fds->descriptors[h];
     if (d == 0) return NULL; /* can happen if some code compiled without -g */
     if (d->retaddr == pc) break;
-    h = (h+1) & fds.mask;
+    h = (h+1) & fds->mask;
   }
   return d;
 }

diff --git a/runtime/gc_ctrl.c b/runtime/gc_ctrl.c
index 99c499b135be3d133b63076288c25a2a31b80c08..7cdafacf3c80b929ec5d26180caa350923980700 100644 (file)
--- a/runtime/gc_ctrl.c
+++ b/runtime/gc_ctrl.c
@@ -20,6 +20,7 @@
 #include "caml/finalise.h"
 #include "caml/gc.h"
 #include "caml/gc_ctrl.h"
+#include "caml/gc_stats.h"
 #include "caml/major_gc.h"
 #include "caml/minor_gc.h"
 #include "caml/shared_heap.h"
@@ -38,21 +39,18 @@
 #include "caml/startup.h"
 #include "caml/fail.h"
 
-uintnat caml_max_stack_wsize;
+atomic_uintnat caml_max_stack_wsize;
 uintnat caml_fiber_wsz;
 
-extern uintnat caml_major_heap_increment; /* percent or words; see major_gc.c */
-extern uintnat caml_percent_free;         /*        see major_gc.c */
-extern uintnat caml_percent_max;          /*        see compact.c */
-extern uintnat caml_allocation_policy;    /*        see freelist.c */
-extern uintnat caml_custom_major_ratio;   /* see custom.c */
-extern uintnat caml_custom_minor_ratio;   /* see custom.c */
+extern uintnat caml_percent_free; /* see major_gc.c */
+extern uintnat caml_custom_major_ratio; /* see custom.c */
+extern uintnat caml_custom_minor_ratio; /* see custom.c */
 extern uintnat caml_custom_minor_max_bsz; /* see custom.c */
-extern uintnat caml_minor_heap_max_wsz;   /* see domain.c */
+extern uintnat caml_minor_heap_max_wsz; /* see domain.c */
 
 CAMLprim value caml_gc_quick_stat(value v)
 {
-  CAMLparam0 ();
+  CAMLparam0 ();   /* v is ignored */
   CAMLlocal1 (res);
 
   /* get a copy of these before allocating anything... */
@@ -110,7 +108,7 @@ CAMLprim value caml_gc_counters(value v)
 
   /* get a copy of these before allocating anything... */
   double minwords = caml_gc_minor_words_unboxed();
-  double prowords = Caml_state->stat_promoted_words;
+  double prowords = (double)Caml_state->stat_promoted_words;
   double majwords = Caml_state->stat_major_words +
                     (double) Caml_state->allocated_words;
 
@@ -233,52 +231,50 @@ CAMLprim value caml_gc_minor(value v)
   CAML_EV_BEGIN(EV_EXPLICIT_GC_MINOR);
   CAMLassert (v == Val_unit);
   caml_minor_collection ();
-  value exn = caml_process_pending_actions_exn();
+  caml_result result = caml_process_pending_actions_res();
   CAML_EV_END(EV_EXPLICIT_GC_MINOR);
-  return caml_raise_if_exception(exn);
+  return caml_get_value_or_raise(result);
 }
 
-static value gc_major_exn(int force_compaction)
+static caml_result gc_major_res(int force_compaction)
 {
   CAML_EV_BEGIN(EV_EXPLICIT_GC_MAJOR);
   caml_gc_log ("Major GC cycle requested");
   caml_empty_minor_heaps_once();
   caml_finish_major_cycle(force_compaction);
-  value exn = caml_process_pending_actions_exn();
+  caml_result result = caml_process_pending_actions_res();
   CAML_EV_END(EV_EXPLICIT_GC_MAJOR);
-  return exn;
+  return result;
 }
 
 CAMLprim value caml_gc_major(value v)
 {
   Caml_check_caml_state();
   CAMLassert (v == Val_unit);
-  return caml_raise_if_exception(gc_major_exn(0));
+  return caml_get_value_or_raise(gc_major_res(0));
 }
 
-static value gc_full_major_exn(void)
+static caml_result gc_full_major_res(void)
 {
-  int i;
-  value exn = Val_unit;
   CAML_EV_BEGIN(EV_EXPLICIT_GC_FULL_MAJOR);
   caml_gc_log ("Full Major GC requested");
   /* In general, it can require up to 3 GC cycles for a
      currently-unreachable object to be collected. */
-  for (i = 0; i < 3; i++) {
+  for (int i = 0; i < 3; i++) {
     caml_finish_major_cycle(0);
-    exn = caml_process_pending_actions_exn();
-    if (Is_exception_result(exn)) break;
+    caml_result res = caml_process_pending_actions_res();
+    if (caml_result_is_exception(res)) return res;
   }
   ++ Caml_state->stat_forced_major_collections;
   CAML_EV_END(EV_EXPLICIT_GC_FULL_MAJOR);
-  return exn;
+  return Result_unit;
 }
 
 CAMLprim value caml_gc_full_major(value v)
 {
   Caml_check_caml_state();
   CAMLassert (v == Val_unit);
-  return caml_raise_if_exception(gc_full_major_exn());
+  return caml_get_value_or_raise(gc_full_major_res());
 }
 
 CAMLprim value caml_gc_major_slice (value v)
@@ -286,9 +282,9 @@ CAMLprim value caml_gc_major_slice (value v)
   CAML_EV_BEGIN(EV_EXPLICIT_GC_MAJOR_SLICE);
   CAMLassert (Is_long (v));
   caml_major_collection_slice(Long_val(v));
-  value exn = caml_process_pending_actions_exn();
+  caml_result result = caml_process_pending_actions_res();
   CAML_EV_END(EV_EXPLICIT_GC_MAJOR_SLICE);
-  return caml_raise_if_exception(exn);
+  return caml_get_value_or_raise(result);
 }
 
 CAMLprim value caml_gc_compaction(value v)
@@ -296,30 +292,29 @@ CAMLprim value caml_gc_compaction(value v)
   Caml_check_caml_state();
   CAML_EV_BEGIN(EV_EXPLICIT_GC_COMPACT);
   CAMLassert (v == Val_unit);
-  value exn = Val_unit;
-  int i;
-  /* We do a full major before this compaction. See [caml_full_major_exn] for
+  caml_result result = Result_unit;
+  /* We do a full major before this compaction. See [caml_full_major_res] for
      why this needs three iterations. */
-  for (i = 0; i < 3; i++) {
+  for (int i = 0; i < 3; i++) {
     caml_finish_major_cycle(i == 2);
-    exn = caml_process_pending_actions_exn();
-    if (Is_exception_result(exn)) break;
+    result = caml_process_pending_actions_res();
+    if (caml_result_is_exception(result)) break;
   }
   ++ Caml_state->stat_forced_major_collections;
   CAML_EV_END(EV_EXPLICIT_GC_COMPACT);
-  return caml_raise_if_exception(exn);
+  return caml_get_value_or_raise(result);
 }
 
 CAMLprim value caml_gc_stat(value v)
 {
-  value res;
+  caml_result result;
   CAML_EV_BEGIN(EV_EXPLICIT_GC_STAT);
-  res = gc_full_major_exn();
-  if (Is_exception_result(res)) goto out;
-  res = caml_gc_quick_stat(Val_unit);
+  result = gc_full_major_res();
+  if (caml_result_is_exception(result)) goto out;
+  result = Result_value(caml_gc_quick_stat(Val_unit));
  out:
   CAML_EV_END(EV_EXPLICIT_GC_STAT);
-  return caml_raise_if_exception(res);
+  return caml_get_value_or_raise(result);
 }
 
 CAMLprim value caml_get_minor_free (value v)
@@ -338,7 +333,7 @@ void caml_init_gc (void)
   caml_percent_free = norm_pfree (caml_params->init_percent_free);
   caml_gc_log ("Initial stack limit: %"
                ARCH_INTNAT_PRINTF_FORMAT "uk bytes",
-               caml_max_stack_wsize / 1024 * sizeof (value));
+               caml_params->init_max_stack_wsz / 1024 * sizeof (value));
 
   caml_custom_major_ratio =
       norm_custom_maj (caml_params->init_custom_major_ratio);
@@ -350,32 +345,10 @@ void caml_init_gc (void)
   #ifdef NATIVE_CODE
   caml_init_frame_descriptors();
   #endif
-  caml_init_domains(caml_params->init_minor_heap_wsz);
-/*
-  caml_major_heap_increment = major_incr;
-  caml_percent_free = norm_pfree (percent_fr);
-  caml_percent_max = norm_pmax (percent_m);
-  caml_init_major_heap (major_heap_size);
-  caml_gc_message (0x20, "Initial minor heap size: %luk bytes\n",
-                   Caml_state->minor_heap_size / 1024);
-  caml_gc_message (0x20, "Initial major heap size: %luk bytes\n",
-                   major_heap_size / 1024);
-  caml_gc_message (0x20, "Initial space overhead: %"
-                   ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_free);
-  caml_gc_message (0x20, "Initial max overhead: %"
-                   ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_max);
-  if (caml_major_heap_increment > 1000){
-    caml_gc_message (0x20, "Initial heap increment: %"
-                     ARCH_INTNAT_PRINTF_FORMAT "uk words\n",
-                     caml_major_heap_increment / 1024);
-  }else{
-    caml_gc_message (0x20, "Initial heap increment: %"
-                     ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
-                     caml_major_heap_increment);
-  }
-  caml_gc_message (0x20, "Initial allocation policy: %d\n",
-                   caml_allocation_policy);
-*/
+  caml_init_domains(caml_params->max_domains,
+                    caml_params->init_minor_heap_wsz);
+  caml_init_gc_stats(caml_params->max_domains);
+
 }
 
 /* FIXME After the startup_aux.c unification, move these functions there. */
@@ -392,16 +365,33 @@ CAMLprim value caml_runtime_variant (value unit)
 #endif
 }
 
-extern int caml_parser_trace;
-
 CAMLprim value caml_runtime_parameters (value unit)
 {
 #define F_Z ARCH_INTNAT_PRINTF_FORMAT
 #define F_S ARCH_SIZET_PRINTF_FORMAT
 
   CAMLassert (unit == Val_unit);
-  /* TODO KC */
-  return caml_alloc_sprintf ("caml_runtime_parameters not implemented: %d", 0);
+  return caml_alloc_sprintf
+      ("b=%d,c=%"F_Z"u,e=%"F_Z"u,l=%"F_Z"u,M=%"F_Z"u,m=%"F_Z"u,n=%"F_Z"u,"
+       "o=%"F_Z"u,p=%d,s=%"F_S"u,t=%"F_Z"u,v=%"F_Z"u,V=%"F_Z"u,W=%"F_Z"u",
+       /* b */ (int) Caml_state->backtrace_active,
+       /* c */ caml_params->cleanup_on_exit,
+       /* e */ caml_params->runtime_events_log_wsize,
+       /* l */ caml_max_stack_wsize,
+       /* M */ caml_custom_major_ratio,
+       /* m */ caml_custom_minor_ratio,
+       /* n */ caml_custom_minor_max_bsz,
+       /* o */ caml_percent_free,
+       /* p */ Caml_state->parser_trace,
+       /* R */ /* missing */
+       /* s */ Caml_state->minor_heap_wsz,
+       /* t */ caml_params->trace_level,
+       /* v */ caml_verb_gc,
+       /* V */ caml_params->verify_heap,
+       /* W */ caml_runtime_warnings
+       );
+#undef F_Z
+#undef F_S
 }
 
 /* Control runtime warnings */

diff --git a/runtime/gc_stats.c b/runtime/gc_stats.c
index 1b35976d331f298ead197c5f7210cd7cf865f60d..4bff32a41e77b0197c56868f4fa5ff271be6f9b1 100644 (file)
--- a/runtime/gc_stats.c
+++ b/runtime/gc_stats.c
@@ -16,8 +16,11 @@
 #define CAML_INTERNALS
 
 #include "caml/gc_stats.h"
+#include "caml/memory.h"
 #include "caml/minor_gc.h"
+#include "caml/platform.h"
 #include "caml/shared_heap.h"
+#include "caml/startup_aux.h"
 
 Caml_inline intnat intnat_max(intnat a, intnat b) {
   return (a > b ? a : b);
@@ -75,14 +78,13 @@ void caml_reset_domain_alloc_stats(caml_domain_state *local)
   local->stat_forced_major_collections = 0;
 }
 
-
 /* We handle orphaning allocation stats here,
    whereas orphaning of heap stats is done in shared_heap.c */
 static caml_plat_mutex orphan_lock = CAML_PLAT_MUTEX_INITIALIZER;
 static struct alloc_stats orphaned_alloc_stats = {0,};
 
 void caml_accum_orphan_alloc_stats(struct alloc_stats *acc) {
-  caml_plat_lock(&orphan_lock);
+  caml_plat_lock_blocking(&orphan_lock);
   caml_accum_alloc_stats(acc, &orphaned_alloc_stats);
   caml_plat_unlock(&orphan_lock);
 }
@@ -95,18 +97,25 @@ void caml_orphan_alloc_stats(caml_domain_state *domain) {
   caml_reset_domain_alloc_stats(domain);
 
   /* push them into the orphan stats */
-  caml_plat_lock(&orphan_lock);
+  caml_plat_lock_blocking(&orphan_lock);
   caml_accum_alloc_stats(&orphaned_alloc_stats, &alloc_stats);
   caml_plat_unlock(&orphan_lock);
 }
 
-
 /* The "sampled stats" of a domain are a recent copy of its
    domain-local stats, accessed without synchronization and only
    updated ("sampled") during stop-the-world events -- each minor
    collection, major cycle (which potentially includes compaction),
    all of these events could happen during domain termination. */
-static struct gc_stats sampled_gc_stats[Max_domains];
+static struct gc_stats* sampled_gc_stats;
+
+void caml_init_gc_stats (uintnat max_domains)
+{
+  sampled_gc_stats =
+    caml_stat_calloc_noexc(max_domains, sizeof(struct gc_stats));
+  if (sampled_gc_stats == NULL)
+    caml_fatal_error("Failed to allocate sampled_gc_stats");
+}
 
 /* Update the sampled stats for the given domain during a STW section. */
 void caml_collect_gc_stats_sample_stw(caml_domain_state* domain)
@@ -133,7 +142,6 @@ void caml_collect_gc_stats_sample_stw(caml_domain_state* domain)
 /* Compute global stats for the whole runtime. */
 void caml_compute_gc_stats(struct gc_stats* buf)
 {
-  int i;
   intnat pool_max = 0, large_max = 0;
   int my_id = Caml_state->id;
   memset(buf, 0, sizeof(*buf));
@@ -153,7 +161,7 @@ void caml_compute_gc_stats(struct gc_stats* buf)
   pool_max = buf->heap_stats.pool_max_words;
   large_max = buf->heap_stats.large_max_words;
 
-  for (i=0; i<Max_domains; i++) {
+  for (int i = 0; i < caml_params->max_domains; i++) {
     /* For allocation stats, we use the live stats of the current domain
        and the sampled stats of other domains.
 

diff --git a/runtime/gen_primitives.sh b/runtime/gen_primitives.sh
index 7c17e6024aec59fda1bb2733037b42b20f934641..bf41dd45982de1468fe9b51b3c12be63766f8cbf 100755 (executable)
--- a/runtime/gen_primitives.sh
+++ b/runtime/gen_primitives.sh
@@ -47,8 +47,10 @@ esac
 
 tmp_primitives="$primitives.tmp$$"
 
+# The tr -d '\r' is _after_ the call to sort just in case sort happens to be the
+# Windows version.
 sed -n -e 's/^CAMLprim value \([a-z][a-z0-9_]*\).*$/\1/p' "$@" | \
-sort | uniq > "$tmp_primitives"
+sort | tr -d '\r' | uniq > "$tmp_primitives"
 
 # To speed up builds, we avoid changing "primitives" when files
 # containing primitives change but the primitives table does not

diff --git a/runtime/globroots.c b/runtime/globroots.c
index bc649b519fa5d90f77aff3e70a0213aecd0cd6e0..47d65afb49860ab41ebd16b749e7231865ba95e2 100644 (file)
--- a/runtime/globroots.c
+++ b/runtime/globroots.c
@@ -19,6 +19,7 @@
 
 #include "caml/mlvalues.h"
 #include "caml/memory.h"
+#include "caml/platform.h"
 #include "caml/roots.h"
 #include "caml/globroots.h"
 #include "caml/skiplist.h"
@@ -50,14 +51,14 @@ struct skiplist caml_global_roots_old = SKIPLIST_STATIC_INITIALIZER;
 
 Caml_inline void caml_insert_global_root(struct skiplist * list, value * r)
 {
-  caml_plat_lock(&roots_mutex);
+  caml_plat_lock_blocking(&roots_mutex);
   caml_skiplist_insert(list, (uintnat) r, 0);
   caml_plat_unlock(&roots_mutex);
 }
 
 Caml_inline void caml_delete_global_root(struct skiplist * list, value * r)
 {
-  caml_plat_lock(&roots_mutex);
+  caml_plat_lock_blocking(&roots_mutex);
   caml_skiplist_remove(list, (uintnat) r);
   caml_plat_unlock(&roots_mutex);
 }
@@ -117,6 +118,7 @@ CAMLexport void caml_remove_generational_global_root(value *r)
       caml_delete_global_root(&caml_global_roots_old, r);
       /* Fallthrough: the root can be in the young list while actually
          being in the major heap. */
+      fallthrough;
     case YOUNG:
       caml_delete_global_root(&caml_global_roots_young, r);
       break;
@@ -172,45 +174,37 @@ static link *cons(void *data, link *tl) {
   return lnk;
 }
 
-#define iter_list(list,lnk) \
-  for (lnk = list; lnk != NULL; lnk = lnk->next)
-
-
 /* protected by roots_mutex */
 static link * caml_dyn_globals = NULL;
 
 void caml_register_dyn_globals(void **globals, int nglobals) {
-  int i;
-  caml_plat_lock(&roots_mutex);
-  for (i = 0; i < nglobals; i++)
+  caml_plat_lock_blocking(&roots_mutex);
+  for (int i = 0; i < nglobals; i++)
     caml_dyn_globals = cons(globals[i],caml_dyn_globals);
   caml_plat_unlock(&roots_mutex);
 }
 
 static void scan_native_globals(scanning_action f, void* fdata)
 {
-  int i, j;
   link* dyn_globals;
-  value* glob;
-  link* lnk;
 
-  caml_plat_lock(&roots_mutex);
+  caml_plat_lock_blocking(&roots_mutex);
   dyn_globals = caml_dyn_globals;
   caml_plat_unlock(&roots_mutex);
 
   /* The global roots */
-  for (i = 0; caml_globals[i] != 0; i++) {
-    for(glob = caml_globals[i]; *glob != 0; glob++) {
-      for (j = 0; j < Wosize_val(*glob); j++){
+  for (int i = 0; caml_globals[i] != 0; i++) {
+    for (value *glob = caml_globals[i]; *glob != 0; glob++) {
+      for (int j = 0; j < Wosize_val(*glob); j++) {
         f(fdata, Field(*glob, j), &Field(*glob, j));
       }
     }
   }
 
   /* Dynamic (natdynlink) global roots */
-  iter_list(dyn_globals, lnk) {
-    for(glob = (value *) lnk->data; *glob != 0; glob++) {
-      for (j = 0; j < Wosize_val(*glob); j++){
+  for (link *lnk = dyn_globals; lnk != NULL; lnk = lnk->next) {
+    for (value *glob = (value *) lnk->data; *glob != 0; glob++) {
+      for (int j = 0; j < Wosize_val(*glob); j++) {
         f(fdata, Field(*glob, j), &Field(*glob, j));
       }
     }
@@ -231,7 +225,7 @@ Caml_inline void caml_iterate_global_roots(scanning_action f,
 
 /* Scan all global roots */
 void caml_scan_global_roots(scanning_action f, void* fdata) {
-  caml_plat_lock(&roots_mutex);
+  caml_plat_lock_blocking(&roots_mutex);
   caml_iterate_global_roots(f, &caml_global_roots, fdata);
   caml_iterate_global_roots(f, &caml_global_roots_young, fdata);
   caml_iterate_global_roots(f, &caml_global_roots_old, fdata);
@@ -245,7 +239,7 @@ void caml_scan_global_roots(scanning_action f, void* fdata) {
 /* Scan global roots for a minor collection */
 void caml_scan_global_young_roots(scanning_action f, void* fdata)
 {
-  caml_plat_lock(&roots_mutex);
+  caml_plat_lock_blocking(&roots_mutex);
 
   caml_iterate_global_roots(f, &caml_global_roots, fdata);
   caml_iterate_global_roots(f, &caml_global_roots_young, fdata);

diff --git a/runtime/hash.c b/runtime/hash.c
index 8567f27c19e093a72446bc57edde1d5887913fac..017862265409c9e4adbf5912f4290cea74d36f3a 100644 (file)
--- a/runtime/hash.c
+++ b/runtime/hash.c
@@ -163,10 +163,10 @@ CAMLexport uint32_t caml_hash_mix_string(uint32_t h, value s)
   /* Finish with up to 3 bytes */
   w = 0;
   switch (len & 3) {
-  case 3: w  = Byte_u(s, i+2) << 16;   /* fallthrough */
-  case 2: w |= Byte_u(s, i+1) << 8;    /* fallthrough */
+  case 3: w  = Byte_u(s, i+2) << 16; fallthrough;
+  case 2: w |= Byte_u(s, i+1) << 8;  fallthrough;
   case 1: w |= Byte_u(s, i);
-          MIX(h, w);
+          MIX(h, w);                 fallthrough;
   default: /*skip*/;     /* len & 3 == 0, no extra bytes, do nothing */
   }
   /* Finally, mix in the length.  Ignore the upper 32 bits, generally 0. */
@@ -190,7 +190,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
   intnat num;                   /* Max number of meaningful values to see */
   uint32_t h;                     /* Rolling hash */
   value v;
-  mlsize_t i, len;
+  mlsize_t len;
 
   sz = Long_val(limit);
   if (sz < 0 || sz > HASH_QUEUE_SIZE) sz = HASH_QUEUE_SIZE;
@@ -215,7 +215,9 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
         num--;
         break;
       case Double_array_tag:
-        for (i = 0, len = Wosize_val(v) / Double_wosize; i < len; i++) {
+        for (mlsize_t i = 0, len = Wosize_val(v) / Double_wosize;
+             i < len;
+             i++) {
           h = caml_hash_mix_double(h, Double_flat_field(v, i));
           num--;
           if (num <= 0) break;
@@ -233,7 +235,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
       case Forward_tag:
         /* 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--) {
+        for (mlsize_t i = MAX_FORWARD_DEREFERENCE; i > 0; i--) {
           v = Forward_val(v);
           if (Is_long(v) || Tag_val(v) != Forward_tag)
             goto again;
@@ -254,7 +256,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
         }
         break;
       case Closure_tag: {
-        mlsize_t startenv;
+        mlsize_t i, startenv;
         len = Wosize_val(v);
         startenv = Start_env_closinfo(Closinfo_val(v));
         CAMLassert (startenv <= len);
@@ -282,7 +284,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
         /* Mix in the tag and size, but do not count this towards [num] */
         h = caml_hash_mix_uint32(h, Cleanhd_hd(Hd_val(v)));
         /* Copy fields into queue, not exceeding the total size [sz] */
-        for (i = 0, len = Wosize_val(v); i < len; i++) {
+        for (mlsize_t i = 0, len = Wosize_val(v); i < len; i++) {
           if (wr >= sz) break;
           queue[wr++] = Field(v, i);
         }

diff --git a/runtime/instrtrace.c b/runtime/instrtrace.c
index aa2c11e9beaffbd0c7d86ef958313eedae513d56..df5709ca9990f6e3ff9fb5f4bc66ddd32bc45d96 100644 (file)
--- a/runtime/instrtrace.c
+++ b/runtime/instrtrace.c
@@ -92,7 +92,7 @@ void caml_disasm_instr(code_t pc)
     /* Instructions with a C primitive as operand */
   case C_CALLN:
     snprintf(buf, sizeof(buf), "%s %d,", opbuf, pc[0]); pc++;
-    /* fallthrough */
+    fallthrough;
   case C_CALL1: case C_CALL2: case C_CALL3: case C_CALL4: case C_CALL5:
     if (pc[0] < 0 || pc[0] >= caml_prim_name_table.size)
       snprintf(buf, sizeof(buf), "%s unknown primitive %d\n", opbuf, pc[0]);
@@ -116,7 +116,6 @@ void caml_disasm_instr(code_t pc)
 void
 caml_trace_value_file (value v, code_t prog, asize_t proglen, FILE * f)
 {
-  int i;
   fprintf (f, "%#" ARCH_INTNAT_PRINTF_FORMAT "x", v);
   if (!v)
     return;
@@ -142,7 +141,7 @@ caml_trace_value_file (value v, code_t prog, asize_t proglen, FILE * f)
     case String_tag:
       l = caml_string_length (v);
       fprintf (f, "=string[s%dL%d]'", s, l);
-      for (i = 0; i < ((l>0x1f)?0x1f:l) ; i++) {
+      for (int i = 0; i < ((l>0x1f)?0x1f:l) ; i++) {
         if (isprint ((int) Byte (v, i)))
           putc (Byte (v, i), f);
         else
@@ -155,7 +154,7 @@ caml_trace_value_file (value v, code_t prog, asize_t proglen, FILE * f)
       goto displayfields;
     case Double_array_tag:
       fprintf (f, "=floatarray[s%d]", s);
-      for (i = 0; i < ((s>0xf)?0xf:s); i++)
+      for (int i = 0; i < ((s>0xf)?0xf:s); i++)
         fprintf (f, " %g", Double_flat_field (v, i));
       goto displayfields;
     case Abstract_tag:
@@ -169,7 +168,7 @@ caml_trace_value_file (value v, code_t prog, asize_t proglen, FILE * f)
     displayfields:
       if (s > 0)
         fputs ("=(", f);
-      for (i = 0; i < s; i++) {
+      for (int i = 0; i < s; i++) {
         if (i > 20) {
           fputs ("....", f);
           break;

diff --git a/runtime/intern.c b/runtime/intern.c
index 2be12e3479ef6cfa1c825727ed424025eab6012c..f99f5f0ce77d185e7d75daaa4a13648bb2754ded 100644 (file)
--- a/runtime/intern.c
+++ b/runtime/intern.c
@@ -230,7 +230,8 @@ static void intern_init(struct caml_intern_state* s, const void * src,
   /* This is asserted at the beginning of demarshaling primitives.
      If it fails, it probably means that an exception was raised
      without calling intern_cleanup() during the previous demarshaling. */
-  CAMLassert (s->intern_input == NULL && s->intern_obj_table == NULL);
+  CAMLassert(s->intern_input == NULL);
+  CAMLassert(s->intern_obj_table == NULL);
   s->intern_src = src;
   s->intern_input = input;
 }
@@ -303,7 +304,6 @@ static void readfloat(struct caml_intern_state* s,
 static void readfloats(struct caml_intern_state* s,
                        double * dest, mlsize_t len, unsigned int code)
 {
-  mlsize_t i;
   if (sizeof(double) != 8) {
     intern_cleanup(s);
     caml_invalid_argument("input_value: non-standard floats");
@@ -314,22 +314,22 @@ static void readfloats(struct caml_intern_state* s,
   /* Host is big-endian; fix up if data read is little-endian */
   if (code != CODE_DOUBLE_ARRAY8_BIG &&
       code != CODE_DOUBLE_ARRAY32_BIG) {
-    for (i = 0; i < len; i++) Reverse_64(dest + i, dest + i);
+    for (mlsize_t i = 0; i < len; i++) Reverse_64(dest + i, dest + i);
   }
 #elif ARCH_FLOAT_ENDIANNESS == 0x01234567
   /* Host is little-endian; fix up if data read is big-endian */
   if (code != CODE_DOUBLE_ARRAY8_LITTLE &&
       code != CODE_DOUBLE_ARRAY32_LITTLE) {
-    for (i = 0; i < len; i++) Reverse_64(dest + i, dest + i);
+    for (mlsize_t i = 0; i < len; i++) Reverse_64(dest + i, dest + i);
   }
 #else
   /* Host is neither big nor little; permute as appropriate */
   if (code == CODE_DOUBLE_ARRAY8_LITTLE ||
       code == CODE_DOUBLE_ARRAY32_LITTLE) {
-    for (i = 0; i < len; i++)
+    for (mlsize_t i = 0; i < len; i++)
       Permute_64(dest + i, ARCH_FLOAT_ENDIANNESS, dest + i, 0x01234567);
   } else {
-    for (i = 0; i < len; i++)
+    for (mlsize_t i = 0; i < len; i++)
       Permute_64(dest + i, ARCH_FLOAT_ENDIANNESS, dest + i, 0x76543210);
   }
 #endif
@@ -396,7 +396,9 @@ static void intern_alloc_storage(struct caml_intern_state* s, mlsize_t whsize,
   wosize = Wosize_whsize(whsize);
 
   if (wosize <= Max_young_wosize && wosize != 0) {
-    v = caml_alloc_small (wosize, String_tag);
+    /* don't track bulk allocation in minor heap with statmemprof;
+     * individual block allocations are tracked instead */
+    Alloc_small(v, wosize, String_tag, Alloc_small_enter_GC_no_track);
     s->intern_dest = (header_t *) Hp_val(v);
   } else {
     CAMLassert (s->intern_dest == NULL);
@@ -426,16 +428,22 @@ static value intern_alloc_obj(struct caml_intern_state* s, caml_domain_state* d,
                 (value*)s->intern_dest < d->young_end);
     p = s->intern_dest;
     *s->intern_dest = Make_header (wosize, tag, 0);
+    caml_memprof_sample_block(Val_hp(p), wosize, 1 + wosize,
+                              CAML_MEMPROF_SRC_MARSHAL);
     s->intern_dest += 1 + wosize;
   } else {
     p = caml_shared_try_alloc(d->shared_heap, wosize, tag,
                               0 /* no reserved bits */);
-    d->allocated_words += Whsize_wosize(wosize);
     if (p == NULL) {
       intern_cleanup (s);
       caml_raise_out_of_memory();
     }
+    d->allocated_words += Whsize_wosize(wosize);
+    d->allocated_words_direct += Whsize_wosize(wosize);
     Hd_hp(p) = Make_header (wosize, tag, caml_global_heap_state.MARKED);
+    caml_memprof_sample_block(Val_hp(p), wosize,
+                              Whsize_wosize(wosize),
+                              CAML_MEMPROF_SRC_MARSHAL);
   }
   return Val_hp(p);
 }
@@ -718,8 +726,6 @@ static void intern_rec(struct caml_intern_state* s,
      may crash. */
   *dest = v;
   break;
-  default:
-    CAMLassert(0);
   }
   }
   /* We are done. Cleanup the stack and leave the function */

diff --git a/runtime/interp.c b/runtime/interp.c
index 479cd66ad4bc248698058c5f950e8fc796804b4c..ae146f2595c2fb92526d041d46deda7144499044 100644 (file)
--- a/runtime/interp.c
+++ b/runtime/interp.c
@@ -64,9 +64,11 @@ sp is a local copy of the global variable Caml_state->extern_sp. */
 #  else
 #    define Next goto *(void *)(jumptbl_base + *pc++)
 #  endif
+#  define Fallthrough ((void) 0)
 #else
 #  define Instruct(name) case name
 #  define Next break
+#  define Fallthrough fallthrough
 #endif
 
 /* GC interface */
@@ -284,7 +286,7 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
 #endif
 
 #ifdef THREADED_CODE
-  static void * jumptable[] = {
+  static const void * const jumptable[] = {
 #    include "caml/jumptbl.h"
   };
 #endif
@@ -419,7 +421,7 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
 
     Instruct(PUSHACC):
       *--sp = accu;
-      /* Fallthrough */
+      Fallthrough;
     Instruct(ACC):
       accu = sp[*pc++];
       Next;
@@ -454,7 +456,7 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
 
     Instruct(PUSHENVACC):
       *--sp = accu;
-      /* Fallthrough */
+      Fallthrough;
     Instruct(ENVACC):
       accu = Field(env, *pc++);
       Next;
@@ -522,11 +524,10 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
       int nargs = *pc++;
       int slotsize = *pc;
       value * newsp;
-      int i;
       /* Slide the nargs bottom words of the current frame to the top
          of the frame, and discard the remainder of the frame */
       newsp = sp + slotsize - nargs;
-      for (i = nargs - 1; i >= 0; i--) newsp[i] = sp[i];
+      for (int i = nargs - 1; i >= 0; i--) newsp[i] = sp[i];
       sp = newsp;
       pc = Code_val(accu);
       env = accu;
@@ -610,9 +611,8 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
 
     Instruct(RESTART): {
       int num_args = Wosize_val(env) - 3;
-      int i;
       sp -= num_args;
-      for (i = 0; i < num_args; i++) sp[i] = Field(env, i + 3);
+      for (int i = 0; i < num_args; i++) sp[i] = Field(env, i + 3);
       env = Field(env, 2);
       extra_args += num_args;
       Next;
@@ -624,11 +624,11 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
         extra_args -= required;
         Next;
       } else {
-        mlsize_t num_args, i;
+        mlsize_t num_args;
         num_args = 1 + extra_args; /* arg1 + extra args */
         Alloc_small(accu, num_args + 3, Closure_tag, Enter_gc);
         Field(accu, 2) = env;
-        for (i = 0; i < num_args; i++) Field(accu, i + 3) = sp[i];
+        for (mlsize_t i = 0; i < num_args; i++) Field(accu, i + 3) = sp[i];
         Code_val(accu) = pc - 3; /* Point to the preceding RESTART instr. */
         Closinfo_val(accu) = Make_closinfo(0, 2);
         sp += num_args;
@@ -638,18 +638,18 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
 
     Instruct(CLOSURE): {
       int nvars = *pc++;
-      int i;
       if (nvars > 0) *--sp = accu;
       if (nvars <= Max_young_wosize - 2) {
         /* nvars + 2 <= Max_young_wosize, can allocate in minor heap */
         Alloc_small(accu, 2 + nvars, Closure_tag, Enter_gc);
-        for (i = 0; i < nvars; i++) Field(accu, i + 2) = sp[i];
+        for (int i = 0; i < nvars; i++) Field(accu, i + 2) = 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(2 + nvars, Closure_tag);
-        for (i = 0; i < nvars; i++) caml_initialize(&Field(accu, i + 2), sp[i]);
+        for (int i = 0; i < nvars; i++)
+          caml_initialize(&Field(accu, i + 2), sp[i]);
       }
       /* The code pointer is not in the heap, so no need to go through
          caml_initialize. */
@@ -665,20 +665,19 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
       int nvars = *pc++;
       mlsize_t envofs = nfuncs * 3 - 1;
       mlsize_t blksize = envofs + nvars;
-      int i;
       volatile value * p;
       if (nvars > 0) *--sp = accu;
       if (blksize <= Max_young_wosize) {
         Alloc_small(accu, blksize, Closure_tag, Enter_gc);
         p = &Field(accu, envofs);
-        for (i = 0; i < nvars; i++, p++) *p = sp[i];
+        for (int 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, envofs);
-        for (i = 0; i < nvars; i++, p++) caml_initialize(p, sp[i]);
+        for (int i = 0; i < nvars; i++, p++) caml_initialize(p, sp[i]);
       }
       sp += nvars;
       /* The code pointers and infix headers are not in the heap,
@@ -687,7 +686,7 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
       p = &Field(accu, 0);
       *p++ = (value) (pc + pc[0]);
       *p++ = Make_closinfo(0, envofs);
-      for (i = 1; i < nfuncs; i++) {
+      for (int i = 1; i < nfuncs; i++) {
         *p++ = Make_header(i * 3, Infix_tag, 0); /* color irrelevant */
         *--sp = (value) p;
         *p++ = (value) (pc + pc[i]);
@@ -699,20 +698,20 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
     }
 
     Instruct(PUSHOFFSETCLOSURE):
-      *--sp = accu; /* fallthrough */
+      *--sp = accu; Fallthrough;
     Instruct(OFFSETCLOSURE):
       accu = env + *pc++ * sizeof(value); Next;
 
     Instruct(PUSHOFFSETCLOSUREM3):
-      *--sp = accu; /* fallthrough */
+      *--sp = accu; Fallthrough;
     Instruct(OFFSETCLOSUREM3):
       accu = env - 3 * sizeof(value); Next;
     Instruct(PUSHOFFSETCLOSURE0):
-      *--sp = accu; /* fallthrough */
+      *--sp = accu; Fallthrough;
     Instruct(OFFSETCLOSURE0):
       accu = env; Next;
     Instruct(PUSHOFFSETCLOSURE3):
-      *--sp = accu; /* fallthrough */
+      *--sp = accu; Fallthrough;
     Instruct(OFFSETCLOSURE3):
       accu = env + 3 * sizeof(value); Next;
 
@@ -721,7 +720,7 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
 
     Instruct(PUSHGETGLOBAL):
       *--sp = accu;
-      /* Fallthrough */
+      Fallthrough;
     Instruct(GETGLOBAL):
       accu = Field(caml_global_data, *pc);
       pc++;
@@ -729,7 +728,7 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
 
     Instruct(PUSHGETGLOBALFIELD):
       *--sp = accu;
-      /* Fallthrough */
+      Fallthrough;
     Instruct(GETGLOBALFIELD): {
       accu = Field(caml_global_data, *pc);
       pc++;
@@ -749,29 +748,29 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
 
     Instruct(PUSHATOM0):
       *--sp = accu;
-      /* Fallthrough */
+      Fallthrough;
     Instruct(ATOM0):
       accu = Atom(0); Next;
 
     Instruct(PUSHATOM):
       *--sp = accu;
-      /* Fallthrough */
+      Fallthrough;
     Instruct(ATOM):
       accu = Atom(*pc++); Next;
 
     Instruct(MAKEBLOCK): {
       mlsize_t wosize = *pc++;
       tag_t tag = *pc++;
-      mlsize_t i;
       value block;
       if (wosize <= Max_young_wosize) {
         Alloc_small(block, wosize, tag, Enter_gc);
         Field(block, 0) = accu;
-        for (i = 1; i < wosize; i++) Field(block, i) = *sp++;
+        for (mlsize_t i = 1; i < wosize; i++) Field(block, i) = *sp++;
       } else {
         block = caml_alloc_shr(wosize, tag);
         caml_initialize(&Field(block, 0), accu);
-        for (i = 1; i < wosize; i++) caml_initialize(&Field(block, i), *sp++);
+        for (mlsize_t i = 1; i < wosize; i++)
+          caml_initialize(&Field(block, i), *sp++);
       }
       accu = block;
       Next;
@@ -807,7 +806,6 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
     }
     Instruct(MAKEFLOATBLOCK): {
       mlsize_t size = *pc++;
-      mlsize_t i;
       value block;
       if (size <= Max_young_wosize / Double_wosize) {
         Alloc_small(block, size * Double_wosize, Double_array_tag, Enter_gc);
@@ -815,7 +813,7 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
         block = caml_alloc_shr(size * Double_wosize, Double_array_tag);
       }
       Store_double_flat_field(block, 0, Double_val(accu));
-      for (i = 1; i < size; i++){
+      for (mlsize_t i = 1; i < size; i++){
         Store_double_flat_field(block, i, Double_val(*sp));
         ++ sp;
       }
@@ -1022,7 +1020,7 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
         }
         sp = domain_state->current_stack->sp;
       }
-      /* Fall through CHECK_SIGNALS */
+      Fallthrough; /* CHECK_SIGNALS */
 
 /* Signal handling */
 
@@ -1106,7 +1104,7 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
 
     Instruct(PUSHCONSTINT):
       *--sp = accu;
-      /* Fallthrough */
+      Fallthrough;
     Instruct(CONSTINT):
       accu = Val_int(*pc);
       pc++;
@@ -1243,7 +1241,7 @@ value caml_bytecode_interpreter(code_t prog, asize_t prog_size,
       *--sp = accu;
       accu = Val_int(*pc);
       pc += 2;
-      /* Fallthrough */
+      Fallthrough;
 #endif
     Instruct(GETDYNMET): {
       /* accu == tag, sp[0] == object, *pc == cache */
@@ -1354,7 +1352,7 @@ do_resume: {
       sp = parent_stack->sp;
       Stack_parent(old_stack) = NULL;
       Field(cont, 0) = Val_ptr(old_stack);
-      Field(cont, 1) = Val_long(0);
+      Field(cont, 1) = Val_ptr(old_stack);
 
       domain_state->trap_sp_off = Long_val(sp[0]);
       extra_args = Long_val(sp[1]);
@@ -1399,6 +1397,7 @@ do_resume: {
       CAMLassert(Stack_parent(cont_tail) == NULL);
       Stack_parent(self) = NULL;
       Stack_parent(cont_tail) = self;
+      Field(cont, 1) = Val_ptr(self);
 
       domain_state->trap_sp_off = Long_val(sp[0]);
       extra_args = Long_val(sp[1]);
@@ -1416,7 +1415,7 @@ do_resume: {
 #ifndef THREADED_CODE
     default:
 #ifdef _MSC_VER
-      __assume(0);
+      CAMLunreachable();
 #else
       caml_fatal_error("bad opcode (%"
                            ARCH_INTNAT_PRINTF_FORMAT "x)",

diff --git a/runtime/ints.c b/runtime/ints.c
index 3e853fff680942d93c91fc6e8c17d194682da68e..3db3de6b6c7b659a3101e62a45b08cb2eba110b5 100644 (file)
--- a/runtime/ints.c
+++ b/runtime/ints.c
@@ -81,7 +81,7 @@ static intnat parse_intnat(value s, int nbits, const char *errmsg)
   int sign, base, signedness, d;
 
   p = parse_sign_and_base(String_val(s), &base, &signedness, &sign);
-  threshold = ((uintnat) -1) / base;
+  threshold = CAML_UINTNAT_MAX / base;
   d = parse_digit(*p);
   if (d < 0 || d >= base) caml_failwith(errmsg);
   for (p++, res = d; /*nothing*/; p++) {
@@ -251,7 +251,7 @@ CAMLprim value caml_int32_div(value v1, value v2)
   if (divisor == 0) caml_raise_zero_divide();
   /* PR#4740: on some processors, division crashes on overflow.
      Implement the same behavior as for type "int". */
-  if (dividend == (1<<31) && divisor == -1) return v1;
+  if (dividend == INT32_MIN && divisor == -1) return v1;
   return caml_copy_int32(dividend / divisor);
 }
 
@@ -262,7 +262,7 @@ CAMLprim value caml_int32_mod(value v1, value v2)
   if (divisor == 0) caml_raise_zero_divide();
   /* PR#4740: on some processors, modulus crashes if division overflows.
      Implement the same behavior as for type "int". */
-  if (dividend == (1<<31) && divisor == -1) return caml_copy_int32(0);
+  if (dividend == INT32_MIN && divisor == -1) return caml_copy_int32(0);
   return caml_copy_int32(dividend % divisor);
 }
 
@@ -450,8 +450,6 @@ CAMLprim value caml_int64_sub(value v1, value v2)
 CAMLprim value caml_int64_mul(value v1, value v2)
 { return caml_copy_int64(Int64_val(v1) * Int64_val(v2)); }
 
-#define Int64_min_int ((intnat) 1 << (sizeof(intnat) * 8 - 1))
-
 CAMLprim value caml_int64_div(value v1, value v2)
 {
   int64_t dividend = Int64_val(v1);
@@ -459,7 +457,7 @@ CAMLprim value caml_int64_div(value v1, value v2)
   if (divisor == 0) caml_raise_zero_divide();
   /* PR#4740: on some processors, division crashes on overflow.
      Implement the same behavior as for type "int". */
-  if (dividend == ((int64_t)1 << 63) && divisor == -1) return v1;
+  if (dividend == INT64_MIN && divisor == -1) return v1;
   return caml_copy_int64(dividend / divisor);
 }
 
@@ -470,7 +468,7 @@ CAMLprim value caml_int64_mod(value v1, value v2)
   if (divisor == 0) caml_raise_zero_divide();
   /* PR#4740: on some processors, division crashes on overflow.
      Implement the same behavior as for type "int". */
-  if (dividend == ((int64_t)1 << 63) && divisor == -1){
+  if (dividend == INT64_MIN && divisor == -1){
     return caml_copy_int64(0);
   }
   return caml_copy_int64(dividend % divisor);
@@ -606,7 +604,7 @@ CAMLprim value caml_int64_of_string(value s)
       if (res >  (uint64_t)1 << 63) caml_failwith(INT64_ERRMSG);
     }
   }
-  if (sign < 0) res = - res;
+  if (sign < 0) res = -(int64_t)res;
   return caml_copy_int64(res);
 }
 
@@ -666,7 +664,7 @@ static void nativeint_serialize(value v, uintnat * bsize_32,
 {
   intnat l = Nativeint_val(v);
 #ifdef ARCH_SIXTYFOUR
-  if (l >= -((intnat)1 << 31) && l < ((intnat)1 << 31)) {
+  if ((intnat)INT32_MIN <= l && l <= (intnat)INT32_MAX) {
     caml_serialize_int_1(1);
     caml_serialize_int_4((int32_t) l);
   } else {
@@ -731,8 +729,6 @@ CAMLprim value caml_nativeint_sub(value v1, value v2)
 CAMLprim value caml_nativeint_mul(value v1, value v2)
 { return caml_copy_nativeint(Nativeint_val(v1) * Nativeint_val(v2)); }
 
-#define Nativeint_min_int ((intnat) 1 << (sizeof(intnat) * 8 - 1))
-
 CAMLprim value caml_nativeint_div(value v1, value v2)
 {
   intnat dividend = Nativeint_val(v1);
@@ -740,7 +736,7 @@ CAMLprim value caml_nativeint_div(value v1, value v2)
   if (divisor == 0) caml_raise_zero_divide();
   /* PR#4740: on some processors, modulus crashes if division overflows.
      Implement the same behavior as for type "int". */
-  if (dividend == Nativeint_min_int && divisor == -1) return v1;
+  if (dividend == CAML_INTNAT_MIN && divisor == -1) return v1;
   return caml_copy_nativeint(dividend / divisor);
 }
 
@@ -751,7 +747,7 @@ CAMLprim value caml_nativeint_mod(value v1, value v2)
   if (divisor == 0) caml_raise_zero_divide();
   /* PR#4740: on some processors, modulus crashes if division overflows.
      Implement the same behavior as for type "int". */
-  if (dividend == Nativeint_min_int && divisor == -1){
+  if (dividend == CAML_INTNAT_MIN && divisor == -1){
     return caml_copy_nativeint(0);
   }
   return caml_copy_nativeint(dividend % divisor);

diff --git a/runtime/io.c b/runtime/io.c
index debf92213209c187fc7c0bda6c45703ccce0ebe1..5401af2d3ac19b0d95d98028c96b4a8d48e4fb8e 100644 (file)
--- a/runtime/io.c
+++ b/runtime/io.c
@@ -86,16 +86,8 @@ static CAMLthread_local struct channel* last_channel_locked = NULL;
 
 CAMLexport void caml_channel_lock(struct channel *chan)
 {
-  if( caml_plat_try_lock(&chan->mutex) ) {
-    last_channel_locked = chan;
-    return;
-  }
-
-  /* If unsuccessful, block on mutex */
-  caml_enter_blocking_section();
-  caml_plat_lock(&chan->mutex);
+  caml_plat_lock_non_blocking(&chan->mutex);
   last_channel_locked = chan;
-  caml_leave_blocking_section();
 }
 
 CAMLexport void caml_channel_unlock(struct channel *chan)
@@ -411,13 +403,12 @@ CAMLexport unsigned char caml_getch(struct channel *channel)
 
 CAMLexport uint32_t caml_getword(struct channel *channel)
 {
-  int i;
   uint32_t res;
 
   if (! caml_channel_binary_mode(channel))
     caml_failwith("input_binary_int: not a binary channel");
   res = 0;
-  for(i = 0; i < 4; i++) {
+  for (int i = 0; i < 4; i++) {
     res = (res << 8) + Getch(channel);
   }
   return res;
@@ -568,7 +559,7 @@ void caml_finalize_channel(value vchan)
   }
   /* Don't run concurrently with caml_ml_out_channels_list that may resurrect
      a dead channel . */
-  caml_plat_lock (&caml_all_opened_channels_mutex);
+  caml_plat_lock_blocking(&caml_all_opened_channels_mutex);
   chan->refcount --;
   if (chan->refcount > 0 || notflushed) {
     /* We need to keep the channel around, either because it is being
@@ -621,7 +612,7 @@ CAMLprim value caml_ml_open_descriptor_in_with_flags(int fd, int flags)
   struct channel * chan = caml_open_descriptor_in(fd);
   chan->flags |= flags | CHANNEL_FLAG_MANAGED_BY_GC;
   chan->refcount = 1;
-  caml_plat_lock (&caml_all_opened_channels_mutex);
+  caml_plat_lock_blocking(&caml_all_opened_channels_mutex);
   link_channel (chan);
   caml_plat_unlock (&caml_all_opened_channels_mutex);
   return caml_alloc_channel(chan);
@@ -636,7 +627,7 @@ CAMLprim value caml_ml_open_descriptor_out_with_flags(int fd, int flags)
   struct channel * chan = caml_open_descriptor_out(fd);
   chan->flags |= flags | CHANNEL_FLAG_MANAGED_BY_GC;
   chan->refcount = 1;
-  caml_plat_lock (&caml_all_opened_channels_mutex);
+  caml_plat_lock_blocking(&caml_all_opened_channels_mutex);
   link_channel (chan);
   caml_plat_unlock (&caml_all_opened_channels_mutex);
   return caml_alloc_channel(chan);
@@ -669,12 +660,11 @@ CAMLprim value caml_ml_out_channels_list (value unit)
 {
   CAMLparam0 ();
   CAMLlocal3 (res, tail, chan);
-  struct channel * channel;
   struct channel_list *channel_list = NULL, *cl_tmp;
-  mlsize_t i, num_channels = 0;
+  mlsize_t num_channels = 0;
 
-  caml_plat_lock (&caml_all_opened_channels_mutex);
-  for (channel = caml_all_opened_channels;
+  caml_plat_lock_blocking(&caml_all_opened_channels_mutex);
+  for (struct channel *channel = caml_all_opened_channels;
        channel != NULL;
        channel = channel->next) {
     CAMLassert(channel->flags & CHANNEL_FLAG_MANAGED_BY_GC);
@@ -695,7 +685,7 @@ CAMLprim value caml_ml_out_channels_list (value unit)
 
   res = Val_emptylist;
   cl_tmp = NULL;
-  for (i = 0; i < num_channels; i++) {
+  for (mlsize_t i = 0; i < num_channels; i++) {
     chan = caml_alloc_channel (channel_list->channel);
     tail = res;
     res = caml_alloc_2(Tag_cons, chan, tail);

diff --git a/runtime/lf_skiplist.c b/runtime/lf_skiplist.c
index 5b65142aaf782b846b49674b8e239e7810ebe930..473b8cd65552df4409e5f05d8dd7fccbc7f6e365 100644 (file)
--- a/runtime/lf_skiplist.c
+++ b/runtime/lf_skiplist.c
@@ -105,7 +105,7 @@ void caml_lf_skiplist_init(struct lf_skiplist *sk) {
 
   sk->tail = caml_stat_alloc(SIZEOF_LF_SKIPCELL +
                              NUM_LEVELS * sizeof(struct lf_skipcell *));
-  sk->tail->key = UINTNAT_MAX;
+  sk->tail->key = CAML_UINTNAT_MAX;
   sk->tail->data = 0;
   sk->tail->garbage_next = NULL;
   sk->tail->top_level = NUM_LEVELS - 1;
@@ -329,7 +329,8 @@ int caml_lf_skiplist_insert(struct lf_skiplist *sk, uintnat key, uintnat data) {
   struct lf_skipcell *preds[NUM_LEVELS];
   struct lf_skipcell *succs[NUM_LEVELS];
 
-  CAMLassert(key > 0 && key < UINTNAT_MAX);
+  CAMLassert(0 < key);
+  CAMLassert(key < CAML_UINTNAT_MAX);
 
   while (1) {
     /* We first try to find a node with [key] in the skip list. If it exists
@@ -354,7 +355,7 @@ int caml_lf_skiplist_insert(struct lf_skiplist *sk, uintnat key, uintnat data) {
       /* attentive readers will have noticed that we assume memory is aligned to
        * atleast even addresses. This is certainly the case on glibc amd64 and
        * Visual C++ on Windows though I can find no guarantees for other
-         platorms. */
+         platforms. */
       struct lf_skipcell *new_cell = caml_stat_alloc(
           SIZEOF_LF_SKIPCELL + (top_level + 1) * sizeof(struct lf_skipcell *));
       new_cell->top_level = top_level;

diff --git a/runtime/major_gc.c b/runtime/major_gc.c
index f6accc3ad84e5ad8873f1c40be2c2b438057d5c4..d8ca191be75aa1211e85c9fffd1825066faa5747 100644 (file)
--- a/runtime/major_gc.c
+++ b/runtime/major_gc.c
@@ -31,6 +31,7 @@
 #include "caml/globroots.h"
 #include "caml/gc_stats.h"
 #include "caml/memory.h"
+#include "caml/memprof.h"
 #include "caml/mlvalues.h"
 #include "caml/platform.h"
 #include "caml/roots.h"
@@ -71,6 +72,7 @@ struct mark_stack {
   addrmap_iterator compressed_stack_iter;
 };
 
+/* Default speed setting for the major GC. */
 uintnat caml_percent_free = Percent_free_def;
 
 /* This variable is only written with the world stopped, so it need not be
@@ -249,7 +251,8 @@ Caml_inline void pb_fill_mode(prefetch_buffer_t *pb)
 
 Caml_inline void pb_push(prefetch_buffer_t* pb, value v)
 {
-  CAMLassert(Is_block(v) && !Is_young(v));
+  CAMLassert(Is_block(v));
+  CAMLassert(!Is_young(v));
   CAMLassert(v != Debug_free_major);
   CAMLassert(pb->enqueued < pb->dequeued + PREFETCH_BUFFER_SIZE);
 
@@ -291,7 +294,7 @@ Caml_inline void prefetch_block(value v)
 
 static void ephe_next_cycle (void)
 {
-  caml_plat_lock(&ephe_lock);
+  caml_plat_lock_blocking(&ephe_lock);
 
   atomic_fetch_add(&ephe_cycle_info.ephe_cycle, +1);
   CAMLassert(atomic_load_acquire(&ephe_cycle_info.num_domains_done) <=
@@ -303,7 +306,7 @@ static void ephe_next_cycle (void)
 
 static void ephe_todo_list_emptied (void)
 {
-  caml_plat_lock(&ephe_lock);
+  caml_plat_lock_blocking(&ephe_lock);
 
   /* Force next ephemeron marking cycle in order to avoid reasoning about
    * whether the domain has already incremented
@@ -313,7 +316,7 @@ static void ephe_todo_list_emptied (void)
 
   /* Since the todo list is empty, this domain does not need to participate in
    * further ephemeron cycles. */
-  atomic_fetch_add(&ephe_cycle_info.num_domains_todo, -1);
+  atomic_fetch_sub(&ephe_cycle_info.num_domains_todo, 1);
   CAMLassert(atomic_load_acquire(&ephe_cycle_info.num_domains_done) <=
              atomic_load_acquire(&ephe_cycle_info.num_domains_todo));
 
@@ -329,7 +332,7 @@ static void record_ephe_marking_done (uintnat ephe_cycle)
   if (ephe_cycle < atomic_load_acquire(&ephe_cycle_info.ephe_cycle))
     return;
 
-  caml_plat_lock(&ephe_lock);
+  caml_plat_lock_blocking(&ephe_lock);
   if (ephe_cycle == atomic_load(&ephe_cycle_info.ephe_cycle)) {
     Caml_state->ephe_info->cycle = ephe_cycle;
     atomic_fetch_add(&ephe_cycle_info.num_domains_done, +1);
@@ -412,7 +415,7 @@ void caml_orphan_ephemerons (caml_domain_state* domain_state)
     value live_tail = ephe_list_tail(ephe_info->live);
     CAMLassert(Ephe_link(live_tail) == 0);
 
-    caml_plat_lock(&orphaned_lock);
+    caml_plat_lock_blocking(&orphaned_lock);
     Ephe_link(live_tail) = orph_structs.ephe_list_live;
     orph_structs.ephe_list_live = ephe_info->live;
     ephe_info->live = 0;
@@ -446,7 +449,7 @@ void caml_orphan_finalisers (caml_domain_state* domain_state)
     CAMLassert (!f->updated_last);
 
     /* Add the finalisers to [orph_structs] */
-    caml_plat_lock(&orphaned_lock);
+    caml_plat_lock_blocking(&orphaned_lock);
     f->next = orph_structs.final_info;
     orph_structs.final_info = f;
     caml_plat_unlock(&orphaned_lock);
@@ -485,7 +488,7 @@ static void adopt_orphaned_work (void)
   if (no_orphaned_work() || caml_domain_is_terminating())
     return;
 
-  caml_plat_lock(&orphaned_lock);
+  caml_plat_lock_blocking(&orphaned_lock);
 
   orph_ephe_list_live = orph_structs.ephe_list_live;
   orph_structs.ephe_list_live = 0;
@@ -536,53 +539,6 @@ static void adopt_orphaned_work (void)
   }
 }
 
-/******************************************************************************/
-
-#define BUFFER_SIZE 64
-
-struct buf_list_t {
-  double buffer[BUFFER_SIZE];
-  struct buf_list_t *next;
-};
-
-static struct {
-  intnat heap_words_last_cycle;
-  intnat not_garbage_words_last_cycle;
-  int index;
-  struct buf_list_t *l;
- } caml_stat_space_overhead = {0, 0, 0, NULL};
-
-double caml_mean_space_overhead (void)
-{
-  int index = caml_stat_space_overhead.index;
-  struct buf_list_t *t, *l = caml_stat_space_overhead.l;
-  /* Use Welford's online algorithm for calculating running variance to remove
-   * outliers from mean calculation. */
-  double mean = 0.0, m2 = 0.0, stddev = 0.0, v;
-  double delta, delta2;
-  intnat count = 0;
-
-  while (l) {
-    while (index > 0) {
-      v = l->buffer[--index];
-      if (count > 5 && (v < mean - 3 * stddev || v > mean + 3 * stddev)) {
-        continue;
-      }
-      count++;
-      delta = v - mean;
-      mean = mean + delta / count;
-      delta2 = v - mean;
-      m2 = m2 + delta * delta2;
-      stddev = sqrt (m2 / count);
-    }
-    t = l;
-    l = l->next;
-    caml_stat_free(t);
-    index = BUFFER_SIZE;
-  }
-  return mean;
-}
-
 static inline intnat max2 (intnat a, intnat b)
 {
   if (a > b){
@@ -620,21 +576,32 @@ static inline intnat diffmod (uintnat x1, uintnat x2)
   return (intnat) (x1 - x2);
 }
 
-static void update_major_slice_work(intnat howmuch,
-                                    int may_access_gc_phase)
+/* The [log_events] parameter is used to disable writing to the ring for two
+   reasons:
+   1. To prevent spamming the ring with numerous events generated during
+      an opportunistic GC slice.
+   2. To avoid logging events when the calling domain is not part of the
+      Stop-The-World (STW) participant set. If the domain is not part of
+      the STW set, the ring could be torn down concurrently while this domain
+      attempts to write to it. */
+static void
+update_major_slice_work(intnat howmuch,
+                        int may_access_gc_phase,
+                        int log_events /* log events to the ring? */)
 {
-  double heap_words;
   intnat alloc_work, dependent_work, extra_work, new_work;
-  intnat my_alloc_count, my_dependent_count;
+  intnat my_alloc_count, my_alloc_direct_count, my_dependent_count;
   double my_extra_count;
   caml_domain_state *dom_st = Caml_state;
-  uintnat heap_size, heap_sweep_words, total_cycle_work;
+  uintnat heap_words, heap_size, heap_sweep_words, total_cycle_work;
 
   my_alloc_count = dom_st->allocated_words;
+  my_alloc_direct_count = dom_st->allocated_words_direct;
   my_dependent_count = dom_st->dependent_allocated;
   my_extra_count = dom_st->extra_heap_resources;
   dom_st->stat_major_words += dom_st->allocated_words;
   dom_st->allocated_words = 0;
+  dom_st->allocated_words_direct = 0;
   dom_st->dependent_allocated = 0;
   dom_st->extra_heap_resources = 0.0;
   /*
@@ -672,11 +639,12 @@ static void update_major_slice_work(intnat howmuch,
                  S = P * TW
   */
   heap_size = caml_heap_size(dom_st->shared_heap);
-  heap_words = (double)Wsize_bsize(heap_size);
+  heap_words = Wsize_bsize(heap_size);
   heap_sweep_words = heap_words;
 
   total_cycle_work =
-    heap_sweep_words + (heap_words * 100 / (100 + caml_percent_free));
+    heap_sweep_words
+    + (uintnat) ((double) heap_words * 100.0 / (100.0 + caml_percent_free));
 
   if (heap_words > 0) {
     double alloc_ratio =
@@ -692,7 +660,7 @@ static void update_major_slice_work(intnat howmuch,
     double dependent_ratio =
       total_cycle_work
       * (100 + caml_percent_free)
-      / dom_st-> dependent_size / caml_percent_free;
+        / (double)dom_st->dependent_size / (double)caml_percent_free;
     dependent_work = (intnat) (my_dependent_count * dependent_ratio);
   }else{
     dependent_work = 0;
@@ -706,6 +674,9 @@ static void update_major_slice_work(intnat howmuch,
   caml_gc_message (0x40, "allocated_words = %"
                          ARCH_INTNAT_PRINTF_FORMAT "u\n",
                    my_alloc_count);
+  caml_gc_message (0x40, "allocated_words_direct = %"
+                         ARCH_INTNAT_PRINTF_FORMAT "u\n",
+                   my_alloc_direct_count);
   caml_gc_message (0x40, "alloc work-to-do = %"
                          ARCH_INTNAT_PRINTF_FORMAT "d\n",
                    alloc_work);
@@ -756,6 +727,18 @@ static void update_major_slice_work(intnat howmuch,
               atomic_load (&alloc_counter),
               dom_st->slice_target, dom_st->slice_budget
               );
+
+  if (log_events) {
+    CAML_EV_COUNTER(EV_C_MAJOR_HEAP_WORDS, (uintnat)heap_words);
+    CAML_EV_COUNTER(EV_C_MAJOR_ALLOCATED_WORDS, my_alloc_count);
+    CAML_EV_COUNTER(EV_C_MAJOR_ALLOCATED_WORK, alloc_work);
+    CAML_EV_COUNTER(EV_C_MAJOR_DEPENDENT_WORK, dependent_work);
+    CAML_EV_COUNTER(EV_C_MAJOR_EXTRA_WORK, extra_work);
+    CAML_EV_COUNTER(EV_C_MAJOR_WORK_COUNTER, atomic_load (&work_counter));
+    CAML_EV_COUNTER(EV_C_MAJOR_ALLOC_COUNTER, atomic_load (&alloc_counter));
+    CAML_EV_COUNTER(EV_C_MAJOR_SLICE_TARGET, dom_st->slice_target);
+    CAML_EV_COUNTER(EV_C_MAJOR_SLICE_BUDGET, dom_st->slice_budget);
+  }
 }
 
 #define Chunk_size 0x4000
@@ -820,8 +803,7 @@ static void realloc_mark_stack (struct mark_stack* stk)
      will not compress and because we are using a domain local heap bound we
      need to fit large blocks into the local mark stack. See PR#11284 */
   if (mark_stack_bsize >= local_heap_bsize / 32) {
-    uintnat i;
-    for (i = 0; i < stk->count; ++i) {
+    for (uintnat i = 0; i < stk->count; ++i) {
       mark_entry* me = &stk->stack[i];
       if (me->end - me->start > BITS_PER_WORD)
         mark_stack_large_bsize += sizeof(mark_entry);
@@ -882,7 +864,8 @@ static intnat mark_stack_push_block(struct mark_stack* stk, value block)
   }
 
   CAMLassert(Has_status_val(block, caml_global_heap_state.MARKED));
-  CAMLassert(Is_block(block) && !Is_young(block));
+  CAMLassert(Is_block(block));
+  CAMLassert(!Is_young(block));
   CAMLassert(Tag_val(block) != Infix_tag);
   CAMLassert(Tag_val(block) < No_scan_tag);
   CAMLassert(Tag_val(block) != Cont_tag);
@@ -1179,7 +1162,9 @@ static scanning_action_flags darken_scanning_flags = 0;
 
 void caml_darken_cont(value cont)
 {
-  CAMLassert(Is_block(cont) && !Is_young(cont) && Tag_val(cont) == Cont_tag);
+  CAMLassert(Is_block(cont));
+  CAMLassert(!Is_young(cont));
+  CAMLassert(Tag_val(cont) == Cont_tag);
   {
     SPIN_WAIT {
       header_t hd = atomic_load_relaxed(Hp_atomic_val(cont));
@@ -1345,19 +1330,109 @@ static intnat ephe_sweep (caml_domain_state* domain_state, intnat budget)
   return budget;
 }
 
+static void cycle_major_heap_from_stw_single(
+  caml_domain_state* domain,
+  uintnat num_domains_in_stw)
+{
+  /* Cycle major heap */
+  /* FIXME: delete caml_cycle_heap_from_stw_single
+     and have per-domain copies of the data? */
+  caml_cycle_heap_from_stw_single();
+  caml_gc_log("GC cycle %lu completed (heap cycled)",
+              (long unsigned int)caml_major_cycles_completed);
+
+  caml_major_cycles_completed++;
+  caml_gc_message(0x40, "Starting major GC cycle\n");
+
+  if (atomic_load_relaxed(&caml_verb_gc) & 0x400) {
+    struct gc_stats s;
+    intnat heap_words, not_garbage_words, swept_words;
+
+    caml_compute_gc_stats(&s);
+    heap_words = s.heap_stats.pool_words + s.heap_stats.large_words;
+    not_garbage_words = s.heap_stats.pool_live_words
+      + s.heap_stats.large_words;
+    swept_words = domain->swept_words;
+    caml_gc_log ("heap_words: %"ARCH_INTNAT_PRINTF_FORMAT"d "
+                 "not_garbage_words %"ARCH_INTNAT_PRINTF_FORMAT"d "
+                 "swept_words %"ARCH_INTNAT_PRINTF_FORMAT"d",
+                 heap_words, not_garbage_words, swept_words);
+
+    static struct {
+      intnat heap_words;
+      intnat not_garbage_words;
+    } last_cycle = {0, 0};
+
+    if (last_cycle.heap_words != 0) {
+      /* At the end of a major cycle, no object has colour MARKED.
+
+         [not_garbage_words] counts all objects which are UNMARKED.
+         Importantly, this includes both live objects and objects which are
+         unreachable in the current cycle (i.e, garbage). But we don't get
+         to know which objects are garbage until the end of the next cycle.
+
+         live_words@N = not_garbage_words@N - swept_words@N+1
+
+         space_overhead@N =
+         100.0 * (heap_words@N - live_words@N) / live_words@N
+      */
+      intnat live_words = last_cycle.not_garbage_words - swept_words;
+      double space_overhead = 100.0 * (double)(last_cycle.heap_words
+                                               - live_words) / live_words;
+
+      caml_gc_log("Previous cycle's space_overhead: %lf", space_overhead);
+    }
+    last_cycle.heap_words = heap_words;
+    last_cycle.not_garbage_words = not_garbage_words;
+  }
+
+  domain->swept_words = 0;
+
+  atomic_store_release(&num_domains_to_sweep, num_domains_in_stw);
+  atomic_store_release(&num_domains_to_mark, num_domains_in_stw);
+
+  caml_gc_phase = Phase_sweep_and_mark_main;
+  atomic_store(&ephe_cycle_info.num_domains_todo, num_domains_in_stw);
+  atomic_store(&ephe_cycle_info.ephe_cycle, 1);
+  atomic_store(&ephe_cycle_info.num_domains_done, 0);
+
+  atomic_store_release(&num_domains_to_ephe_sweep, 0);
+  /* Will be set to the correct number when switching to
+     [Phase_sweep_ephe] */
+
+  atomic_store_release(&num_domains_to_final_update_first,
+                       num_domains_in_stw);
+  atomic_store_release(&num_domains_to_final_update_last,
+                       num_domains_in_stw);
+
+  atomic_store(&domain_global_roots_started, WORK_UNSTARTED);
+
+  caml_code_fragment_cleanup_from_stw_single();
+}
+
 struct cycle_callback_params {
   int force_compaction;
 };
 
-static void stw_cycle_all_domains(caml_domain_state* domain, void* args,
-                                       int participating_count,
-                                       caml_domain_state** participating)
+static void stw_cycle_all_domains(
+  caml_domain_state* domain, void* args,
+  int participating_count,
+  caml_domain_state** participating)
 {
-  uintnat num_domains_in_stw;
   /* We copy params because the stw leader may leave early. No barrier needed
      because there's one in the minor gc and after. */
   struct cycle_callback_params params = *((struct cycle_callback_params*)args);
 
+  /* TODO: Not clear this memprof work is really part of the "cycle"
+   * operation. It's more like ephemeron-cleaning really. An earlier
+   * version had a separate callback for this, but resulted in
+   * failures because using caml_try_run_on_all_domains() on it would
+   * mysteriously put all domains back into mark/sweep.
+   */
+  CAML_EV_BEGIN(EV_MAJOR_MEMPROF_CLEAN);
+  caml_memprof_after_major_gc(domain);
+  CAML_EV_END(EV_MAJOR_MEMPROF_CLEAN);
+
   CAML_EV_BEGIN(EV_MAJOR_GC_CYCLE_DOMAINS);
 
   CAMLassert(domain == Caml_state);
@@ -1371,99 +1446,8 @@ static void stw_cycle_all_domains(caml_domain_state* domain, void* args,
                         (domain, (void*)0, participating_count, participating);
 
   CAML_EV_BEGIN(EV_MAJOR_GC_STW);
-
-  {
-    /* Cycle major heap */
-    /* FIXME: delete caml_cycle_heap_from_stw_single
-       and have per-domain copies of the data? */
-    barrier_status b = caml_global_barrier_begin();
-    if (caml_global_barrier_is_final(b)) {
-      caml_cycle_heap_from_stw_single();
-      caml_gc_log("GC cycle %lu completed (heap cycled)",
-                  (long unsigned int)caml_major_cycles_completed);
-
-      caml_major_cycles_completed++;
-      caml_gc_message(0x40, "Starting major GC cycle\n");
-
-      if (atomic_load_relaxed(&caml_verb_gc) & 0x400) {
-        struct gc_stats s;
-        intnat heap_words, not_garbage_words, swept_words;
-
-        caml_compute_gc_stats(&s);
-        heap_words = s.heap_stats.pool_words + s.heap_stats.large_words;
-        not_garbage_words = s.heap_stats.pool_live_words
-                            + s.heap_stats.large_words;
-        swept_words = domain->swept_words;
-        caml_gc_log ("heap_words: %"ARCH_INTNAT_PRINTF_FORMAT"d "
-                      "not_garbage_words %"ARCH_INTNAT_PRINTF_FORMAT"d "
-                      "swept_words %"ARCH_INTNAT_PRINTF_FORMAT"d",
-                      heap_words, not_garbage_words, swept_words);
-
-        if (caml_stat_space_overhead.heap_words_last_cycle != 0) {
-          /* At the end of a major cycle, no object has colour MARKED.
-
-             [not_garbage_words] counts all objects which are UNMARKED.
-             Importantly, this includes both live objects and objects which are
-             unreachable in the current cycle (i.e, garbage). But we don't get
-             to know which objects are garbage until the end of the next cycle.
-
-             live_words@N = not_garbage_words@N - swept_words@N+1
-
-             space_overhead@N =
-                      100.0 * (heap_words@N - live_words@N) / live_words@N
-            */
-          double live_words_last_cycle =
-            caml_stat_space_overhead.not_garbage_words_last_cycle - swept_words;
-          double space_overhead =
-            100.0 * (double)(caml_stat_space_overhead.heap_words_last_cycle
-                            - live_words_last_cycle) / live_words_last_cycle;
-
-          if (caml_stat_space_overhead.l == NULL ||
-              caml_stat_space_overhead.index == BUFFER_SIZE) {
-            struct buf_list_t *l =
-              (struct buf_list_t*)
-                  caml_stat_alloc_noexc(sizeof(struct buf_list_t));
-            l->next = caml_stat_space_overhead.l;
-            caml_stat_space_overhead.l = l;
-            caml_stat_space_overhead.index = 0;
-          }
-          caml_stat_space_overhead.l->buffer[caml_stat_space_overhead.index++] =
-            space_overhead;
-          caml_gc_log("Previous cycle's space_overhead: %lf", space_overhead);
-        }
-        caml_stat_space_overhead.heap_words_last_cycle = heap_words;
-
-        caml_stat_space_overhead.not_garbage_words_last_cycle
-        = not_garbage_words;
-      }
-
-      domain->swept_words = 0;
-
-      num_domains_in_stw = (uintnat)caml_global_barrier_num_domains();
-      atomic_store_release(&num_domains_to_sweep, num_domains_in_stw);
-      atomic_store_release(&num_domains_to_mark, num_domains_in_stw);
-
-      caml_gc_phase = Phase_sweep_and_mark_main;
-      atomic_store(&ephe_cycle_info.num_domains_todo, num_domains_in_stw);
-      atomic_store(&ephe_cycle_info.ephe_cycle, 1);
-      atomic_store(&ephe_cycle_info.num_domains_done, 0);
-
-      atomic_store_release(&num_domains_to_ephe_sweep, 0);
-      /* Will be set to the correct number when switching to
-         [Phase_sweep_ephe] */
-
-      atomic_store_release(&num_domains_to_final_update_first,
-                           num_domains_in_stw);
-      atomic_store_release(&num_domains_to_final_update_last,
-                           num_domains_in_stw);
-
-      atomic_store(&domain_global_roots_started, WORK_UNSTARTED);
-
-      caml_code_fragment_cleanup_from_stw_single();
-    }
-    // should interrupts be processed here or not?
-    // depends on whether marking above may need interrupts
-    caml_global_barrier_end(b);
+  Caml_global_barrier_if_final(participating_count) {
+    cycle_major_heap_from_stw_single(domain, (uintnat) participating_count);
   }
 
   /* If the heap is to be verified, do it before the domains continue
@@ -1474,7 +1458,7 @@ static void stw_cycle_all_domains(caml_domain_state* domain, void* args,
     /* This global barrier avoids races between the verify_heap code
        and the rest of the STW critical section, for example the parts
        that mark global roots. */
-    caml_global_barrier();
+    caml_global_barrier(participating_count);
   }
 
   caml_cycle_heap(domain->shared_heap);
@@ -1523,6 +1507,11 @@ static void stw_cycle_all_domains(caml_domain_state* domain, void* args,
   }
   CAML_EV_END(EV_MAJOR_MARK_ROOTS);
 
+  CAML_EV_BEGIN(EV_MAJOR_MEMPROF_ROOTS);
+  caml_memprof_scan_roots(caml_darken, darken_scanning_flags, domain,
+                          domain, false);
+  CAML_EV_END(EV_MAJOR_MEMPROF_ROOTS);
+
   if (domain->mark_stack->count == 0 &&
       !caml_addrmap_iter_ok(&domain->mark_stack->compressed_stack,
                             domain->mark_stack->compressed_stack_iter)
@@ -1555,10 +1544,10 @@ static void stw_cycle_all_domains(caml_domain_state* domain, void* args,
   /* To ensure a mutator doesn't resume while global roots are being marked.
      Mutators can alter the set of global roots, to preserve its correctness,
      they should not run while global roots are being marked.*/
-  caml_global_barrier();
+  caml_global_barrier(participating_count);
 
   /* Someone should flush the allocation stats we gathered during the cycle */
-  if( participating[0] == Caml_state ) {
+  if( participating[0] == domain ) {
     CAML_EV_ALLOC_FLUSH();
   }
 
@@ -1622,11 +1611,9 @@ static void stw_try_complete_gc_phase(
   int participant_count,
   caml_domain_state** participating)
 {
-  barrier_status b;
   CAML_EV_BEGIN(EV_MAJOR_GC_PHASE_CHANGE);
 
-  b = caml_global_barrier_begin ();
-  if (caml_global_barrier_is_final(b)) {
+  Caml_global_barrier_if_final(participant_count) {
     if (is_complete_phase_sweep_and_mark_main()) {
       caml_gc_phase = Phase_mark_final;
     } else if (is_complete_phase_mark_final()) {
@@ -1636,13 +1623,12 @@ static void stw_try_complete_gc_phase(
         participating[i]->ephe_info->must_sweep_ephe = 1;
     }
   }
-  caml_global_barrier_end(b);
+
   CAML_EV_END(EV_MAJOR_GC_PHASE_CHANGE);
 }
 
-intnat caml_opportunistic_major_work_available (void)
+intnat caml_opportunistic_major_work_available (caml_domain_state* domain_state)
 {
-  caml_domain_state* domain_state = Caml_state;
   return !domain_state->sweeping_done || !domain_state->marking_done;
 }
 
@@ -1679,7 +1665,7 @@ static void major_collection_slice(intnat howmuch,
   int log_events = mode != Slice_opportunistic ||
                    (atomic_load_relaxed(&caml_verb_gc) & 0x40);
 
-  update_major_slice_work(howmuch, may_access_gc_phase);
+  update_major_slice_work(howmuch, may_access_gc_phase, log_events);
 
   /* When a full slice of major GC work is done,
      or the slice is interrupted (in mode Slice_interruptible),
@@ -1688,7 +1674,7 @@ static void major_collection_slice(intnat howmuch,
   /* shortcut out if there is no opportunistic work to be done
    * NB: needed particularly to avoid caml_ev spam when polling */
   if (mode == Slice_opportunistic &&
-      !caml_opportunistic_major_work_available()) {
+      !caml_opportunistic_major_work_available(domain_state)) {
     commit_major_slice_work (0);
     return;
   }
@@ -1998,6 +1984,7 @@ void caml_finish_marking (void)
     caml_shrink_mark_stack();
     Caml_state->stat_major_words += Caml_state->allocated_words;
     Caml_state->allocated_words = 0;
+    Caml_state->allocated_words_direct = 0;
     CAML_EV_END(EV_MAJOR_FINISH_MARKING);
   }
 }
@@ -2049,8 +2036,7 @@ static void mark_stack_prune(struct mark_stack* stk)
      unprocessed entries of the existing compressed stack into the new one. */
   uintnat old_compressed_entries = 0;
   struct addrmap new_compressed_stack = ADDRMAP_INIT;
-  addrmap_iterator it;
-  for (it = stk->compressed_stack_iter;
+  for (addrmap_iterator it = stk->compressed_stack_iter;
        caml_addrmap_iter_ok(&stk->compressed_stack, it);
        it = caml_addrmap_next(&stk->compressed_stack, it)) {
     value k = caml_addrmap_iter_key(&stk->compressed_stack, it);
@@ -2066,8 +2052,8 @@ static void mark_stack_prune(struct mark_stack* stk)
   stk->compressed_stack = new_compressed_stack;
 
   /* scan mark stack and compress entries */
-  uintnat i, new_stk_count = 0, compressed_entries = 0, total_words = 0;
-  for (i=0; i < stk->count; i++) {
+  uintnat new_stk_count = 0, compressed_entries = 0, total_words = 0;
+  for (uintnat i = 0; i < stk->count; i++) {
     mark_entry me = stk->stack[i];
     total_words += me.end - me.start;
     if (me.end - me.start > BITS_PER_WORD) {
@@ -2145,8 +2131,10 @@ void caml_teardown_major_gc(void) {
    so we may not access the gc phase. */
   int may_access_gc_phase = 0;
 
-  /* account for latest allocations */
-  update_major_slice_work (0, may_access_gc_phase);
+  /* Account for latest allocations, but do not write to the event ring since
+     we are out of the STW participant set; the ring may be torn down
+     concurrently. */
+  update_major_slice_work (0, may_access_gc_phase, 0);
   CAMLassert(!caml_addrmap_iter_ok(&d->mark_stack->compressed_stack,
                                    d->mark_stack->compressed_stack_iter));
   caml_addrmap_clear(&d->mark_stack->compressed_stack);

diff --git a/runtime/md5.c b/runtime/md5.c
index 4ae64c3c2c77d7a584e3a389ffecb9fee047067a..9f70b998251b30f9db83a0bbc2d1ab1236a1c41d 100644 (file)
--- a/runtime/md5.c
+++ b/runtime/md5.c
@@ -37,6 +37,11 @@ CAMLprim value caml_md5_string(value str, value ofs, value len)
   return res;
 }
 
+CAMLprim value caml_md5_bytes(value b, value ofs, value len)
+{
+  return caml_md5_string(b, ofs, len);
+}
+
 CAMLexport value caml_md5_channel(struct channel *chan, intnat toread)
 {
   CAMLparam0();

diff --git a/runtime/memory.c b/runtime/memory.c
index 4545f3d1f8eec03b950858d3c67e7b9b0595a616..dd5b082d609d318c8e1f8a6bae2ff1f9c1403d0d 100644 (file)
--- a/runtime/memory.c
+++ b/runtime/memory.c
@@ -20,11 +20,16 @@
 #include <stdio.h>
 #include <stdarg.h>
 #include <stddef.h>
+#include <stdalign.h>
+#if defined(_WIN32)
+#include <malloc.h>
+#endif
 #include "caml/config.h"
 #include "caml/custom.h"
 #include "caml/misc.h"
 #include "caml/fail.h"
 #include "caml/memory.h"
+#include "caml/memprof.h"
 #include "caml/major_gc.h"
 #include "caml/signals.h"
 #include "caml/shared_heap.h"
@@ -286,7 +291,7 @@ CAMLexport void caml_adjust_minor_gc_speed (mlsize_t res, mlsize_t max)
   }
 }
 
-/* You must use [caml_intialize] to store the initial value in a field of a
+/* You must use [caml_initialize] to store the initial value in a field of a
    block, unless you are sure the value is not a young block, in which case a
    plain assignment would do.
 
@@ -301,7 +306,8 @@ CAMLexport CAMLweakdef void caml_initialize (volatile value *fp, value val)
   /* Previous value should not be a pointer.
      In the debug runtime, it can be either a TMC placeholder,
      or an uninitialized value canary (Debug_uninit_{major,minor}). */
-  CAMLassert(Is_long(*fp));
+  CAMLassert(Is_long(*fp) || *fp == Debug_uninit_major
+             || *fp == Debug_uninit_minor);
 #endif
   *fp = val;
   if (!Is_young((value)fp) && Is_block_and_young (val))
@@ -409,10 +415,9 @@ CAMLprim value caml_atomic_fetch_add (value ref, value incr)
 
 CAMLexport void caml_set_fields (value obj, value v)
 {
-  int i;
   CAMLassert (Is_block(obj));
 
-  for (i = 0; i < Wosize_val(obj); i++) {
+  for (int i = 0; i < Wosize_val(obj); i++) {
     caml_modify(&Field(obj, i), v);
   }
 }
@@ -432,18 +437,22 @@ Caml_inline value alloc_shr(mlsize_t wosize, tag_t tag, reserved_t reserved,
   }
 
   dom_st->allocated_words += Whsize_wosize(wosize);
-  if (dom_st->allocated_words > dom_st->minor_heap_wsz / 5) {
+  dom_st->allocated_words_direct += Whsize_wosize(wosize);
+  if (dom_st->allocated_words_direct > dom_st->minor_heap_wsz / 5) {
     CAML_EV_COUNTER (EV_C_REQUEST_MAJOR_ALLOC_SHR, 1);
     caml_request_major_slice(1);
   }
 
 #ifdef DEBUG
   if (tag < No_scan_tag) {
-    mlsize_t i;
-    for (i = 0; i < wosize; i++)
+    for (mlsize_t i = 0; i < wosize; i++)
       Op_hp(v)[i] = Debug_uninit_major;
   }
 #endif
+  caml_memprof_sample_block(Val_hp(v), wosize,
+                            Whsize_wosize(wosize),
+                            CAML_MEMPROF_SRC_NORMAL);
+
   return Val_hp(v);
 }
 
@@ -481,52 +490,42 @@ CAMLexport value caml_alloc_shr_noexc(mlsize_t wosize, tag_t tag) {
    the implementation from the user.
 */
 
-/* A type with the most strict alignment requirements */
-union max_align {
-  char c;
-  short s;
-  long l;
-  int i;
-  float f;
-  double d;
-  void *v;
-  void (*q)(void);
-};
+#if !defined(HAVE_MAX_ALIGN_T) && defined(_MSC_VER)
+typedef double max_align_t;
+#endif
 
-struct pool_block {
-#ifdef DEBUG
-  intnat magic;
+#define MAX(a, b) ((a) > (b) ? (a) : (b))
+
+#if defined(_M_AMD64) || defined(__x86_64__)
+#define pool_block_align MAX(alignof(max_align_t), 16 /* for SSE */)
+#else
+#define pool_block_align alignof(max_align_t)
 #endif
+
+struct pool_block {
   struct pool_block *next;
   struct pool_block *prev;
-  union max_align data[];  /* not allocated, used for alignment purposes */
+  alignas(pool_block_align) char data[]; /* flexible array member */
 };
 
-#define SIZEOF_POOL_BLOCK sizeof(struct pool_block)
-
 static struct pool_block *pool = NULL;
 static caml_plat_mutex pool_mutex = CAML_PLAT_MUTEX_INITIALIZER;
 
 /* Returns a pointer to the block header, given a pointer to "data" */
 static struct pool_block* get_pool_block(caml_stat_block b)
 {
-  if (b == NULL)
+  if (b == NULL) {
     return NULL;
-
-  else {
-    struct pool_block *pb =
-      (struct pool_block*)(((char*)b) - SIZEOF_POOL_BLOCK);
-#ifdef DEBUG
-    CAMLassert(pb->magic == Debug_pool_magic);
-#endif
-    return pb;
+  } else {
+    return (struct pool_block *)
+      (((char *) b) - offsetof(struct pool_block, data));
   }
 }
 
 /* Linking a pool block into the ring */
 static void link_pool_block(struct pool_block *pb)
 {
-  caml_plat_lock(&pool_mutex);
+  caml_plat_lock_blocking(&pool_mutex);
   pb->next = pool->next;
   pb->prev = pool;
   pool->next->prev = pb;
@@ -537,7 +536,7 @@ static void link_pool_block(struct pool_block *pb)
 /* Unlinking a pool block from the ring */
 static void unlink_pool_block(struct pool_block *pb)
 {
-    caml_plat_lock(&pool_mutex);
+    caml_plat_lock_blocking(&pool_mutex);
     pb->prev->next = pb->next;
     pb->next->prev = pb->prev;
     caml_plat_unlock(&pool_mutex);
@@ -546,12 +545,9 @@ static void unlink_pool_block(struct pool_block *pb)
 CAMLexport void caml_stat_create_pool(void)
 {
   if (pool == NULL) {
-    pool = malloc(SIZEOF_POOL_BLOCK);
+    pool = malloc(sizeof(struct pool_block));
     if (pool == NULL)
       caml_fatal_error("Fatal error: out of memory.\n");
-#ifdef DEBUG
-    pool->magic = Debug_pool_magic;
-#endif
     pool->next = pool;
     pool->prev = pool;
   }
@@ -559,12 +555,16 @@ CAMLexport void caml_stat_create_pool(void)
 
 CAMLexport void caml_stat_destroy_pool(void)
 {
-  caml_plat_lock(&pool_mutex);
+  caml_plat_lock_blocking(&pool_mutex);
   if (pool != NULL) {
     pool->prev->next = NULL;
     while (pool != NULL) {
       struct pool_block *next = pool->next;
+#ifdef _WIN32
+      _aligned_free(pool);
+#else
       free(pool);
+#endif
       pool = next;
     }
     pool = NULL;
@@ -579,12 +579,13 @@ CAMLexport caml_stat_block caml_stat_alloc_noexc(asize_t sz)
   if (pool == NULL)
     return malloc(sz);
   else {
-    struct pool_block *pb = malloc(sz + SIZEOF_POOL_BLOCK);
-    if (pb == NULL) return NULL;
-#ifdef DEBUG
-    memset(&(pb->data), Debug_uninit_stat, sz);
-    pb->magic = Debug_pool_magic;
+    struct pool_block *pb;
+#ifdef _WIN32
+    pb = _aligned_malloc(sizeof(struct pool_block) + sz, pool_block_align);
+#else
+    pb = malloc(sizeof(struct pool_block) + sz);
 #endif
+    if (pb == NULL) return NULL;
     link_pool_block(pb);
     return &(pb->data);
   }
@@ -596,7 +597,8 @@ CAMLexport void* caml_stat_alloc_aligned_noexc(asize_t sz, int modulo,
 {
   char *raw_mem;
   uintnat aligned_mem;
-  CAMLassert (0 <= modulo && modulo < Page_size);
+  CAMLassert(0 <= modulo);
+  CAMLassert(modulo < Page_size);
   raw_mem = (char *) caml_stat_alloc_noexc(sz + Page_size);
   if (raw_mem == NULL) return NULL;
   *b = raw_mem;
@@ -604,14 +606,13 @@ CAMLexport void* caml_stat_alloc_aligned_noexc(asize_t sz, int modulo,
   aligned_mem = (((uintnat) raw_mem / Page_size + 1) * Page_size);
 #ifdef DEBUG
   {
-    uintnat *p;
     uintnat *p0 = (void *) *b;
     uintnat *p1 = (void *) (aligned_mem - modulo);
     uintnat *p2 = (void *) (aligned_mem - modulo + sz);
     uintnat *p3 = (void *) ((char *) *b + sz + Page_size);
-    for (p = p0; p < p1; p++) *p = Debug_filler_align;
-    for (p = p1; p < p2; p++) *p = Debug_uninit_align;
-    for (p = p2; p < p3; p++) *p = Debug_filler_align;
+    for (uintnat *p = p0; p < p1; p++) *p = Debug_filler_align;
+    for (uintnat *p = p1; p < p2; p++) *p = Debug_uninit_align;
+    for (uintnat *p = p2; p < p3; p++) *p = Debug_filler_align;
   }
 #endif
   return (char *) (aligned_mem - modulo);
@@ -647,7 +648,11 @@ CAMLexport void caml_stat_free(caml_stat_block b)
     struct pool_block *pb = get_pool_block(b);
     if (pb == NULL) return;
     unlink_pool_block(pb);
+#ifdef _WIN32
+    _aligned_free(pb);
+#else
     free(pb);
+#endif
   }
 }
 
@@ -666,7 +671,12 @@ CAMLexport caml_stat_block caml_stat_resize_noexc(caml_stat_block b, asize_t sz)
        while other domains access the pool concurrently. */
     unlink_pool_block(pb);
     /* Reallocating */
-    pb_new = realloc(pb, sz + SIZEOF_POOL_BLOCK);
+#ifdef _WIN32
+    pb_new = _aligned_realloc(pb, sizeof(struct pool_block) + sz,
+                              pool_block_align);
+#else
+    pb_new = realloc(pb, sizeof(struct pool_block) + sz);
+#endif
     if (pb_new == NULL) {
       /* The old block is still there, relinking it */
       link_pool_block(pb);
@@ -721,13 +731,21 @@ CAMLexport caml_stat_string caml_stat_strdup(const char *s)
 
 #ifdef _WIN32
 
+CAMLexport wchar_t * caml_stat_wcsdup_noexc(const wchar_t *s)
+{
+  size_t slen = wcslen(s);
+  wchar_t* result = caml_stat_alloc_noexc((slen + 1)*sizeof(wchar_t));
+  if (result == NULL)
+    return NULL;
+  memcpy(result, s, (slen + 1)*sizeof(wchar_t));
+  return result;
+}
+
 CAMLexport wchar_t * caml_stat_wcsdup(const wchar_t *s)
 {
-  int slen = wcslen(s);
-  wchar_t* result = caml_stat_alloc((slen + 1)*sizeof(wchar_t));
+  wchar_t* result = caml_stat_wcsdup_noexc(s);
   if (result == NULL)
     caml_raise_out_of_memory();
-  memcpy(result, s, (slen + 1)*sizeof(wchar_t));
   return result;
 }
 
@@ -738,10 +756,9 @@ CAMLexport caml_stat_string caml_stat_strconcat(int n, ...)
   va_list args;
   char *result, *p;
   size_t len = 0;
-  int i;
 
   va_start(args, n);
-  for (i = 0; i < n; i++) {
+  for (int i = 0; i < n; i++) {
     const char *s = va_arg(args, const char*);
     len += strlen(s);
   }
@@ -751,7 +768,7 @@ CAMLexport caml_stat_string caml_stat_strconcat(int n, ...)
 
   va_start(args, n);
   p = result;
-  for (i = 0; i < n; i++) {
+  for (int i = 0; i < n; i++) {
     const char *s = va_arg(args, const char*);
     size_t l = strlen(s);
     memcpy(p, s, l);
@@ -770,10 +787,9 @@ CAMLexport wchar_t* caml_stat_wcsconcat(int n, ...)
   va_list args;
   wchar_t *result, *p;
   size_t len = 0;
-  int i;
 
   va_start(args, n);
-  for (i = 0; i < n; i++) {
+  for (int i = 0; i < n; i++) {
     const wchar_t *s = va_arg(args, const wchar_t*);
     len += wcslen(s);
   }
@@ -783,7 +799,7 @@ CAMLexport wchar_t* caml_stat_wcsconcat(int n, ...)
 
   va_start(args, n);
   p = result;
-  for (i = 0; i < n; i++) {
+  for (int i = 0; i < n; i++) {
     const wchar_t *s = va_arg(args, const wchar_t*);
     size_t l = wcslen(s);
     memcpy(p, s, l*sizeof(wchar_t));

diff --git a/runtime/memprof.c b/runtime/memprof.c
index 2cc064b89944cdf623bc1a3954f901d5d2de3a2b..c385c2fd91e65d8e022518446992c5a1ae093bf7 100644 (file)
--- a/runtime/memprof.c
+++ b/runtime/memprof.c
@@ -15,24 +15,545 @@
 
 #define CAML_INTERNALS
 
+#include <math.h>
 #include <stdbool.h>
+#include "caml/alloc.h"
+#include "caml/backtrace.h"
+#include "caml/backtrace_prim.h"
+#include "caml/callback.h"
+#include "caml/fail.h"
+#include "caml/frame_descriptors.h"
 #include "caml/memory.h"
 #include "caml/memprof.h"
+#include "caml/mlvalues.h"
+#include "caml/platform.h"
+#include "caml/runtime_events.h"
+#include "caml/shared_heap.h"
+
+/* Design
+ *
+ * 1. Data Design
+ *
+ * 1.1. Configuration
+ *
+ * A Gc.Memprof.t value (a "profile" from the OCaml point of view) is
+ * a block on the OCaml heap containing the profile configuration. As
+ * a profile may be shared between threads and domains, keeping it on
+ * the OCaml heap allows us not to worry about its liveness - pointers
+ * to it from memprof data structures are simply treated as GC roots.
+ * The "status" field in this object allows distinct domains to safely
+ * `stop` and `discard` (with atomic reads and writes).
+ *
+ * 1.2. Entries
+ *
+ * Each block of memory tracked by memprof is represented by an
+ * "entry" structure (entry_s, *entry_t). It tracks the state of the
+ * block of memory, and its progress through the various callbacks.
+ *
+ * A resizable table of entry structures is called an "entries" table
+ * (entries_s, *entries_t). It tracks ranges of those entries which
+ * may (a) be ripe for running a callback, (b) be marked for deletion,
+ * or (c) contain pointers to the minor heap (to be scanned in a minor
+ * collection). As processing each of these actions proceeds linearly
+ * through the table, this tracking is done simply by keeping the
+ * lowest possible entry index for each purpose. The code to perform
+ * each action (running a callback, evicting a deleted entry, or
+ * scanning a pointer) checks whether an entry does require the action
+ * before performing it.
+ *
+ * The entries table also has a pointer to the configuration object on
+ * the OCaml heap, for the profile under which all the entries in the
+ * table were sampled. This allows callbacks on the table to be run at
+ * any later time, regardless of the currently-sampling profile of the
+ * particular domain running the callback. A consequence is that all
+ * entries in a table must be from the same profile.
+ *
+ * After a profile is "discarded", entries may still exist for blocks
+ * allocated in that profile, but no callbacks will be called for it
+ * (those entries themselves will be discarded lazily).
+ *
+ * There is code for iterating over entries in a table, which is used
+ * when scanning for GC roots or updating tables to reflect GC activity
+ * (see below).
+ *
+ * 1.3. Threads
+ *
+ * The memprof state of a particular systhread is a "thread state"
+ * (memprof_thread_s, *memprof_thread_t). It has an entries table, for
+ * blocks allocated by this thread whose allocation callback has not
+ * yet completed. All allocation callbacks are guaranteed to be called
+ * by the thread performing the allocation (in the rare circumstance in
+ * which this is impossible, the tracking entry is discarded).
+ *
+ * This thread state structure exists whether or not the systhreads
+ * module is initialized (one thread state per domain), and whether or
+ * not memprof is running.
+ *
+ * 1.4. Domains
+ *
+ * The memprof state of a domain is a "domain state"
+ * (memprof_domain_s, *memprof_domain_t). It has an entries table, for
+ * blocks allocated in this domain whose allocation callbacks have
+ * completed. If a domain terminates, or starts a new profile, while
+ * it still has tracked entries from a previous profile, those tracked
+ * entries become "orphaned" (see below).
+ *
+ * The domain state has a linked list of thread states for all the
+ * threads in the domain, and a pointer to the current thread state.
+ *
+ * This structure exists whether or not memprof is running. A pointer
+ * to it is kept in the caml_domain_state.
+ *
+ * 1.5. Orphans
+ *
+ * When sampling is stopped for a profile, all domains and threads
+ * continue to manage the entry tables for it as before, but without
+ * sampling and creating new entries. However, if a domain _starts_ a
+ * profile while it has entries (tracked blocks) from a previous
+ * profile which has not been "discarded", it moves those entries to
+ * its "orphans" list - a linked list of entry tables - for subsequent
+ * processing.
+ *
+ * If a domain is terminated, all its current and orphaned entries
+ * (and those of its threads) are moved to a global `orphans`
+ * list. This list, and its protective lock `orphans_lock`, are the
+ * only memprof global variables. No domain processes the entries in
+ * the global orphans list directly: the first domain to look at the
+ * list (either at a collection or when checking for pending
+ * callbacks) adopts all entry tables on it into its own orphans list,
+ * and then processes them as its own.
+ *
+ * 2. Synchronisation
+ *
+ * Mostly threads and domains are free to run callbacks on their own
+ * allocated blocks without explicitly synchronising. Care is taken
+ * not to assume that the memprof state of any given thread or entry
+ * in a domain is preserved outside of memprof code, as another thread
+ * in the same domain may run and modify that state, but we assume
+ * that the systhreads module effectively serializes entries to
+ * memprof within a single domain (for these purposes, entering and
+ * returning from a callback is treated as leaving and re-entering
+ * memprof code).
+ *
+ * However, there are some structures shared between domains. The main
+ * such structure is the profile configuration object on the Caml
+ * heap. The only field written in this object is the status field,
+ * used to communicate between domains sharing the profile, when a
+ * profile is stopped or discarded. This field is inspected or set
+ * atomically by the `Status` and `Set_status` macros. If a profile is
+ * found to be discarded (`CONFIG_STATUS_DISCARDED`) then no domain
+ * need take any action on it (and we can lazily discard any state
+ * from it).
+ *
+ * The only other data shared between domains is the global orphans
+ * list. As noted above, this is protected by a single global lock,
+ * `orphans_lock`. Because an entry table only gets onto the global
+ * orphans list when its owning domain terminates (at which point all
+ * threads of that domain have terminated), and a table is adopted
+ * from the global orphans list before being processed, all callbacks
+ * and other entry table processing is performed by a thread of the
+ * domain which owns the entry table. (and actions of those threads
+ * are serialized by `systhreads`).
+ *
+ * 3. Interface with GC
+ *
+ * 3.1. Root scanning
+ *
+ * Memprof may have a large number of strong GC roots: one per tracked
+ * block, pointing to the tracking information ('minor or 'major, in
+ * the Gc.Memprof.tracker sense), plus the pointer to a config block
+ * in every entries table. Rather than manually registering and
+ * deregistering all of these, the GC calls caml_memprof_scan_roots()
+ * to scan them, in either minor or major collections. This function
+ * is called by all domains in parallel. A single domain adopts any
+ * global orphaned entries tables, and then each domain scans its own
+ * roots.
+ *
+ * 3.2. Updating block status.
+ *
+ * After a major or minor GC, memprof has to check tracked blocks to
+ * discover whether they have survived the GC, or (for a minor GC)
+ * whether they have been promoted to the major heap. This is done by
+ * caml_memprof_after_minor_gc() and caml_memprof_after_major_gc(),
+ * which share the system for iterating over entries tables as used by
+ * caml_memprof_scan_roots(). Again, these functions are called by all
+ * domains in parallel; a single domain starts by adopting any global
+ * orphaned entries tables, and then each domain updates its own
+ * entries.
+ *
+ * 3.3. Compaction
+ *
+ * GC compaction may move all objects in the major heap, so all
+ * memprof roots must be scanned and potentially updated, including
+ * the weak roots (i.e. pointers to the tracked blocks). This is done
+ * by the same caml_memprof_scan_roots() function as root scanning in
+ * regular GCs, using a boolean argument to indicate that weak roots
+ * should also be scanned.
+ *
+ * 4. Random Number Generation
+ *
+ * 4.1. Requirements
+ *
+ * We sample every word of allocation with the same probability
+ * (lambda, usually very small) - a Bernoulli trial. For the
+ * allocation of a block on the shared heap, or any allocation from
+ * the C runtime, we need to know how many samples we make of that
+ * block (usually zero). This is a **binomial random variable**,
+ * parameterized by lambda and N (the number of words in the block,
+ * including the header).
+ *
+ * For allocations by Caml on the minor heap, we use the existing GC
+ * trigger mechanism, to cause Caml to enter the runtime when "the
+ * next sample" is due. The amount of allocation before "the next
+ * sample" is a **geometric random variable**, parameterized by
+ * lambda.
+ *
+ * 4.2. Implementation
+ *
+ * We focus on generating geometric pseudo-random numbers (PRNs), and
+ * simulate binomial PRNs for parameters (lambda, N) by counting
+ * geometric PRNs for lambda which sum to no more than N.
+ *
+ * We use a high-quality high-performance 32-bit uniform PRNG
+ * (xoshiro128+), with per-domain state vectors. We initialize the
+ * per-domain state vector with a low-quality PRNG (SplitMX64), seeded
+ * separately for each domain.
+ *
+ * To convert from a uniform PRN `u` to a geometric PRN `g`, we compute
+ *
+ *          g = floor(1 + log(u) / log(1-lambda))
+ *
+ * where we treat u as uniformly distributed in [0,1]. We pre-compute
+ * 1/log(1-lambda) (called `one_log1m_lambda` here), and compute
+ * log(u) using a combination of type punning and a 3rd-degree
+ * polynomial (see `log_approx()`).
+ *
+ * For further efficiency we generate geometric PRNs in blocks, and
+ * the generating code is designed to be vectorizable.
+ *
+ * 5. Backtraces
+ *
+ * We have to be able to sample the current backtrace at any
+ * allocation point, and pass it (as a Caml array) to the allocation
+ * callback. We assume that in most cases these backtraces have short
+ * lifetimes, so we don't want to allocate them on the shared
+ * heap. However, we can't always allocate them directly on the Caml
+ * minor heap, as some allocations (e.g. allocating in the shared heap
+ * from the runtime) may take place at points at which GC is not safe
+ * (and so minor-heap allocation is not permitted).  In those cases we
+ * "stash" the backtrace on the C heap, and copy it onto the Caml heap
+ * when we are about to call the allocation callback.
+ *
+ * 6. Sampling
+ *
+ * We sample allocation for all threads in a domain which has a
+ * currently sampling profile, except when such a thread is running a
+ * memprof callback, which "suspends" sampling on that thread.
+ *
+ * Allocation sampling divides into two cases: one simple and one
+ * complex.
+ *
+ * 6.1. Simple Sampling
+ *
+ * When sampling an allocation by the runtime (as opposed to
+ * allocation by Caml), an entry is added to the thread's entry table,
+ * for subsequent processing. No allocation callback is called at
+ * allocation time, because the heap may not be consistent so
+ * allocation by the callback is not safe (see "Backtraces").
+ *
+ * 6.2. Minor Heap Caml Allocation Sampling
+ *
+ * Caml code allocates on the minor heap by pointer-bumping, and only
+ * drops into the runtime if the `young_ptr` allocation pointer hits
+ * the `young_trigger`, usually triggering a garbage collection. When
+ * profiling, we set the trigger at the next word which we want to
+ * sample (see "Random Number Generation"), thus allowing us to enter
+ * memprof code at the approporiate allocation point. However,
+ * sampling the allocation is more complex in this case for several
+ * reasons:
+ *
+ * - Deferred allocation. A sampled block is not actually allocated
+ *   until the runtime returns to the GC poll point in Caml code,
+ *   after the memprof sampling code has run. So we have to predict
+ *   the address of the sampled block for the entry record, to track
+ *   its future promotion or collection. Until the allocation callback
+ *   has run, instead of the allocated block address, the entry holds
+ *   the offset in words of the block within the combined allocation,
+ *   and the entry's `offset` field is set.
+ *
+ * - Combined allocations. A single GC poll point in Caml code may
+ *   combine the allocation of several distinct blocks, each of which
+ *   may be sampled independently. We create an entry for each sampled
+ *   block and then run all allocation callbacks.
+ *
+ * - Prompt allocation callbacks. We call allocation callbacks
+ *   directly from memprof as we sample the allocated blocks. These
+ *   callbacks could be deferred (as are the ones in the "Simple
+ *   Sampling" case), but that would require twice as many entries
+ *   into memprof code. So the allocation callback is called before
+ *   the sampled block is actually allocated (see above), and several
+ *   allocation callbacks may be called at any given GC poll point
+ *   (due to combined allocations). We take care to arrange heap
+ *   metadata such that it is safe to run allocation callbacks (which
+ *   may allocate and trigger minor and major GCs).
+ *
+ * - Other callbacks. In order to call the allocation callbacks from
+ *   the poll point, we process the thread's entries table. This may
+ *   call other callbacks for the same thread (specifically: deferred
+ *   "Simple Sampling" callbacks).
+ *
+ * - Callback effects. Any callback may raise an exception, stop
+ *   sampling, start a new profile, and/or discard a profile.
+ *
+ *   If a callback raises an exception, none of the allocations from
+ *   the current poll point will take place. However, some allocation
+ *   callbacks may already have been called. If so, we mark those
+ *   entries as "deallocated", so that matching deallocation callbacks
+ *   will run. We simply delete any tracking entry from the current
+ *   poll point which has not yet run an allocation callback. Then we
+ *   propagate the exception up to Caml.
+ *
+ *   If a callback stops sampling, subsequent allocations from the
+ *   current poll point will not be sampled.
+ *
+ *   If a callback stops sampling and starts a new profile, none of
+ *   the allocations from the current poll point are subsequently
+ *   tracked (through promotion and/or deallocation), as it's not
+ *   possible to reconstruct the allocation addresses of the tracking
+ *   entries, so they are simply deleted (or marked as deallocated, as
+ *   in the exceptional case). The new profile effectively begins with
+ *   the following poll point or other allocation.
+ *
+ * Most of this complexity is managed in caml_memprof_sample_young().
+ *
+ * 7. Callbacks
+ *
+ * Some callbacks are run at allocation time, for allocations from
+ * Caml (see under "Sampling" above). Other allocation callbacks, and
+ * all post-allocation callbacks, are run during
+ * `caml_memprof_run_callbacks_res()`, which is called by the
+ * runtime's general pending-action mechanism at poll points.
+ *
+ * We set the domain's action-pending flag when we notice we have
+ * pending callbacks. Caml drops into the runtime at a poll point, and
+ * calls `caml_memprof_run_callbacks_res()`, whenever the
+ * action-pending flag is set, whether or not memprof set it. So
+ * memprof maintains its own per-domain `pending` flag, to avoid
+ * suspending/unsuspending sampling, and checking all the entries
+ * tables, when there are no pending callbacks.
+ *
+ * This is particularly important because when we unsuspend sampling,
+ * we reset the young-limit, which has the side-effect of setting the
+ * domain's action-pending flag. TODO: consider changing
+ * `caml_reset_young_limit` so it doesn't do this.
+ *
+ * Allocation callbacks are always run by the thread which made the
+ * allocation, unless that thread terminates before running the
+ * callback, in which case it is inherited by the domain.
+ *
+ * Callbacks are run by iterating through candidate entries in a entry
+ * table. See under "Entries" above. A single entry may have more than
+ * one callback to run (if, for example, it has been promoted *and*
+ * garbage collected since the last time callbacks for that entry were
+ * run) - they are run in the natural order.
+ */
 
-/* type aliases for the hierarchy of structures for managing memprof status. */
+/* number of random variables in a batch */
+#define RAND_BLOCK_SIZE 64
+
+/* type aliases for the hierarchy of structures for managing memprof status */
 
+typedef struct entry_s entry_s, *entry_t;
+typedef struct entries_s entries_s, *entries_t;
 typedef struct memprof_domain_s memprof_domain_s, *memprof_domain_t;
 typedef struct memprof_thread_s memprof_thread_s, *memprof_thread_t;
+typedef struct memprof_orphan_table_s memprof_orphan_table_s,
+  *memprof_orphan_table_t;
+
+/* A memprof configuration is held in an object on the Caml heap, of
+ * type Gc.Memprof.t. Here we define getter macros for each field, and
+ * a setter macro for the status field (which is updated). */
+
+#define CONFIG_FIELDS 9
+
+#define CONFIG_FIELD_STATUS        0
+#define CONFIG_FIELD_LAMBDA        1
+#define CONFIG_FIELD_1LOG1ML       2
+#define CONFIG_FIELD_STACK_FRAMES  3
+#define CONFIG_FIELD_ALLOC_MINOR   4
+#define CONFIG_FIELD_ALLOC_MAJOR   5
+#define CONFIG_FIELD_PROMOTE       6
+#define CONFIG_FIELD_DEALLOC_MINOR 7
+#define CONFIG_FIELD_DEALLOC_MAJOR 8
+
+#define CONFIG_FIELD_FIRST_CALLBACK CONFIG_FIELD_ALLOC_MINOR
+#define CONFIG_FIELD_LAST_CALLBACK CONFIG_FIELD_DEALLOC_MAJOR
+
+#define CONFIG_STATUS_SAMPLING 0
+#define CONFIG_STATUS_STOPPED 1
+#define CONFIG_STATUS_DISCARDED 2
+
+#define CONFIG_NONE Val_unit
+
+#define Status(config)          Int_val(Field(config, CONFIG_FIELD_STATUS))
+#define Sampling(config)        ((config != CONFIG_NONE) && \
+                                 (Status(config) == CONFIG_STATUS_SAMPLING))
+
+/* The 'status' field is the only one we ever update. */
+
+#define Set_status(config, stat) \
+  Store_field(config, CONFIG_FIELD_STATUS, Val_int(stat))
+
+/* lambda: the fraction of allocated words to sample.  0 <= lambda <= 1 */
+#define Lambda(config) \
+  Double_val(Field(config, CONFIG_FIELD_LAMBDA))
+
+/* 1/ln(1-lambda), pre-computed for use in the geometric RNG */
+#define One_log1m_lambda(config) \
+  Double_val(Field(config, CONFIG_FIELD_1LOG1ML))
+
+/* If lambda is zero or very small, computing one_log1m_lambda
+ * underflows.  It should always be treated as negative infinity in
+ * that case, (effectively turning sampling off). */
+#define MIN_ONE_LOG1M_LAMBDA (-INFINITY)
+
+#define Min_lambda(config) \
+  (One_log1m_lambda(config) == MIN_ONE_LOG1M_LAMBDA)
+
+/* The number of stack frames to record for each allocation site */
+#define Callstack_size(config) \
+  Int_val(Field(config, CONFIG_FIELD_STACK_FRAMES))
+
+/* callbacks */
+#define Alloc_minor(config)   Field(config, CONFIG_FIELD_ALLOC_MINOR)
+#define Alloc_major(config)   Field(config, CONFIG_FIELD_ALLOC_MAJOR)
+#define Promote(config)       Field(config, CONFIG_FIELD_PROMOTE)
+#define Dealloc_minor(config) Field(config, CONFIG_FIELD_DEALLOC_MINOR)
+#define Dealloc_major(config) Field(config, CONFIG_FIELD_DEALLOC_MAJOR)
+
+/* Callback indexes. "Major" and "minor" are not distinguished here. */
+
+#define CB_NONE          0
+#define CB_ALLOC         1
+#define CB_PROMOTE       2
+#define CB_DEALLOC       3
+
+/* Maximum value of a callback index */
+#define CB_MAX           CB_DEALLOC
+
+/* How many bits required for a callback index */
+#define CB_BITS          2
+
+/* the mask for a given callback index */
+#define CB_MASK(cb) (1 << ((cb) - 1))
+
+/* Structure for each tracked allocation. Six words (with many spare
+ * bits in the final word). */
+
+struct entry_s {
+  /* Memory block being sampled. This is a weak GC root. Note that
+   * during the allocation callback of a block allocated directly by OCaml,
+   * this may be a comballoc offset (and the `offset` flag set). */
+  value block;
+
+  /* The value returned by the previous callback for this block, or
+   * the callstack (as a value-tagged pointer to the C heap) if the
+   * alloc callback has not been called yet.  This is a strong GC
+   * root. */
+  value user_data;
+
+  /* Number of samples in this block. */
+  size_t samples;
+
+  /* The size of this block, in words (not including the header). */
+  size_t wosize;
+
+  /* The thread currently running a callback for this entry,
+   * or NULL if there is none */
+  memprof_thread_t runner;
+
+  /* The source of the allocation: normal allocations, interning,
+   * or custom_mem (CAML_MEMPROF_SRC_*). */
+  unsigned int source : 2;
+
+  /* Is `block` actually an offset? */
+  bool offset : 1;
+
+  /* Was this block initially allocated in the minor heap? */
+  bool alloc_young : 1;
+
+  /* Has this block been promoted? Implies [alloc_young]. */
+  bool promoted : 1;
+
+  /* Has this block been deallocated? */
+  bool deallocated : 1;
+
+  /* Has this entry been marked for deletion. */
+  bool deleted : 1;
+
+  /* Which callback (CB_*) is currently running for this entry.
+   * Useful when debugging. */
+  unsigned int callback : CB_BITS;
+
+  /* A mask of callbacks (1 << (CB_* - 1)) which have been called (not
+   * necessarily completed) for this entry. */
+  unsigned int callbacks : CB_MAX;
+
+  /* There are a number of spare bits here for future expansion,
+   * without increasing the size of an entry */
+};
+
+/* A resizable array of entry_s entries. */
+
+struct entries_s {
+  entry_t t; /* Pointer to array of entry_s structures */
+  size_t min_capacity, capacity, size; /* array allocation management */
+
+  /* Before this position, the [block] and [user_data] fields both
+   * point to the major heap ([young <= size]). */
+  size_t young;
+
+  /* There are no blocks to be evicted before this position
+   * ([evict <= size]). */
+  size_t evict;
+
+  /* There are no pending callbacks before this position
+   * ([active <= size]). */
+  size_t active;
+
+  /* The profiling configuration under which these blocks were
+   * allocated. A strong GC root. */
+  value config;
+};
 
 /* Per-thread memprof state. */
 
+/* Minimum capacity of a per-thread entries array */
+#define MIN_ENTRIES_THREAD_CAPACITY 16
+
+/* Minimum capacity of a per-domain entries array */
+#define MIN_ENTRIES_DOMAIN_CAPACITY 128
+
+/* Minimum capacity of an orphaned entries array */
+#define MIN_ENTRIES_ORPHAN_CAPACITY 16
+
 struct memprof_thread_s {
   /* [suspended] is used for inhibiting memprof callbacks when
      a callback is running or when an uncaught exception handler is
      called. */
   bool suspended;
 
-  /* TODO: More fields to add here */
+  /* The index of the entry in `running_table` for which this thread is
+   * currently in a callback */
+  size_t running_index;
+
+  /* Pointer to entries table for the current callback, or NULL if not
+   * currently running a callback. */
+  entries_t running_table;
+
+  /* Entries for blocks allocated in this thread whose alloc callback
+   * has not yet been called. */
+  entries_s entries;
 
   /* Per-domain memprof information */
   memprof_domain_t domain;
@@ -42,1290 +563,1768 @@ struct memprof_thread_s {
   memprof_thread_t next;
 };
 
-/* A memprof configuration is held in an object on the Caml
- * heap. These are getter macros for each field. */
-
-#define Stopped(config)          Bool_val(Field(config, 0))
-#define Running(config)          ((config != Val_unit) && !Stopped(config))
-#define Lambda(config)           Double_val(Field(config, 1))
-#define One_log1m_lambda(config) Double_val(Field(config, 2))
-#define Callstack_size(config)   Int_val(Field(config, 3)
-#define Alloc_minor(config)      Field(config, 4)
-#define Alloc_major(config)      Field(config, 5)
-#define Promote(config)          Field(config, 6)
-#define Dealloc_minor(config)    Field(config, 7)
-#define Dealloc_major(config)    Field(config, 8)
-
-/* The 'stopped' field is the only one we ever update. */
-
-#define Set_stopped(config, flag) (Field(config, 0) = Val_bool(flag))
-
 /* Per-domain memprof state */
 
 struct memprof_domain_s {
   /* The owning domain */
   caml_domain_state *caml_state;
 
+  /* Tracking entries for this domain. In the usual case these are
+   * entries allocated by a thread in this domain for which the
+   * allocation callback has returned: the entry is then transferred
+   * to this per-domain table. However, this table will also include
+   * entries for threads in this domain which terminated before
+   * calling the allocation callback.  entries.config is the current
+   * memprof configuration for this domain. */
+  entries_s entries;
+
+  /* Orphaned entries - either from previous profiles run in this
+   * domain or adopted from terminated domains. */
+  memprof_orphan_table_t orphans;
+
+  /* true if there may be callbacks to be processed on the orphans list. */
+  bool orphans_pending;
+
+  /* true if there may be any callbacks pending for this domain */
+  bool pending;
+
   /* Linked list of threads in this domain */
   memprof_thread_t threads;
 
-  /* The current thread's memprof state. Note that there may not be a
-     "current thread". TODO: maybe this shouldn't be nullable.
-     Nullability costs us some effort and may be meaningless. See call
-     site of caml_memprof_leave_thread() in st_stubs.c. */
+  /* The current thread's memprof state. */
   memprof_thread_t current;
 
-  /* TODO: More fields to add here */
+  /* Buffer used to compute backtraces */
+  backtrace_slot *callstack_buffer;
+  size_t callstack_buffer_len;
 
-  /* The current profiling configuration for this domain. */
-  value config;
+  /* ---- random number generation state ---- */
+
+  /* RAND_BLOCK_SIZE separate xoshiro+128 state vectors, defined in this
+   * column-major order so that SIMD-aware compilers can parallelize the
+   * algorithm. */
+  uint32_t xoshiro_state[4][RAND_BLOCK_SIZE];
+
+  /* Array of computed geometric random variables */
+  uintnat rand_geom_buff[RAND_BLOCK_SIZE];
+  uint32_t rand_pos;
+
+  /* Surplus amount of the current sampling distance, not consumed by
+   * previous allocations. Still a legitimate sample of a geometric
+   * random variable. */
+  uintnat next_rand_geom;
 };
 
-/**** Create and destroy thread state structures ****/
+struct memprof_orphan_table_s {
+  /* An orphaned entries table */
+  entries_s entries;
 
-static memprof_thread_t thread_create(memprof_domain_t domain)
-{
-  memprof_thread_t thread = caml_stat_alloc(sizeof(memprof_thread_s));
-  if (!thread) {
-    return NULL;
-  }
-  thread->suspended = false;
+  /* next orphaned table in a linked list. */
+  memprof_orphan_table_t next;
+};
 
-  /* attach to domain record */
-  thread->domain = domain;
-  thread->next = domain->threads;
-  domain->threads = thread;
+/* List of orphaned entry tables not yet adopted by any domain. */
+static memprof_orphan_table_t orphans = NULL;
 
-  return thread;
+/* lock controlling access to `orphans` and writes to `orphans_present` */
+static caml_plat_mutex orphans_lock = CAML_PLAT_MUTEX_INITIALIZER;
+
+/* Flag indicating non-NULL orphans. Only modified when holding orphans_lock. */
+static atomic_uintnat orphans_present;
+
+/**** Initializing and clearing entries tables ****/
+
+static void entries_init(entries_t es, size_t min_capacity, value config)
+{
+  es->t = NULL;
+  es->min_capacity = min_capacity;
+  es->capacity = es->size = es->young = es->evict = es->active = 0;
+  es->config = config;
 }
 
-static void thread_destroy(memprof_thread_t thread)
+static void entries_clear(entries_t es)
 {
-  memprof_domain_t domain = thread->domain;
+  if (es->t) {
+    caml_stat_free(es->t);
+    es->t = NULL;
+  }
+  es->capacity = es->size = es->young = es->evict = es->active = 0;
+  es->config = CONFIG_NONE;
+}
 
-  if (domain->current == thread) {
-    domain->current = NULL;
+/**** Managing entries. ****/
+
+/* When an entries table needs to grow, grow it by this factor */
+#define ENTRIES_GROWTH_FACTOR 2
+
+/* Do not shrink an entries table until it is this much too large */
+#define ENTRIES_SHRINK_FACTOR 4
+
+/* Reallocate the [es] entries table if it is either too small or too
+ * large. [grow] is the number of free cells needed.
+ * Returns false if reallocation was necessary but failed, and truer
+ * otherwise. */
+
+static bool entries_ensure(entries_t es, size_t grow)
+{
+  if (es->capacity == 0 && grow == 0) {
+    /* Don't want min_capacity for an unused table. */
+    return true;
   }
-  /* remove thread from the per-domain list. Could go faster if we
-   * used a doubly-linked list, but that's premature optimisation
-   * at this point. */
-  memprof_thread_t *p = &domain->threads;
-  while (*p != thread) {
-    p = &(*p)->next;
+  size_t new_size = es->size + grow;
+  if (new_size <= es->capacity &&
+     (ENTRIES_SHRINK_FACTOR * new_size >= es->capacity ||
+      es->capacity == es->min_capacity)) {
+    /* No need to grow or shrink */
+    return true;
   }
+  size_t new_capacity = new_size * ENTRIES_GROWTH_FACTOR;
+  if (new_capacity < es->min_capacity)
+    new_capacity = es->min_capacity;
+  entry_t new_t = caml_stat_resize_noexc(es->t, new_capacity * sizeof(entry_s));
+  if (new_t == NULL) return false;
+  es->t = new_t;
+  es->capacity = new_capacity;
+  return true;
+}
 
-  *p = thread->next;
+#define Invalid_index (~(size_t)0)
 
-  caml_stat_free(thread);
+/* Create and initialize a new entry in an entries table, and return
+ * its index (or Invalid_index if allocation fails). */
+
+Caml_inline size_t new_entry(entries_t es,
+                             value block, value user_data,
+                             size_t wosize, size_t samples,
+                             int source, bool is_young,
+                             bool offset)
+{
+  if (!entries_ensure(es, 1))
+    return Invalid_index;
+  size_t i = es->size ++;
+  entry_t e = es->t + i;
+  e->block = block;
+  e->user_data = user_data;
+  e->samples = samples;
+  e->wosize = wosize;
+  e->runner = NULL;
+  e->source = source;
+  e->offset = offset;
+  e->alloc_young = is_young;
+  e->promoted = false;
+  e->deallocated = false;
+  e->deleted = false;
+  e->callback = CB_NONE;
+  e->callbacks = 0;
+  return i;
 }
 
-/**** Create and destroy domain state structures ****/
+/* Mark a given entry in an entries table as "deleted". Do not call on
+ * an entry with a currently-running callback. */
 
-static void domain_destroy(memprof_domain_t domain)
+static void entry_delete(entries_t es, size_t i)
 {
-  memprof_thread_t thread = domain->threads;
-  while (thread) {
-    memprof_thread_t next = thread->next;
-    thread_destroy(thread);
-    thread = next;
+  entry_t e = &es->t[i];
+
+  CAMLassert(!e->runner);
+
+  e->deleted = true;
+  e->offset = false;
+  e->user_data = Val_unit;
+  e->block = Val_unit;
+  if (i < es->evict) es->evict = i;
+}
+
+/* Remove any deleted entries from [es], updating [es->young] and
+ * [es->active] if necessary. */
+
+static void entries_evict(entries_t es)
+{
+  size_t i, j;
+
+  /* The obvious linear compaction algorithm */
+  j = i = es->evict;
+
+  while (i < es->size) {
+    if (!es->t[i].deleted) { /* keep this entry */
+      if (i != j) {
+        es->t[j] = es->t[i];
+        if (es->t[i].runner) {
+          memprof_thread_t runner = es->t[i].runner;
+          CAMLassert(runner->running_table == es);
+          CAMLassert(runner->running_index == i);
+          runner->running_index = j;
+        }
+      }
+      ++ j;
+    }
+    ++ i;
+    if (es->young == i) es->young = j;
+    if (es->active == i) es->active = j;
   }
+  es->evict = es->size = j;
+  CAMLassert(es->active <= es->size);
+  CAMLassert(es->young <= es->size);
 
-  caml_stat_free(domain);
+  entries_ensure(es, 0);
 }
 
-static memprof_domain_t domain_create(caml_domain_state *caml_state)
+/* Remove any offset entries from [es]. Ones which have completed an
+ * allocation callback but not a deallocation callback are marked as
+ * deallocated. Others are marked as deleted.
+ *
+ * This is called before moving entries from a thread's entries table
+ * to that of the domain, when we're about to orphan all the domain's
+ * entries. This can occur if we stop a profile and start another one
+ * during an allocation callback (either directly in the callback or
+ * on another thread while the callback is running). We'll never be
+ * able to connect an offset entry to its allocated block (the block
+ * will not be actually allocated until the callback completes, if at
+ * all), but some callbacks may already have been run for it. If no
+ * callbacks have been run, we simply mark the entry as deleted. If
+ * the allocation callback has been run, the best we can do is
+ * probably to fake deallocating the block, so that alloc/dealloc
+ * callback counts correspond.
+ *
+ * Note: no callbacks apart from the allocation callback can run on an
+ * offset entry (as the block has not yet been allocated, it cannot be
+ * promoted or deallocated). */
+
+static void entries_clear_offsets(entries_t es)
 {
-  memprof_domain_t domain = caml_stat_alloc(sizeof(memprof_domain_s));
-  if (!domain) {
-    return NULL;
+  for (size_t i = 0; i < es->size; ++i) {
+    entry_t e = &es->t[i];
+    if (e->offset) {
+      if (e->callbacks & CB_MASK(CB_ALLOC)) {
+        /* Have called just the allocation callback */
+        CAMLassert(e->callbacks == CB_MASK(CB_ALLOC));
+        e->block = Val_unit;
+        e->offset = false;
+        e->deallocated = true;
+        if (i < es->active) es->active = i;
+      } else {
+        /* Haven't yet called any callbacks */
+        CAMLassert(e->runner == NULL);
+        CAMLassert(e->callbacks == 0);
+        entry_delete(es, i);
+      }
+    }
   }
+  entries_evict(es);
+}
 
-  domain->caml_state = caml_state;
-  domain->threads = NULL;
-  domain->current = NULL;
-  domain->config = Val_unit;
+/* Remove any entries from [es] which are not currently running a
+ * callback. */
 
-  /* create initial thread for domain */
-  memprof_thread_t thread = thread_create(domain);
-  if (thread) {
-    domain->current = thread;
-  } else {
-    domain_destroy(domain);
-    domain = NULL;
+static void entries_clear_inactive(entries_t es)
+{
+  CAMLassert (es->config == CONFIG_NONE);
+  for (size_t i = 0; i < es->size; ++i) {
+    if (es->t[i].runner == NULL) {
+      entry_delete(es, i);
+    }
   }
-  return domain;
+  entries_evict(es);
 }
 
-/**** Interface to domain module ***/
+static value validated_config(entries_t es);
 
-void caml_memprof_new_domain(caml_domain_state *parent,
-                             caml_domain_state *child)
+/* Transfer all entries from one entries table to another, excluding
+ * ones which have not run any callbacks (these are deleted).
+ * Return `false` if allocation fails. */
+
+static bool entries_transfer(entries_t from, entries_t to)
 {
-  memprof_domain_t domain = domain_create(child);
+  if (from->size == 0)
+    return true;
 
-  child->memprof = domain;
-  /* domain inherits configuration from parent */
-  if (domain && parent) {
-    domain->config = parent->memprof->config;
+  (void)validated_config(from); /* For side-effect, so we can check ... */
+  (void)validated_config(to);   /* ... that the configs are equal. */
+  CAMLassert(from->config == to->config);
+
+  if (!entries_ensure(to, from->size))
+    return false;
+
+  size_t delta = to->size;
+  to->size += from->size;
+
+  for (size_t i = 0; i < from->size; ++i) {
+    if (from->t[i].callbacks == 0) {
+      /* Very rare: transferring an entry which hasn't called its
+       * allocation callback. We just delete it. */
+      entry_delete(from, i);
+    }
+    to->t[i + delta] = from->t[i];
+    memprof_thread_t runner = from->t[i].runner;
+    if (runner) { /* unusual */
+      CAMLassert(runner->running_table == from);
+      CAMLassert(runner->running_index == i);
+      runner->running_table = to;
+      runner->running_index = i + delta;
+    }
+  }
+
+  if (to->young == delta) {
+    to->young = from->young + delta;
   }
+  if (to->evict == delta) {
+    to->evict = from->evict + delta;
+  }
+  if (to->active == delta) {
+    to->active = from->active + delta;
+  }
+  /* Reset `from` to empty, and allow it to shrink */
+  from->young = from->evict = from->active = from->size = 0;
+  entries_ensure(from, 0);
+  return true;
 }
 
-void caml_memprof_delete_domain(caml_domain_state *state)
+/* If es->config points to a DISCARDED configuration, update
+ * es->config to CONFIG_NONE. Return es->config. */
+
+static value validated_config(entries_t es)
 {
-  if (!state->memprof) {
-    return;
+  if ((es->config != CONFIG_NONE) &&
+      (Status(es->config) == CONFIG_STATUS_DISCARDED)) {
+    es->config = CONFIG_NONE;
+    entries_clear_inactive(es);
   }
-  domain_destroy(state->memprof);
-  state->memprof = NULL;
+  return es->config;
 }
 
-/**** Interface with domain action-pending flag ****/
+/* Return current sampling configuration for a thread. If it's been
+ * discarded, then reset it to CONFIG_NONE and return that. */
+
+static value thread_config(memprof_thread_t thread)
+{
+  return validated_config(&thread->entries);
+}
 
-/* If profiling is active in the current domain, and we may have some
- * callbacks pending, set the action pending flag. */
+/*** Create and destroy orphan tables ***/
 
-static void set_action_pending_as_needed(memprof_domain_t domain)
+/* Orphan any surviving entries from a domain or its threads (after
+ * first discarding any deleted and offset entries), onto the domain's
+ * orphans list. This copies the domain's table itself, to avoid
+ * copying the potentially live array.
+ *
+ * Returns false if allocation fails, true otherwise. */
+
+static bool orphans_create(memprof_domain_t domain)
 {
-  /* if (condition) caml_set_action_pending(domain->caml_state); */
+  /* Clear offset entries and count survivors in threads tables. */
+  size_t total_size = 0;
+  memprof_thread_t thread = domain->threads;
+  while (thread) {
+    entries_clear_offsets(&thread->entries);
+    total_size += thread->entries.size;
+    thread = thread->next;
+  }
+  entries_t es = &domain->entries;
+  entries_evict(es); /* remove deleted entries */
+  total_size += es->size;
+
+  if (!total_size) /* No entries to orphan */
+    return true;
+
+  memprof_orphan_table_t ot = caml_stat_alloc(sizeof(memprof_orphan_table_s));
+  if (!ot)
+    return false;
+
+  entries_init(&ot->entries, MIN_ENTRIES_ORPHAN_CAPACITY,
+               domain->entries.config);
+  if (!entries_ensure(&ot->entries, total_size)) {
+    /* Couldn't allocate entries table - failure */
+    caml_stat_free(ot);
+    return false;
+  }
+
+  /* Orphan surviving entries; these transfers will succeed
+   * because we pre-sized the table. */
+  (void)entries_transfer(&domain->entries, &ot->entries);
+  thread = domain->threads;
+  while(thread) {
+    /* May discard entries which haven't run allocation callbacks */
+    (void)entries_transfer(&thread->entries, &ot->entries);
+    thread = thread->next;
+  }
+  ot->next = domain->orphans;
+  domain->orphans = ot;
+  return true;
 }
 
-/* Set the suspended flag on `domain` to `s`. */
+/* Abandon all a domain's orphans to the global list. */
 
-static void update_suspended(memprof_domain_t domain, bool s)
+static void orphans_abandon(memprof_domain_t domain)
 {
-  if (domain->current) {
-    domain->current->suspended = s;
+  /* Find the end of the domain's orphans list */
+  memprof_orphan_table_t ot = domain->orphans;
+  if (!ot)
+    return;
+
+  while(ot->next) {
+    ot = ot->next;
   }
-  caml_memprof_renew_minor_sample(domain->caml_state);
-  if (!s) set_action_pending_as_needed(domain);
+
+  caml_plat_lock_blocking(&orphans_lock);
+  ot->next = orphans;
+  orphans = domain->orphans;
+  atomic_store_release(&orphans_present, 1);
+  caml_plat_unlock(&orphans_lock);
+  domain->orphans = NULL;
 }
 
-/* Set the suspended flag on the current domain to `s`. */
+/* Adopt all global orphans to the given domain. */
 
-void caml_memprof_update_suspended(bool s) {
-  update_suspended(Caml_state->memprof, s);
+static void orphans_adopt(memprof_domain_t domain)
+{
+  if (!atomic_load_acquire(&orphans_present))
+    return; /* No orphans to adopt */
+
+  /* Find the end of the domain's orphans list */
+  memprof_orphan_table_t *p = &domain->orphans;
+  while(*p) {
+    p = &(*p)->next;
+  }
+
+  caml_plat_lock_blocking(&orphans_lock);
+  if (orphans) {
+    *p = orphans;
+    orphans = NULL;
+    atomic_store_release(&orphans_present, 0);
+  }
+  caml_plat_unlock(&orphans_lock);
 }
 
-/**** Sampling procedures ****/
+/* Destroy an orphan table. */
 
-Caml_inline bool running(memprof_domain_t domain)
+static void orphans_destroy(memprof_orphan_table_t ot)
 {
-  memprof_thread_t thread = domain->current;
+  entries_clear(&ot->entries);
+  caml_stat_free(ot);
+}
 
-  if (thread && !thread->suspended) {
-    value config = domain->config;
-    return Running(config);
+/* Traverse a domain's orphans list, clearing inactive entries from
+ * discarded tables and removing any table which is empty, and update
+ * the orphans_pending flag. */
+
+static void orphans_update_pending(memprof_domain_t domain)
+{
+  memprof_orphan_table_t *p = &domain->orphans;
+  bool pending = false;
+
+  while(*p) {
+    memprof_orphan_table_t ot = *p;
+    memprof_orphan_table_t next = ot->next;
+    value config = validated_config(&ot->entries);
+    if (config == CONFIG_NONE) { /* remove inactive entries */
+      entries_clear_inactive(&ot->entries);
+    }
+    if (ot->entries.size == 0) {
+      orphans_destroy(ot);
+      *p = next;
+    } else { /* any pending entries in this table? */
+      pending |= (ot->entries.active < ot->entries.size);
+      p = &ot->next;
+    }
   }
-  return false;
+  domain->orphans_pending = pending;
 }
 
-/* Renew the next sample in a domain's minor heap. Could race with
- * sampling and profile-stopping code, so do not call from another
- * domain unless the world is stopped. Must be called after each minor
- * sample and after each minor collection. In practice, this is called
- * at each minor sample, at each minor collection, and when sampling
- * is suspended and unsuspended. Extra calls do not change the
- * statistical properties of the sampling because of the
- * memorylessness of the geometric distribution. */
+/**** Statistical sampling ****/
+
+/* We use a low-quality SplitMix64 PRNG to initialize state vectors
+ * for a high-quality high-performance 32-bit PRNG (xoshiro128+). That
+ * PRNG generates uniform random 32-bit numbers, which we use in turn
+ * to generate geometric random numbers parameterized by [lambda].
+ * This is all coded in such a way that compilers can readily use SIMD
+ * optimisations. */
+
+/* splitmix64 PRNG, used to initialize the xoshiro+128 state
+ * vectors. Closely based on the public-domain implementation
+ * by Sebastiano Vigna https://xorshift.di.unimi.it/splitmix64.c */
 
-void caml_memprof_renew_minor_sample(caml_domain_state *state)
+Caml_inline uint64_t splitmix64_next(uint64_t* x)
 {
-  memprof_domain_t domain = state->memprof;
-  value *trigger = state->young_start;
-  if (running(domain)) {
-    /* set trigger based on geometric distribution */
+  uint64_t z = (*x += 0x9E3779B97F4A7C15ull);
+  z = (z ^ (z >> 30)) * 0xBF58476D1CE4E5B9ull;
+  z = (z ^ (z >> 27)) * 0x94D049BB133111EBull;
+  return z ^ (z >> 31);
+}
+
+/* Initialize all the xoshiro+128 state vectors. */
+
+static void xoshiro_init(memprof_domain_t domain, uint64_t seed)
+{
+  uint64_t splitmix64_state = seed;
+  for (int i = 0; i < RAND_BLOCK_SIZE; i++) {
+    uint64_t t = splitmix64_next(&splitmix64_state);
+    domain->xoshiro_state[0][i] = t & 0xFFFFFFFF;
+    domain->xoshiro_state[1][i] = t >> 32;
+    t = splitmix64_next(&splitmix64_state);
+    domain->xoshiro_state[2][i] = t & 0xFFFFFFFF;
+    domain->xoshiro_state[3][i] = t >> 32;
   }
-  CAMLassert((trigger >= state->young_start) &&
-             (trigger <= state->young_ptr));
-  state->memprof_young_trigger = trigger;
-  caml_reset_young_limit(state);
 }
 
-/**** Interface with systhread. ****/
+/* xoshiro128+ PRNG. See Blackman & Vigna; "Scrambled linear
+ * pseudorandom number generators"; ACM Trans. Math. Softw., 47:1-32,
+ * 2021:
+ * "xoshiro128+ is our choice for 32-bit floating-point generation." */
 
-CAMLexport memprof_thread_t caml_memprof_new_thread(caml_domain_state *state)
+Caml_inline uint32_t xoshiro_next(memprof_domain_t domain, int i)
 {
-  return thread_create(state->memprof);
+  uint32_t res = domain->xoshiro_state[0][i] + domain->xoshiro_state[3][i];
+  uint32_t t = domain->xoshiro_state[1][i] << 9;
+  domain->xoshiro_state[2][i] ^= domain->xoshiro_state[0][i];
+  domain->xoshiro_state[3][i] ^= domain->xoshiro_state[1][i];
+  domain->xoshiro_state[1][i] ^= domain->xoshiro_state[2][i];
+  domain->xoshiro_state[0][i] ^= domain->xoshiro_state[3][i];
+  domain->xoshiro_state[2][i] ^= t;
+  t = domain->xoshiro_state[3][i];
+  domain->xoshiro_state[3][i] = (t << 11) | (t >> 21);
+  return res;
 }
 
-CAMLexport memprof_thread_t caml_memprof_main_thread(caml_domain_state *state)
+/* Computes [log((y+0.5)/2^32)], up to a relatively good precision,
+ * and guarantee that the result is negative, in such a way that SIMD
+ * can parallelize it. The average absolute error is very close to
+ * 0.
+ *
+ * Uses a type pun to break y+0.5 into biased exponent `exp` (an
+ * integer-valued float in the range [126, 159]) and mantissa `x` (a
+ * float in [1,2)). This may discard up to eight low bits of y.
+ *
+ * Then y+0.5 = x * 2^(exp-127), so if f(x) ~= log(x) - 159*log(2),
+ * log((y+0.5)/2^32) ~= f(x) + exp * log(2).
+ *
+ * We use sollya to find the unique degree-3 polynomial f such that :
+ *
+ *    - Its average value is that of log(x) - 159*log(2) for x in [1, 2)
+ *          (so the sampling has the right mean when lambda is small).
+ *    - f(1) = f(2) - log(2), so the approximation is continuous.
+ *    - The error at x=1 is -1e-5, so the approximation is always negative.
+ *    - The maximum absolute error is minimized in [1, 2) (the actual
+ *      maximum absolute error is around 7e-4). */
+
+Caml_inline float log_approx(uint32_t y)
 {
-  memprof_domain_t domain = state->memprof;
-  memprof_thread_t thread = domain->threads;
+  union { float f; int32_t i; } u;
+  u.f = y + 0.5f;
+  float exp = (float)(u.i >> 23);
+  u.i = (u.i & 0x7FFFFF) | 0x3F800000;
+  float x = u.f;
+  return (-111.70172433407f +
+          x * (2.104659476859f +
+               x * (-0.720478916626f +
+                    x * 0.107132064797f)) +
+          0.6931471805f * exp);
+}
 
-  /* There should currently be just one thread in this domain */
-  CAMLassert(thread);
-  CAMLassert(thread->next == NULL);
-  return thread;
+/* This function regenerates [RAND_BLOCK_SIZE] geometric random
+ * variables at once. Doing this by batches help us gain performances:
+ * many compilers (e.g., GCC, CLang, ICC) will be able to use SIMD
+ * instructions to get a performance boost. */
+
+#ifdef SUPPORTS_TREE_VECTORIZE
+__attribute__((optimize("tree-vectorize")))
+#endif
+
+static void rand_batch(memprof_domain_t domain)
+{
+  float one_log1m_lambda = One_log1m_lambda(domain->entries.config);
+
+  /* Instead of using temporary buffers, we could use one big loop,
+     but it turns out SIMD optimizations of compilers are more fragile
+     when using larger loops.  */
+  uint32_t A[RAND_BLOCK_SIZE];
+  float B[RAND_BLOCK_SIZE];
+
+  /* Generate uniform variables in A using the xoshiro128+ PRNG. */
+  for (int i = 0; i < RAND_BLOCK_SIZE; i++)
+    A[i] = xoshiro_next(domain, i);
+
+  /* Generate exponential random variables by computing logarithms. */
+  for (int i = 0; i < RAND_BLOCK_SIZE; i++)
+    B[i] = 1 + log_approx(A[i]) * one_log1m_lambda;
+
+  /* We do the final flooring for generating geometric
+     variables. Compilers are unlikely to use SIMD instructions for
+     this loop, because it involves a conditional and variables of
+     different sizes (32 and 64 bits). */
+  for (int i = 0; i < RAND_BLOCK_SIZE; i++) {
+    double f = B[i];
+    CAMLassert (f >= 1);
+    /* [Max_long+1] is a power of two => no rounding in the test. */
+    if (f >= Max_long+1)
+      domain->rand_geom_buff[i] = Max_long;
+    else domain->rand_geom_buff[i] = (uintnat)f;
+  }
+
+  domain->rand_pos = 0;
 }
 
-CAMLexport void caml_memprof_delete_thread(memprof_thread_t thread)
+/* Simulate a geometric random variable of parameter [lambda].
+ * The result is clipped in [1..Max_long] */
+
+static uintnat rand_geom(memprof_domain_t domain)
 {
-  thread_destroy(thread);
+  uintnat res;
+  CAMLassert(One_log1m_lambda(domain->entries.config) <= 0.);
+  if (domain->rand_pos == RAND_BLOCK_SIZE)
+    rand_batch(domain);
+  res = domain->rand_geom_buff[domain->rand_pos++];
+  CAMLassert(1 <= res);
+  CAMLassert(res <= Max_long);
+  return res;
 }
 
-CAMLexport void caml_memprof_enter_thread(memprof_thread_t thread)
+/* Initialize per-domain PRNG, so we're ready to sample. */
+
+static void rand_init(memprof_domain_t domain)
 {
-  thread->domain->current = thread;
-  update_suspended(thread->domain, thread->suspended);
+  domain->rand_pos = RAND_BLOCK_SIZE;
+  if (domain->entries.config != CONFIG_NONE
+      && !Min_lambda(domain->entries.config)) {
+    /* next_rand_geom can be zero if the next word is to be sampled,
+     * but rand_geom always returns a value >= 1. Subtract 1 to correct. */
+    domain->next_rand_geom = rand_geom(domain) - 1;
+  }
 }
 
-/**** Interface to OCaml ****/
+/* Simulate a binomial random variable of parameters [len] and
+ * [lambda]. This tells us how many times a single block allocation is
+ * sampled.  This sampling algorithm has running time linear with [len
+ * * lambda].  We could use a more involved algorithm, but this should
+ * be good enough since, in the typical use case, [lambda] << 0.01 and
+ * therefore the generation of the binomial variable is amortized by
+ * the initialialization of the corresponding block.
+ *
+ * If needed, we could use algorithm BTRS from the paper:
+ *  Hormann, Wolfgang. "The generation of binomial random variates."
+ *  Journal of statistical computation and simulation 46.1-2 (1993), pp101-110.
+ */
 
-#include "caml/fail.h"
+static uintnat rand_binom(memprof_domain_t domain, uintnat len)
+{
+  uintnat res;
+  CAMLassert(len < Max_long);
+  for (res = 0; domain->next_rand_geom < len; res++)
+    domain->next_rand_geom += rand_geom(domain);
+  domain->next_rand_geom -= len;
+  return res;
+}
+
+/**** Create and destroy thread state structures ****/
 
-CAMLprim value caml_memprof_start(value lv, value szv, value tracker_param)
+/* Create a thread state structure attached to `domain`. */
+
+static memprof_thread_t thread_create(memprof_domain_t domain)
 {
-  caml_failwith("Gc.Memprof.start: not implemented in multicore");
+  memprof_thread_t thread = caml_stat_alloc(sizeof(memprof_thread_s));
+  if (!thread) {
+    return NULL;
+  }
+  thread->suspended = false;
+  thread->running_index = 0;
+  thread->running_table = NULL;
+  entries_init(&thread->entries, MIN_ENTRIES_THREAD_CAPACITY,
+               domain->entries.config);
+
+  /* attach to domain record */
+  thread->domain = domain;
+  thread->next = domain->threads;
+  domain->threads = thread;
+
+  return thread;
 }
 
-CAMLprim value caml_memprof_stop(value unit)
+/* Destroy a thread state structure.  If the thread's entries table is
+ * not empty (because allocation failed when transferring it to the
+ * domain) then its entries will be lost. */
+
+static void thread_destroy(memprof_thread_t thread)
 {
-  caml_failwith("Gc.Memprof.stop: not implemented in multicore");
+  memprof_domain_t domain = thread->domain;
+
+  /* A thread cannot be destroyed while inside a callback, as
+   * Thread.exit works by raising an exception, taking us out of the
+   * callback, and a domain won't terminate while any thread is
+   * alive. */
+  CAMLassert (!thread->running_table);
+  /* We would like to assert (thread->entries.size == 0), but this may
+   * not be true if allocation failed when transferring the thread's
+   * entries to its domain (in which case we are about to lose those
+   * entries. */
+  entries_clear(&thread->entries);
+
+  if (domain->current == thread) {
+    domain->current = NULL;
+  }
+  /* remove thread from the per-domain list. Could go faster if we
+   * used a doubly-linked list, but that's premature optimisation
+   * at this point. */
+  memprof_thread_t *p = &domain->threads;
+  while (*p != thread) {
+    CAMLassert(*p); /* checks that thread is on the list */
+    p = &(*p)->next;
+  }
+  *p = thread->next;
+
+  caml_stat_free(thread);
 }
 
-CAMLprim value caml_memprof_discard(value profile)
+/**** Create and destroy domain state structures ****/
+
+/* Destroy a domain state structure. In the usual case, this will
+ * orphan any entries belonging to the domain or its threads onto the
+ * global orphans list. However, if there is an allocation failure,
+ * some or all of those entries may be lost. */
+
+static void domain_destroy(memprof_domain_t domain)
 {
-  caml_failwith("Gc.Memprof.discard: not implemented in multicore");
+  /* Orphan any entries from the domain or its threads, then abandon
+   * all orphans to the global table. If creating the orphans table
+   * fails due to allocation failure, we lose the entries. */
+  (void)orphans_create(domain);
+  orphans_abandon(domain);
+
+  /* Destroy thread structures */
+  memprof_thread_t thread = domain->threads;
+  while (thread) {
+    memprof_thread_t next = thread->next;
+    thread_destroy(thread);
+    thread = next;
+  }
+
+  entries_clear(&domain->entries); /* In case allocation failed */
+  caml_stat_free(domain->callstack_buffer);
+  caml_stat_free(domain);
 }
 
-/* FIXME: integrate memprof with multicore */
-#if 0
+/* Create a domain state structure */
 
-#include <string.h>
-#include "caml/memprof.h"
-#include "caml/fail.h"
-#include "caml/alloc.h"
-#include "caml/callback.h"
-#include "caml/signals.h"
-#include "caml/memory.h"
-#include "caml/minor_gc.h"
-#include "caml/backtrace_prim.h"
-#include "caml/weak.h"
-#include "caml/stack.h"
-#include "caml/misc.h"
-#include "caml/printexc.h"
-#include "caml/runtime_events.h"
+static memprof_domain_t domain_create(caml_domain_state *caml_state)
+{
+  memprof_domain_t domain = caml_stat_alloc(sizeof(memprof_domain_s));
+  if (!domain) {
+    return NULL;
+  }
 
-#define RAND_BLOCK_SIZE 64
+  domain->caml_state = caml_state;
+  entries_init(&domain->entries, MIN_ENTRIES_DOMAIN_CAPACITY, CONFIG_NONE);
+  domain->orphans = NULL;
+  domain->orphans_pending = false;
+  domain->pending = false;
+  domain->threads = NULL;
+  domain->current = NULL;
+  domain->callstack_buffer = NULL;
+  domain->callstack_buffer_len = 0;
 
-static uint32_t xoshiro_state[4][RAND_BLOCK_SIZE];
-static uintnat rand_geom_buff[RAND_BLOCK_SIZE];
-static uint32_t rand_pos;
+  /* create initial thread for domain */
+  memprof_thread_t thread = thread_create(domain);
+  if (thread) {
+    domain->current = thread;
+  } else {
+    domain_destroy(domain);
+    domain = NULL;
+  }
+  return domain;
+}
+
+/**** Interface with domain action-pending flag ****/
 
-/* [lambda] is the mean number of samples for each allocated word (including
-   block headers). */
-static double lambda = 0;
-/* Precomputed value of [1/log(1-lambda)], for fast sampling of
-   geometric distribution.
-   Dummy if [lambda = 0]. */
-static float one_log1m_lambda;
+/* If a domain has some callbacks pending, and isn't currently
+ * suspended, set the action pending flag. */
 
-static intnat callstack_size;
+static void set_action_pending_as_needed(memprof_domain_t domain)
+{
+  CAMLassert(domain->current);
+  if (domain->current->suspended) return;
+  domain->pending = (domain->entries.active < domain->entries.size ||
+                     domain->current->entries.size > 0 ||
+                     domain->orphans_pending);
+  if (domain->pending) {
+    caml_set_action_pending(domain->caml_state);
+  }
+}
+
+/* Set the suspended flag on `domain` to `s`. Has the side-effect of
+ * setting the trigger. */
+
+static void update_suspended(memprof_domain_t domain, bool s)
+{
+  CAMLassert(domain->current);
+  domain->current->suspended = s;
+  /* If we are unsuspending, set the action-pending flag if
+   * we have callbacks to run. */
+  if (!s) set_action_pending_as_needed(domain);
 
-/* accessors for the OCaml type [Gc.Memprof.tracker],
-   which is the type of the [tracker] global below. */
-#define Alloc_minor(tracker) (Field(tracker, 0))
-#define Alloc_major(tracker) (Field(tracker, 1))
-#define Promote(tracker) (Field(tracker, 2))
-#define Dealloc_minor(tracker) (Field(tracker, 3))
-#define Dealloc_major(tracker) (Field(tracker, 4))
+  caml_memprof_set_trigger(domain->caml_state);
+  caml_reset_young_limit(domain->caml_state);
+}
 
-static value tracker;
+/* Set the suspended flag on the current domain to `s`.
+ * Has the side-effect of setting the trigger. */
 
-/* Gc.Memprof.allocation_source */
-enum { SRC_NORMAL = 0, SRC_MARSHAL = 1, SRC_CUSTOM = 2 };
+void caml_memprof_update_suspended(bool s) {
+  CAMLassert(Caml_state->memprof);
+  update_suspended(Caml_state->memprof, s);
+}
 
-struct tracked {
-  /* Memory block being sampled. This is a weak GC root. */
-  value block;
+/**** Iterating over entries ****/
 
-  /* Number of samples in this block. */
-  uintnat n_samples;
+/* Type of a function to apply to a single entry. Returns true if,
+ * following the call, the entry may have a newly-applicable
+ * callback. */
 
-  /* The size of this block. */
-  uintnat wosize;
+typedef bool (*entry_action)(entry_t, void *);
 
-  /* The value returned by the previous callback for this block, or
-     the callstack if the alloc callback has not been called yet.
-     This is a strong GC root. */
-  value user_data;
+/* Type of a function to apply to an entries array after iterating
+ * over the entries. */
 
-  /* The thread currently running a callback for this entry,
-     or NULL if there is none */
-  struct caml_memprof_th_ctx* running;
+typedef void (*entries_action)(entries_t, void *);
 
-  /* Whether this block has been initially allocated in the minor heap. */
-  unsigned int alloc_young : 1;
+/* Iterate an entry_action over entries in a single entries table,
+ * followed by an (optional) entries_action on the whole table.  If
+ * `young` is true, only apply to possibly-young entries (usually a
+ * small number of entries, often zero).
+ *
+ * This function validates the entries table configuration (which
+ * changes it to NONE if DISCARDED). If then it is NONE, this function
+ * does nothing else.
+ *
+ * Assumes that calling `f` does not change entry table indexes. */
 
-  /* The source of the allocation: normal allocations, marshal or custom_mem. */
-  unsigned int source : 2;
+static void entries_apply_actions(entries_t entries, bool young,
+                                  entry_action f, void *data,
+                                  entries_action after)
+{
+  value config = validated_config(entries);
+  if (config == CONFIG_NONE) {
+    return;
+  }
 
-  /* Whether this block has been promoted. Implies [alloc_young]. */
-  unsigned int promoted : 1;
+  for (size_t i = young ? entries->young : 0; i < entries->size; ++i) {
+    if (f(&entries->t[i], data) && entries->active > i) {
+      entries->active = i;
+    }
+  }
+  if (after) {
+    after(entries, data);
+  }
+}
 
-  /* Whether this block has been deallocated. */
-  unsigned int deallocated : 1;
+/* Iterate entry_action/entries_action over all entries managed by a
+ * single domain (including those managed by its threads).
+ *
+ * Assumes that calling `f` does not modify entry table indexes. */
 
-  /* Whether the allocation callback has been called depends on
-     whether the entry is in a thread local entry array or in
-     [entries_global]. */
+static void domain_apply_actions(memprof_domain_t domain, bool young,
+                                 entry_action f, void *data,
+                                 entries_action after)
+{
+  entries_apply_actions(&domain->entries, young, f, data, after);
+  memprof_thread_t thread = domain->threads;
+  while (thread) {
+    entries_apply_actions(&thread->entries, young, f, data, after);
+    thread = thread->next;
+  }
+  memprof_orphan_table_t ot = domain->orphans;
+  while (ot) {
+    entries_apply_actions(&ot->entries, young, f, data, after);
+    ot = ot->next;
+  }
+}
 
-  /* Whether the promotion callback has been called. */
-  unsigned int cb_promote_called : 1;
+/**** GC interface ****/
 
-  /* Whether the deallocation callback has been called. */
-  unsigned int cb_dealloc_called : 1;
+/* Root scanning */
 
-  /* Whether this entry is deleted. */
-  unsigned int deleted : 1;
+struct scan_closure {
+  scanning_action f;
+  scanning_action_flags fflags;
+  void *fdata;
+  bool weak;
 };
 
-/* During the alloc callback for a minor allocation, the block being
-   sampled is not yet allocated. Instead, we place in the block field
-   a value computed with the following macro: */
-#define Placeholder_magic 0x04200000
-#define Placeholder_offs(offset) (Val_long(offset + Placeholder_magic))
-#define Offs_placeholder(block) (Long_val(block) & 0xFFFF)
-#define Is_placeholder(block) \
-  (Is_long(block) && (Long_val(block) & ~(uintnat)0xFFFF) == Placeholder_magic)
-
-/* A resizable array of entries */
-struct entry_array {
-  struct tracked* t;
-  uintnat min_alloc_len, alloc_len, len;
-  /* Before this position, the [block] and [user_data] fields point to
-     the major heap ([young <= len]). */
-  uintnat young_idx;
-  /* There are no blocks to be deleted before this position
-     ([delete_idx <= len]). */
-  uintnat delete_idx;
-};
+/* An entry_action to scan roots */
 
-#define MIN_ENTRIES_LOCAL_ALLOC_LEN 16
-#define MIN_ENTRIES_GLOBAL_ALLOC_LEN 128
+static bool entry_scan(entry_t e, void *data)
+{
+  struct scan_closure *closure = data;
+  closure->f(closure->fdata, e->user_data, &e->user_data);
+  if (closure->weak && !e->offset && (e->block != Val_unit)) {
+    closure->f(closure->fdata, e->block, &e->block);
+  }
+  return false;
+}
 
-/* Entries for other blocks. This variable is shared across threads. */
-static struct entry_array entries_global =
-  { NULL, MIN_ENTRIES_GLOBAL_ALLOC_LEN, 0, 0, 0, 0 };
+/* An entries_action to scan the config root */
 
-/* There are no pending callbacks in [entries_global] before this
-   position ([callback_idx <= entries_global.len]). */
-static uintnat callback_idx;
+static void entries_finish_scan(entries_t es, void *data)
+{
+  struct scan_closure *closure = data;
+  closure->f(closure->fdata, es->config, &es->config);
+}
 
-#define CB_IDLE -1
-#define CB_LOCAL -2
-#define CB_STOPPED -3
+/* Function called by either major or minor GC to scan all the memprof roots */
 
-/* Structure for thread-local variables. */
-struct caml_memprof_th_ctx {
-  /* [suspended] is used for masking memprof callbacks when
-     a callback is running or when an uncaught exception handler is
-     called. */
-  int suspended;
-
-  /* [callback_status] contains:
-     - CB_STOPPED if the current thread is running a callback, but
-       sampling has been stopped using [caml_memprof_stop];
-     - The index of the corresponding entry in the [entries_global]
-       array if the current thread is currently running a promotion or
-       a deallocation callback;
-     - CB_LOCAL if the current thread is currently running an
-       allocation callback;
-     - CB_IDLE if the current thread is not running any callback.
-  */
-  intnat callback_status;
-
-  /* Entries for blocks whose alloc callback has not yet been called. */
-  struct entry_array entries;
-} caml_memprof_main_ctx =
-  { 0, CB_IDLE, { NULL, MIN_ENTRIES_LOCAL_ALLOC_LEN, 0, 0, 0, 0 } };
-static struct caml_memprof_th_ctx* local = &caml_memprof_main_ctx;
-
-/* Pointer to the word following the next sample in the minor
-   heap. Equals [Caml_state->young_alloc_start] if no sampling is planned in
-   the current minor heap.
-   Invariant: [caml_memprof_young_trigger <= Caml_state->young_ptr].
- */
-value* caml_memprof_young_trigger;
+void caml_memprof_scan_roots(scanning_action f,
+                             scanning_action_flags fflags,
+                             void* fdata,
+                             caml_domain_state *state,
+                             bool weak)
+{
+  memprof_domain_t domain = state->memprof;
+  CAMLassert(domain);
 
-/* Whether memprof has been initialized.  */
-static int init = 0;
+  /* Adopt all global orphans into this domain. */
+  orphans_adopt(domain);
 
-/* Whether memprof is started. */
-static int started = 0;
+  bool young = (fflags & SCANNING_ONLY_YOUNG_VALUES);
+  struct scan_closure closure = {f, fflags, fdata, weak};
+  domain_apply_actions(domain, young,
+                       entry_scan, &closure, entries_finish_scan);
+}
 
-/* Buffer used to compute backtraces */
-static value* callstack_buffer = NULL;
-static intnat callstack_buffer_len = 0;
+/* Post-GC actions: we have to notice when tracked blocks die or get promoted */
 
-/**** Statistical sampling ****/
+/* An entry_action to update a single entry after a minor GC. Notices
+ * when a young tracked block has died or been promoted. */
 
-Caml_inline uint64_t splitmix64_next(uint64_t* x)
+static bool entry_update_after_minor_gc(entry_t e, void *data)
 {
-  uint64_t z = (*x += 0x9E3779B97F4A7C15ull);
-  z = (z ^ (z >> 30)) * 0xBF58476D1CE4E5B9ull;
-  z = (z ^ (z >> 27)) * 0x94D049BB133111EBull;
-  return z ^ (z >> 31);
+  (void)data;
+  CAMLassert(Is_block(e->block)
+             || e->deleted || e->deallocated || e->offset);
+  if (!e->offset && Is_block(e->block) && Is_young(e->block)) {
+    if (Hd_val(e->block) == 0) {
+      /* Block has been promoted */
+      e->block = Field(e->block, 0);
+      e->promoted = true;
+    } else {
+      /* Block is dead */
+      e->block = Val_unit;
+      e->deallocated = true;
+    }
+    return true; /* either promotion or deallocation callback */
+  }
+  return false; /* no callback triggered */
 }
 
-static void xoshiro_init(void)
+/* An entries_action for use after a minor GC. */
+
+static void entries_update_after_minor_gc(entries_t entries,
+                                          void *data)
 {
-  int i;
-  uint64_t splitmix64_state = 42;
-  rand_pos = RAND_BLOCK_SIZE;
-  for (i = 0; i < RAND_BLOCK_SIZE; i++) {
-    uint64_t t = splitmix64_next(&splitmix64_state);
-    xoshiro_state[0][i] = t & 0xFFFFFFFF;
-    xoshiro_state[1][i] = t >> 32;
-    t = splitmix64_next(&splitmix64_state);
-    xoshiro_state[2][i] = t & 0xFFFFFFFF;
-    xoshiro_state[3][i] = t >> 32;
-  }
+  (void)data;
+  /* There are no 'young' entries left */
+  entries->young = entries->size;
 }
 
-Caml_inline uint32_t xoshiro_next(int i)
+/* Update all memprof structures for a given domain, at the end of a
+ * minor GC. */
+
+void caml_memprof_after_minor_gc(caml_domain_state *state)
 {
-  uint32_t res = xoshiro_state[0][i] + xoshiro_state[3][i];
-  uint32_t t = xoshiro_state[1][i] << 9;
-  xoshiro_state[2][i] ^= xoshiro_state[0][i];
-  xoshiro_state[3][i] ^= xoshiro_state[1][i];
-  xoshiro_state[1][i] ^= xoshiro_state[2][i];
-  xoshiro_state[0][i] ^= xoshiro_state[3][i];
-  xoshiro_state[2][i] ^= t;
-  t = xoshiro_state[3][i];
-  xoshiro_state[3][i] = (t << 11) | (t >> 21);
-  return res;
+  memprof_domain_t domain = state->memprof;
+  CAMLassert(domain);
+
+  /* Adopt all global orphans into this domain. */
+  orphans_adopt(domain);
+
+  domain_apply_actions(domain, true, entry_update_after_minor_gc,
+                       NULL, entries_update_after_minor_gc);
+  orphans_update_pending(domain);
+  set_action_pending_as_needed(domain);
 }
 
-/* Computes [log((y+0.5)/2^32)], up to a relatively good precision,
-   and guarantee that the result is negative.
-   The average absolute error is very close to 0. */
-Caml_inline float log_approx(uint32_t y)
+/* An entry_action to update a single entry after a major GC. Notices
+ * when a tracked block has died. */
+
+static bool entry_update_after_major_gc(entry_t e, void *data)
 {
-  union { float f; int32_t i; } u;
-  float exp, x;
-  u.f = y + 0.5f;    /* We convert y to a float ... */
-  exp = u.i >> 23;   /* ... of which we extract the exponent ... */
-  u.i = (u.i & 0x7FFFFF) | 0x3F800000;
-  x = u.f;           /* ... and the mantissa. */
-
-  return
-    /* This polynomial computes the logarithm of the mantissa (which
-       is in [1, 2]), up to an additive constant. It is chosen such that :
-       - Its degree is 4.
-       - Its average value is that of log in [1, 2]
-             (the sampling has the right mean when lambda is small).
-       - f(1) = f(2) - log(2) = -159*log(2) - 1e-5
-             (this guarantee that log_approx(y) is always <= -1e-5 < 0).
-       - The maximum of abs(f(x)-log(x)+159*log(2)) is minimized.
-    */
-    x * (2.104659476859f + x * (-0.720478916626f + x * 0.107132064797f))
-
-    /* Then, we add the term corresponding to the exponent, and
-       additive constants. */
-    + (-111.701724334061f + 0.6931471805f*exp);
+  (void)data;
+  CAMLassert(Is_block(e->block)
+             || e->deleted || e->deallocated || e->offset);
+  if (!e->offset && Is_block(e->block) && !Is_young(e->block)) {
+    /* Either born in the major heap or promoted */
+    CAMLassert(!e->alloc_young || e->promoted);
+    if (is_unmarked(e->block)) { /* died */
+      e->block = Val_unit;
+      e->deallocated = true;
+      return true; /* trigger deallocation callback */
+    }
+  }
+  return false; /* no callback triggered */
 }
 
-/* This function regenerates [MT_STATE_SIZE] geometric random
-   variables at once. Doing this by batches help us gain performances:
-   many compilers (e.g., GCC, CLang, ICC) will be able to use SIMD
-   instructions to get a performance boost.
-*/
-#ifdef SUPPORTS_TREE_VECTORIZE
-__attribute__((optimize("tree-vectorize")))
-#endif
-static void rand_batch(void)
+/* Note: there's nothing to be done at the table level after a major
+ * GC (unlike a minor GC, when we reset the 'young' index), so there
+ * is no "entries_update_after_major_gc" function. */
+
+/* Update all memprof structures for a given domain, at the end of a
+ * major GC. */
+
+void caml_memprof_after_major_gc(caml_domain_state *state)
 {
-  int i;
+  memprof_domain_t domain = state->memprof;
+  CAMLassert(domain);
 
-  /* Instead of using temporary buffers, we could use one big loop,
-     but it turns out SIMD optimizations of compilers are more fragile
-     when using larger loops.  */
-  static uint32_t A[RAND_BLOCK_SIZE];
-  static float B[RAND_BLOCK_SIZE];
+  /* Adopt all global orphans into this domain. */
+  orphans_adopt(domain);
 
-  CAMLassert(lambda > 0.);
+  domain_apply_actions(domain, false, entry_update_after_major_gc,
+                       NULL, NULL);
+  orphans_update_pending(domain);
+  set_action_pending_as_needed(domain);
+}
 
-  /* Shuffle the xoshiro samplers, and generate uniform variables in A. */
-  for (i = 0; i < RAND_BLOCK_SIZE; i++)
-    A[i] = xoshiro_next(i);
+/**** Interface to domain module ***/
 
-  /* Generate exponential random variables by computing logarithms. We
-     do not use math.h library functions, which are slow and prevent
-     compiler from using SIMD instructions. */
-  for (i = 0; i < RAND_BLOCK_SIZE; i++)
-    B[i] = 1 + log_approx(A[i]) * one_log1m_lambda;
+void caml_memprof_new_domain(caml_domain_state *parent,
+                             caml_domain_state *child)
+{
+  memprof_domain_t domain = domain_create(child);
+  child->memprof = domain;
 
-  /* We do the final flooring for generating geometric
-     variables. Compilers are unlikely to use SIMD instructions for
-     this loop, because it involves a conditional and variables of
-     different sizes (32 and 64 bits). */
-  for (i = 0; i < RAND_BLOCK_SIZE; i++) {
-    double f = B[i];
-    CAMLassert (f >= 1);
-    /* [Max_long+1] is a power of two => no rounding in the test. */
-    if (f >= Max_long+1)
-      rand_geom_buff[i] = Max_long;
-    else rand_geom_buff[i] = (uintnat)f;
+  if (domain == NULL) /* failure - domain creation will fail */
+    return;
+
+  /* domain inherits configuration from parent */
+  if (parent) {
+    CAMLassert(parent->memprof);
+    CAMLassert(domain->current);
+    domain->current->entries.config =
+      domain->entries.config =
+      parent->memprof->entries.config;
   }
+  /* Initialize RNG */
+  xoshiro_init(domain, (uint64_t)child->id);
 
-  rand_pos = 0;
+  /* If already profiling, set up RNG */
+  rand_init(domain);
 }
 
-/* Simulate a geometric variable of parameter [lambda].
-   The result is clipped in [1..Max_long] */
-static uintnat rand_geom(void)
+void caml_memprof_delete_domain(caml_domain_state *state)
 {
-  uintnat res;
-  CAMLassert(lambda > 0.);
-  if (rand_pos == RAND_BLOCK_SIZE) rand_batch();
-  res = rand_geom_buff[rand_pos++];
-  CAMLassert(1 <= res && res <= Max_long);
-  return res;
-}
+  CAMLassert(state->memprof);
 
-static uintnat next_rand_geom;
-/* Simulate a binomial variable of parameters [len] and [lambda].
-   This sampling algorithm has running time linear with [len *
-   lambda].  We could use more a involved algorithm, but this should
-   be good enough since, in the average use case, [lambda] <= 0.01 and
-   therefore the generation of the binomial variable is amortized by
-   the initialialization of the corresponding block.
-
-   If needed, we could use algorithm BTRS from the paper:
-     Hormann, Wolfgang. "The generation of binomial random variates."
-     Journal of statistical computation and simulation 46.1-2 (1993), pp101-110.
- */
-static uintnat rand_binom(uintnat len)
-{
-  uintnat res;
-  CAMLassert(lambda > 0. && len < Max_long);
-  for (res = 0; next_rand_geom < len; res++)
-    next_rand_geom += rand_geom();
-  next_rand_geom -= len;
-  return res;
+  domain_destroy(state->memprof);
+  state->memprof = NULL;
 }
 
 /**** Capturing the call stack *****/
 
-/* This function is called in, e.g., [caml_alloc_shr], which
-   guarantees that the GC is not called. Clients may use it in a
-   context where the heap is in an invalid state, or when the roots
-   are not properly registered. Therefore, we do not use [caml_alloc],
-   which may call the GC, but prefer using [caml_alloc_shr], which
-   gives this guarantee. The return value is either a valid callstack
-   or 0 in out-of-memory scenarios. */
-static value capture_callstack_postponed()
+/* A "stashed" callstack, allocated on the C heap. */
+
+typedef struct {
+        size_t frames;
+        backtrace_slot stack[];
+} callstack_stash_s, *callstack_stash_t;
+
+/* How large a callstack buffer must be to be considered "large" */
+#define CALLSTACK_BUFFER_LARGE 256
+
+/* How much larger a callstack buffer must be, compared to the most
+ * recent callstack, to be considered large. */
+#define CALLSTACK_BUFFER_FACTOR 8
+
+/* If the per-domain callstack buffer is "large" and we've only used a
+ * small part of it, free it. This saves us from C heap bloat due to
+ * unbounded lifetime of the callstack buffers (as callstacks may
+ * sometimes be huge). */
+
+static void shrink_callstack_buffer(memprof_domain_t domain, size_t frames)
 {
-  value res;
-  intnat callstack_len =
-    caml_collect_current_callstack(&callstack_buffer, &callstack_buffer_len,
-                                   callstack_size, -1);
-  if (callstack_len == 0)
-    return Atom(0);
-  res = caml_alloc_shr_no_track_noexc(callstack_len, 0);
-  if (res == 0)
-    return Atom(0);
-  memcpy(Op_val(res), callstack_buffer, sizeof(value) * callstack_len);
-  if (callstack_buffer_len > 256 && callstack_buffer_len > callstack_len * 8) {
-    caml_stat_free(callstack_buffer);
-    callstack_buffer = NULL;
-    callstack_buffer_len = 0;
+  if (domain->callstack_buffer_len > CALLSTACK_BUFFER_LARGE &&
+      domain->callstack_buffer_len > frames * CALLSTACK_BUFFER_FACTOR) {
+    caml_stat_free(domain->callstack_buffer);
+    domain->callstack_buffer = NULL;
+    domain->callstack_buffer_len = 0;
   }
-  return res;
 }
 
-/* In this version, we are allowed to call the GC, so we use
-   [caml_alloc], which is more efficient since it uses the minor
-   heap.
-   Should be called with [local->suspended == 1] */
-static value capture_callstack(int alloc_idx)
+/* Capture the call stack when sampling an allocation from the
+ * runtime. We don't have to account for combined allocations
+ * (Comballocs) but we can't allocate the resulting stack on the Caml
+ * heap, because the heap may be in an invalid state so we can't cause
+ * a GC. Therefore, we capture the callstack onto the C heap, and will
+ * copy it onto the Caml heap later, when we're ready to call the
+ * allocation callback. The callstack is returned as a Val_ptr value
+ * (or an empty array, if allocation fails). */
+
+static value capture_callstack_no_GC(memprof_domain_t domain)
 {
-  value res;
-  intnat callstack_len =
-    caml_collect_current_callstack(&callstack_buffer, &callstack_buffer_len,
-                                   callstack_size, alloc_idx);
-  CAMLassert(local->suspended);
-  res = caml_alloc(callstack_len, 0);
-  memcpy(Op_val(res), callstack_buffer, sizeof(value) * callstack_len);
-  if (callstack_buffer_len > 256 && callstack_buffer_len > callstack_len * 8) {
-    caml_stat_free(callstack_buffer);
-    callstack_buffer = NULL;
-    callstack_buffer_len = 0;
+  value res = Atom(0); /* empty array. */
+  size_t frames =
+    caml_get_callstack(Callstack_size(domain->entries.config),
+                       &domain->callstack_buffer,
+                       &domain->callstack_buffer_len, -1);
+  if (frames) {
+    callstack_stash_t stash = caml_stat_alloc_noexc(sizeof(callstack_stash_s)
+                                                    + frames * sizeof(value));
+    if (stash) {
+      stash->frames = frames;
+      memcpy(stash->stack, domain->callstack_buffer,
+             sizeof(backtrace_slot) * frames);
+      res = Val_ptr(stash);
+    }
   }
+
+  shrink_callstack_buffer(domain, frames);
   return res;
 }
 
-/**** Managing data structures for tracked blocks. ****/
+/* Capture the call stack when sampling an allocation from Caml. We
+ * have to deal with combined allocations (Comballocs), but can
+ * allocate the resulting call stack directly on the Caml heap. Should
+ * be called with [domain->current->suspended] set, as it allocates.
+ * May cause a GC. */
 
-/* Reallocate the [ea] array if it is either too small or too
-   large.
-   [grow] is the number of free cells needed.
-   Returns 1 if reallocation succeeded --[ea->alloc_len] is at
-   least [ea->len+grow]--, and 0 otherwise. */
-static int realloc_entries(struct entry_array* ea, uintnat grow)
+static value capture_callstack_GC(memprof_domain_t domain, int alloc_idx)
 {
-  uintnat new_alloc_len, new_len = ea->len + grow;
-  struct tracked* new_t;
-  if (new_len <= ea->alloc_len &&
-     (4*new_len >= ea->alloc_len || ea->alloc_len == ea->min_alloc_len))
-    return 1;
-  new_alloc_len = new_len * 2;
-  if (new_alloc_len < ea->min_alloc_len)
-    new_alloc_len = ea->min_alloc_len;
-  new_t = caml_stat_resize_noexc(ea->t, new_alloc_len * sizeof(struct tracked));
-  if (new_t == NULL) return 0;
-  ea->t = new_t;
-  ea->alloc_len = new_alloc_len;
-  return 1;
+  CAMLassert(domain->current->suspended);
+
+  size_t frames =
+    caml_get_callstack(Callstack_size(domain->entries.config),
+                       &domain->callstack_buffer,
+                       &domain->callstack_buffer_len,
+                       alloc_idx);
+  value res = caml_alloc(frames, 0);
+  for (size_t i = 0; i < frames; ++i) {
+    Field(res, i) = Val_backtrace_slot(domain->callstack_buffer[i]);
+  }
+
+  shrink_callstack_buffer(domain, frames);
+  return res;
 }
 
-#define Invalid_index (~(uintnat)0)
+/* Given a stashed callstack, copy it to the Caml heap and free the
+ * stash. Given a non-stashed callstack, simply return it. */
 
-Caml_inline uintnat new_tracked(uintnat n_samples, uintnat wosize,
-                                int source, int is_young,
-                                value block, value user_data)
+static value unstash_callstack(value callstack)
 {
-  struct tracked *t;
-  if (!realloc_entries(&local->entries, 1))
-    return Invalid_index;
-  local->entries.len++;
-  t = &local->entries.t[local->entries.len - 1];
-  t->block = block;
-  t->n_samples = n_samples;
-  t->wosize = wosize;
-  t->user_data = user_data;
-  t->running = NULL;
-  t->alloc_young = is_young;
-  t->source = source;
-  t->promoted = 0;
-  t->deallocated = 0;
-  t->cb_promote_called = t->cb_dealloc_called = 0;
-  t->deleted = 0;
-  return local->entries.len - 1;
+  CAMLparam1(callstack);
+  if (Is_long(callstack)) { /* stashed on C heap */
+    callstack_stash_t stash = Ptr_val(callstack);
+    callstack = caml_alloc(stash->frames, 0);
+    for (size_t i = 0; i < stash->frames; ++i) {
+      Field(callstack, i) = Val_backtrace_slot(stash->stack[i]);
+    }
+    caml_stat_free(stash);
+  }
+  CAMLreturn(callstack);
 }
 
-static void mark_deleted(struct entry_array* ea, uintnat t_idx)
-{
-  struct tracked* t = &ea->t[t_idx];
-  t->deleted = 1;
-  t->user_data = Val_unit;
-  t->block = Val_unit;
-  if (t_idx < ea->delete_idx) ea->delete_idx = t_idx;
-}
+/**** Running callbacks ****/
 
-Caml_inline value run_callback_exn(
-  struct entry_array* ea, uintnat t_idx, value cb, value param)
+/* Runs a single callback, in thread `thread`, for entry number `i` in
+ * table `es`. The callback closure is `cb`, the parameter is `param`,
+ * and the "callback index" is `cb_index`.
+ * Returns unit or an exception result. */
+
+static caml_result run_callback_res(
+  memprof_thread_t thread,
+  entries_t es, size_t i,
+  value cb, value param,
+  uintnat cb_index)
 {
-  struct tracked* t = &ea->t[t_idx];
-  value res;
-  CAMLassert(t->running == NULL);
-  CAMLassert(lambda > 0.);
-
-  local->callback_status = ea == &entries_global ? t_idx : CB_LOCAL;
-  t->running = local;
-  t->user_data = Val_unit;      /* Release root. */
-  res = caml_callback_exn(cb, param);
-  if (local->callback_status == CB_STOPPED) {
-    /* Make sure this entry has not been removed by [caml_memprof_stop] */
-    local->callback_status = CB_IDLE;
-    return Is_exception_result(res) ? res : Val_unit;
+  entry_t e = &es->t[i];
+
+  if (e->runner) { /* some other thread has got to this callback first */
+    return Result_unit;
   }
-  /* The call above can move the tracked entry and thus invalidate
-     [t_idx] and [t]. */
-  if (ea == &entries_global) {
-    CAMLassert(local->callback_status >= 0 && local->callback_status < ea->len);
-    t_idx = local->callback_status;
-    t = &ea->t[t_idx];
+
+  thread->running_table = es;
+  thread->running_index = i;
+  e->runner = thread;
+
+  e->callback = cb_index;
+  e->callbacks |= CB_MASK(cb_index);
+  e->user_data = Val_unit;      /* Release root. */
+
+  caml_result res = caml_callback_res(cb, param);
+
+  /* The entry may have been moved to another table under our feet,
+   * due to the callback or to other threads from this domain. For
+   * example, if a new profile is started. */
+  es = thread->running_table;
+  thread->running_table = NULL;
+  i = thread->running_index;
+
+  CAMLassert(es != NULL);
+  CAMLassert(i < es->size);
+  e = &es->t[i];
+  CAMLassert(e->runner == thread);
+  e->runner = NULL;
+  e->callback = CB_NONE;
+
+  if (validated_config(es) == CONFIG_NONE) {
+    /* The profile was discarded during the callback.
+     * no entries to update etc. */
+    if (!caml_result_is_exception(res))
+      return Result_unit;
   }
-  local->callback_status = CB_IDLE;
-  CAMLassert(t->running == local);
-  t->running = NULL;
-  if (Is_exception_result(res) || res == Val_unit) {
+
+  if (caml_result_is_exception(res) || res.data == Val_unit) {
     /* Callback raised an exception or returned None or (), discard
        this entry. */
-    mark_deleted(ea, t_idx);
+    entry_delete(es, i);
     return res;
   } else {
+    value v = res.data;
     /* Callback returned [Some _]. Store the value in [user_data]. */
-    CAMLassert(!Is_exception_result(res) && Is_block(res) && Tag_val(res) == 0
-               && Wosize_val(res) == 1);
-    t->user_data = Field(res, 0);
-    if (Is_block(t->user_data) && Is_young(t->user_data) &&
-        t_idx < ea->young_idx)
-      ea->young_idx = t_idx;
-
-    // If the following condition are met:
-    //   - we are running a promotion callback,
-    //   - the corresponding block is deallocated,
-    //   - another thread is running callbacks in
-    //     [caml_memprof_handle_postponed_exn],
-    // then [callback_idx] may have moved forward during this callback,
-    // which means that we may forget to run the deallocation callback.
-    // Hence, we reset [callback_idx] if appropriate.
-    if (ea == &entries_global && t->deallocated && !t->cb_dealloc_called &&
-        callback_idx > t_idx)
-      callback_idx = t_idx;
-
-    return Val_unit;
+    CAMLassert(Is_block(v));
+    CAMLassert(Tag_val(v) == 0);
+    CAMLassert(Wosize_val(v) == 1);
+    e->user_data = Some_val(v);
+    if (Is_block(e->user_data) && Is_young(e->user_data) &&
+        i < es->young)
+      es->young = i;
+
+    /* The callback we just ran was not a dealloc (they return unit)
+     * so there may be more callbacks to run on this entry.  If the
+     * block has been deallocated, or promoted and we were not running
+     * a promotion callback, mark this entry as ready to run. */
+    if (i < es->active &&
+        (e->deallocated ||
+         (e->promoted && (cb_index != CB_PROMOTE))))
+      es->active = i;
+
+    return Result_unit;
   }
 }
 
-/* Run the allocation callback for a given entry of the local entries array.
-   This assumes that the corresponding [deleted] and
-   [running] fields of the entry are both set to 0.
-   Reentrancy is not a problem for this function, since other threads
-   will use a different array for entries.
-   The index of the entry will not change, except if [caml_memprof_stop] is
-   called .
-   Returns:
-   - An exception result if the callback raised an exception
-   - Val_long(0) == Val_unit == None otherwise
- */
-static value run_alloc_callback_exn(uintnat t_idx)
+/* Run the allocation callback for a given entry of an entries array.
+ * Returns Val_unit or an exception result. */
+
+static caml_result run_alloc_callback_res(
+  memprof_thread_t thread, entries_t es, size_t i)
 {
-  struct tracked* t = &local->entries.t[t_idx];
-  value sample_info;
-
-  CAMLassert(Is_block(t->block) || Is_placeholder(t->block) || t->deallocated);
-  sample_info = caml_alloc_small(4, 0);
-  Field(sample_info, 0) = Val_long(t->n_samples);
-  Field(sample_info, 1) = Val_long(t->wosize);
-  Field(sample_info, 2) = Val_long(t->source);
-  Field(sample_info, 3) = t->user_data;
-  return run_callback_exn(&local->entries, t_idx,
-     t->alloc_young ? Alloc_minor(tracker) : Alloc_major(tracker), sample_info);
+  entry_t e = &es->t[i];
+  CAMLassert(e->deallocated || e->offset || Is_block(e->block));
+
+  e->user_data = unstash_callstack(e->user_data);
+  value sample_info = caml_alloc_small(4, 0);
+  Field(sample_info, 0) = Val_long(e->samples);
+  Field(sample_info, 1) = Val_long(e->wosize);
+  Field(sample_info, 2) = Val_long(e->source);
+  Field(sample_info, 3) = e->user_data;
+  value callback =
+    e->alloc_young ? Alloc_minor(es->config) : Alloc_major(es->config);
+  return run_callback_res(thread, es, i, callback, sample_info, CB_ALLOC);
 }
 
-/* Remove any deleted entries from [ea], updating [ea->young_idx] and
-   [callback_idx] if [ea == &entries_global]. */
-static void flush_deleted(struct entry_array* ea)
+/* Run any pending callbacks from entries table `es` in thread
+ * `thread`. Returns either (a) when a callback raises an exception,
+ * or (b) when all pending callbacks have been run. */
+
+static caml_result entries_run_callbacks_res(
+  memprof_thread_t thread, entries_t es)
 {
-  uintnat i, j;
-
-  if (ea == NULL) return;
-
-  j = i = ea->delete_idx;
-  while (i < ea->len) {
-    if (!ea->t[i].deleted) {
-      struct caml_memprof_th_ctx* runner = ea->t[i].running;
-      if (runner != NULL && runner->callback_status == i)
-        runner->callback_status = j;
-      ea->t[j] = ea->t[i];
-      j++;
+  caml_result res = Result_unit;
+
+  /* Note: several callbacks may be called for a single entry. */
+  while (es->active < es->size) {
+    /* Examine and possibly run a callback on the entry at es->active.
+     * Running a callback may change many things, including es->active
+     * and es->config. */
+    value config = validated_config(es);
+    if (config == CONFIG_NONE) break;
+    size_t i = es->active;
+    entry_t e = &es->t[i];
+
+    if (e->deleted || e->runner) {
+      /* This entry is already deleted, or is running a callback. Ignore it. */
+      ++ es->active;
+    } else if (!(e->callbacks & CB_MASK(CB_ALLOC))) {
+      /* allocation callback hasn't been run */
+      if (Status(config) == CONFIG_STATUS_SAMPLING) {
+        res = run_alloc_callback_res(thread, es, i);
+        if (caml_result_is_exception(res)) break;
+      } else {
+        /* sampling stopped, e.g. by a previous callback; drop this entry */
+        entry_delete(es, i);
+      }
+    } else if (e->promoted && !(e->callbacks & CB_MASK(CB_PROMOTE))) {
+      /* promoted entry; call promote callback */
+      res = run_callback_res(thread, es, i,
+                             Promote(config), e->user_data,
+                             CB_PROMOTE);
+      if (caml_result_is_exception(res)) break;
+    } else if (e->deallocated && !(e->callbacks & CB_MASK(CB_DEALLOC))) {
+      /* deallocated entry; call dealloc callback */
+      value cb = (e->promoted || !e->alloc_young) ?
+        Dealloc_major(config) : Dealloc_minor(config);
+      res = run_callback_res(thread, es, i,
+                             cb, e->user_data,
+                             CB_DEALLOC);
+      if (caml_result_is_exception(res)) break;
+    } else {
+      /* There is nothing to do with this entry. */
+      ++ es->active;
     }
-    i++;
-    if (ea->young_idx == i) ea->young_idx = j;
-    if (ea == &entries_global && callback_idx == i) callback_idx = j;
   }
-  ea->delete_idx = ea->len = j;
-  CAMLassert(ea != &entries_global || callback_idx <= ea->len);
-  CAMLassert(ea->young_idx <= ea->len);
-  realloc_entries(ea, 0);
+  entries_evict(es);
+  return res;
 }
 
-static void check_action_pending(void)
-{
-  if (local->suspended) return;
-  if (callback_idx < entries_global.len || local->entries.len > 0)
-    caml_set_action_pending(Caml_state);
-}
+/* Run any pending callbacks for the current thread and domain, and
+ * any orphaned callbacks.
+ *
+ * Does not use domain_apply_actions() because this can dynamically
+ * change the various indexes into an entries table while iterating
+ * over it, whereas domain_apply_actions assumes that can't happen. */
 
-/* In case of a thread context switch during a callback, this can be
-   called in a reetrant way. */
-value caml_memprof_handle_postponed_exn(void)
+caml_result caml_memprof_run_callbacks_res(void)
 {
-  value res = Val_unit;
-  uintnat i;
-  if (local->suspended) return Val_unit;
-  if (callback_idx >= entries_global.len && local->entries.len == 0)
-    return Val_unit;
-
-  caml_memprof_set_suspended(1);
-
-  for (i = 0; i < local->entries.len; i++) {
-    /* We are the only thread allowed to modify [local->entries], so
-       the indices cannot shift, but it is still possible that
-       [caml_memprof_stop] got called during the callback,
-       invalidating all the entries. */
-    res = run_alloc_callback_exn(i);
-    if (Is_exception_result(res)) goto end;
-    if (local->entries.len == 0)
-      goto end; /* [caml_memprof_stop] has been called. */
-    if (local->entries.t[i].deleted) continue;
-    if (realloc_entries(&entries_global, 1))
-      /* Transfer the entry to the global array. */
-      entries_global.t[entries_global.len++] = local->entries.t[i];
-    mark_deleted(&local->entries, i);
-  }
-
-  while (callback_idx < entries_global.len) {
-    struct tracked* t = &entries_global.t[callback_idx];
-
-    if (t->deleted || t->running != NULL) {
-      /* This entry is not ready. Ignore it. */
-      callback_idx++;
-    } else if (t->promoted && !t->cb_promote_called) {
-      t->cb_promote_called = 1;
-      res = run_callback_exn(&entries_global, callback_idx, Promote(tracker),
-                             t->user_data);
-      if (Is_exception_result(res)) goto end;
-    } else if (t->deallocated && !t->cb_dealloc_called) {
-      value cb = (t->promoted || !t->alloc_young) ?
-        Dealloc_major(tracker) : Dealloc_minor(tracker);
-      t->cb_dealloc_called = 1;
-      res = run_callback_exn(&entries_global, callback_idx, cb, t->user_data);
-      if (Is_exception_result(res)) goto end;
-    } else {
-      /* There is nothing more to do with this entry. */
-      callback_idx++;
+  memprof_domain_t domain = Caml_state->memprof;
+  CAMLassert(domain);
+  memprof_thread_t thread = domain->current;
+  CAMLassert(thread);
+  caml_result res = Result_unit;
+  if (thread->suspended || !domain->pending) return res;
+
+  orphans_adopt(domain);
+  update_suspended(domain, true);
+
+  /* run per-domain callbacks first */
+  res = entries_run_callbacks_res(thread, &domain->entries);
+  if (caml_result_is_exception(res)) goto end;
+
+  /* run per-thread callbacks for current thread */
+  res = entries_run_callbacks_res(thread, &thread->entries);
+  if (caml_result_is_exception(res)) goto end;
+  /* Move any surviving entries from allocating thread to owning
+   * domain, so their subsequent callbacks may be run by any thread in
+   * the domain. entries_run_callbacks_res didn't return an exception,
+   * so all these entries have had their allocation callbacks run. If
+   * this fails due to allocation failure, the entries remain with the
+   * thread, which is OK. */
+  (void)entries_transfer(&thread->entries, &domain->entries);
+
+  /* now run per-domain orphaned callbacks. */
+  memprof_orphan_table_t ot = domain->orphans;
+  while (ot) {
+    entries_t es = &ot->entries;
+    if ((validated_config(es) != CONFIG_NONE) && (es->active < es->size)) {
+      /* An orphan table with something to run. */
+      res = entries_run_callbacks_res(thread, es);
+      if (caml_result_is_exception(res)) goto end;
+      /* Orphan tables may be deallocated during callbacks (if a
+       * callback discards the profile and then orphans_update_pending
+       * runs due to a GC) but a callback from an orphan table can
+       * never deallocate _that_ orphan table, so we can continue down
+       * the list. */
     }
+    ot = ot->next;
   }
 
  end:
-  flush_deleted(&local->entries);
-  flush_deleted(&entries_global);
-  /* We need to reset the suspended flag *after* flushing
-     [local->entries] to make sure the floag is not set back to 1. */
-  caml_memprof_set_suspended(0);
+  orphans_update_pending(domain);
+  update_suspended(domain, false);
   return res;
 }
 
-/**** Handling weak and strong roots when the GC runs. ****/
-
-typedef void (*ea_action)(struct entry_array*, void*);
-struct call_on_entry_array_data { ea_action f; void *data; };
-static void call_on_entry_array(struct caml_memprof_th_ctx* ctx, void *data)
-{
-  struct call_on_entry_array_data* closure = data;
-  closure->f(&ctx->entries, closure->data);
-}
-
-static void entry_arrays_iter(ea_action f, void *data)
-{
-  struct call_on_entry_array_data closure = { f, data };
-  f(&entries_global, data);
-  caml_memprof_th_ctx_iter_hook(call_on_entry_array, &closure);
-}
+/**** Sampling ****/
 
-static void entry_array_oldify_young_roots(struct entry_array *ea, void *data)
-{
-  uintnat i;
-  (void)data;
-  /* This loop should always have a small number of iterations (when
-     compared to the size of the minor heap), because the young_idx
-     pointer should always be close to the end of the array. Indeed,
-     it is only moved back when returning from a callback triggered by
-     allocation or promotion, which can only happen for blocks
-     allocated recently, which are close to the end of the
-     [entries_global] array. */
-  for (i = ea->young_idx; i < ea->len; i++)
-    caml_oldify_one(ea->t[i].user_data, &ea->t[i].user_data);
-}
+/* Is the current thread currently sampling? */
 
-void caml_memprof_oldify_young_roots(void)
+Caml_inline bool sampling(memprof_domain_t domain)
 {
-  entry_arrays_iter(entry_array_oldify_young_roots, NULL);
-}
+  memprof_thread_t thread = domain->current;
 
-static void entry_array_minor_update(struct entry_array *ea, void *data)
-{
-  uintnat i;
-  (void)data;
-  /* See comment in [entry_array_oldify_young_roots] for the number
-     of iterations of this loop. */
-  for (i = ea->young_idx; i < ea->len; i++) {
-    struct tracked *t = &ea->t[i];
-    CAMLassert(Is_block(t->block) || t->deleted || t->deallocated ||
-               Is_placeholder(t->block));
-    if (Is_block(t->block) && Is_young(t->block)) {
-      if (Hd_val(t->block) == 0) {
-        /* Block has been promoted */
-        t->block = Field(t->block, 0);
-        t->promoted = 1;
-      } else {
-        /* Block is dead */
-        CAMLassert_young_header(Hd_val(t->block));
-        t->block = Val_unit;
-        t->deallocated = 1;
-      }
-    }
+  if (thread && !thread->suspended) {
+    value config = thread_config(thread);
+    return Sampling(config) && !Min_lambda(config);
   }
-  ea->young_idx = ea->len;
+  return false;
 }
 
-void caml_memprof_minor_update(void)
-{
-  if (callback_idx > entries_global.young_idx) {
-    /* The entries after [entries_global.young_idx] will possibly get
-       promoted. Hence, there might be pending promotion callbacks. */
-    callback_idx = entries_global.young_idx;
-    check_action_pending();
-  }
-
-  entry_arrays_iter(entry_array_minor_update, NULL);
-}
+/* Respond to the allocation of a block [block], size [wosize], with
+ * [samples] samples. [src] is one of the [CAML_MEMPROF_SRC_] enum values
+ * ([Gc.Memprof.allocation_source]). */
 
-static void entry_array_do_roots(struct entry_array *ea, void* data)
+static void maybe_track_block(memprof_domain_t domain,
+                              value block, size_t samples,
+                              size_t wosize, int src)
 {
-  scanning_action f = data;
-  uintnat i;
-  for (i = 0; i < ea->len; i++)
-    f(ea->t[i].user_data, &ea->t[i].user_data);
-}
+  if (samples == 0) return;
 
-void caml_memprof_do_roots(scanning_action f)
-{
-  entry_arrays_iter(entry_array_do_roots, f);
+  value callstack = capture_callstack_no_GC(domain);
+  (void)new_entry(&domain->current->entries, block, callstack,
+                  wosize, samples, src, Is_young(block), false);
+  set_action_pending_as_needed(domain);
 }
 
-static void entry_array_clean_phase(struct entry_array *ea, void* data)
+/* Sets the trigger for the next sample in a domain's minor
+ * heap. Could race with sampling and profile-stopping code, so do not
+ * call from another domain unless the world is stopped (at the time
+ * of writing, this is only actually called from this domain). Must be
+ * called after each minor sample and after each minor collection. In
+ * practice, this is called at each minor sample, at each minor
+ * collection, and when sampling is suspended and unsuspended. Extra
+ * calls do not change the statistical properties of the sampling
+ * because of the memorylessness of the geometric distribution. */
+
+void caml_memprof_set_trigger(caml_domain_state *state)
 {
-  uintnat i;
-  (void)data;
-  for (i = 0; i < ea->len; i++) {
-    struct tracked *t = &ea->t[i];
-    if (Is_block(t->block) && !Is_young(t->block)) {
-      CAMLassert(Is_in_heap(t->block));
-      CAMLassert(!t->alloc_young || t->promoted);
-      if (Is_white_val(t->block)) {
-        t->block = Val_unit;
-        t->deallocated = 1;
-      }
+  memprof_domain_t domain = state->memprof;
+  CAMLassert(domain);
+  value *trigger = state->young_start;
+  if (sampling(domain)) {
+    uintnat geom = rand_geom(domain);
+    if (state->young_ptr - state->young_start > geom) {
+      trigger = state->young_ptr - (geom - 1);
     }
   }
-}
-
-void caml_memprof_update_clean_phase(void)
-{
-  entry_arrays_iter(entry_array_clean_phase, NULL);
-  callback_idx = 0;
-  check_action_pending();
-}
-
-static void entry_array_invert(struct entry_array *ea, void *data)
-{
-  uintnat i;
-  (void)data;
-  for (i = 0; i < ea->len; i++)
-    caml_invert_root(ea->t[i].block, &ea->t[i].block);
-}
-
-void caml_memprof_invert_tracked(void)
-{
-  entry_arrays_iter(entry_array_invert, NULL);
-}
-
-/**** Sampling procedures ****/
-
-static void maybe_track_block(value block, uintnat n_samples,
-                              uintnat wosize, int src)
-{
-  value callstack;
-  if (n_samples == 0) return;
 
-  callstack = capture_callstack_postponed();
-  if (callstack == 0) return;
-
-  new_tracked(n_samples, wosize, src, Is_young(block), block, callstack);
-  check_action_pending();
+  CAMLassert(trigger >= state->young_start);
+  CAMLassert(trigger <= state->young_ptr);
+  state->memprof_young_trigger = trigger;
 }
 
-void caml_memprof_track_alloc_shr(value block)
-{
-  CAMLassert(Is_in_heap(block));
-  if (lambda == 0 || local->suspended) return;
-
-  maybe_track_block(block, rand_binom(Whsize_val(block)),
-                    Wosize_val(block), SRC_NORMAL);
-}
+/* Respond to the allocation of any block. Does not call callbacks. */
 
-void caml_memprof_track_custom(value block, mlsize_t bytes)
+void caml_memprof_sample_block(value block,
+                               size_t allocated_words,
+                               size_t sampled_words,
+                               int source)
 {
-  CAMLassert(Is_young(block) || Is_in_heap(block));
-  if (lambda == 0 || local->suspended) return;
-
-  maybe_track_block(block, rand_binom(Wsize_bsize(bytes)),
-                    Wsize_bsize(bytes), SRC_CUSTOM);
+  memprof_domain_t domain = Caml_state->memprof;
+  CAMLassert(domain);
+  CAMLassert(sampled_words >= allocated_words);
+  if (sampling(domain)) {
+    maybe_track_block(domain, block, rand_binom(domain, sampled_words),
+                      allocated_words, source);
+  }
 }
 
-/* Shifts the next sample in the minor heap by [n] words. Essentially,
-   this tells the sampler to ignore the next [n] words of the minor
-   heap. */
-static void shift_sample(uintnat n)
-{
-  if (caml_memprof_young_trigger - Caml_state->young_alloc_start > n)
-    caml_memprof_young_trigger -= n;
-  else
-    caml_memprof_young_trigger = Caml_state->young_alloc_start;
-  caml_reset_young_limit(Caml_state);
-}
+/* Respond to hitting the memprof trigger on the minor heap. May
+ * sample several distinct blocks in the combined allocation. Runs
+ * allocation callbacks. */
 
-/* Called when exceeding the threshold for the next sample in the
-   minor heap, from the C code (the handling is different when called
-   from natively compiled OCaml code). */
-void caml_memprof_track_young(uintnat wosize, int from_caml,
-                              int nallocs, unsigned char* encoded_alloc_lens)
+void caml_memprof_sample_young(uintnat wosize, int from_caml,
+                               int allocs, unsigned char* encoded_lens)
 {
+  CAMLparam0();
+  memprof_domain_t domain = Caml_state->memprof;
+  CAMLassert(domain);
+  memprof_thread_t thread = domain->current;
+  CAMLassert(thread);
+  entries_t entries = &thread->entries;
   uintnat whsize = Whsize_wosize(wosize);
-  value callstack, res = Val_unit;
-  int alloc_idx = 0, i, allocs_sampled = 0;
-  intnat alloc_ofs, trigger_ofs;
-  double saved_lambda = lambda;
+  CAMLlocalresult(res);
+  CAMLlocal1(config);
+  config = entries->config;
 
-  /* If this condition is false, then [caml_memprof_young_trigger] should be
-     equal to [Caml_state->young_alloc_start]. But this function is only
-     called with [Caml_state->young_alloc_start <= Caml_state->young_ptr <
-     caml_memprof_young_trigger], which is contradictory. */
-  CAMLassert(!local->suspended && lambda > 0);
+  /* When a domain is not sampling, the memprof trigger is not
+   * set, so we should not come into this function. */
+  CAMLassert(sampling(domain));
 
   if (!from_caml) {
-    unsigned n_samples = 1 +
-      rand_binom(caml_memprof_young_trigger - 1 - Caml_state->young_ptr);
-    CAMLassert(encoded_alloc_lens == NULL);    /* No Comballoc in C! */
-    caml_memprof_renew_minor_sample();
-    maybe_track_block(Val_hp(Caml_state->young_ptr), n_samples,
-                      wosize, SRC_NORMAL);
-    return;
+    /* Not coming from Caml, so this isn't a comballoc. We know we're
+     * sampling at least once, but maybe more than once. */
+    size_t samples = 1 +
+      rand_binom(domain,
+                 Caml_state->memprof_young_trigger - 1 - Caml_state->young_ptr);
+    CAMLassert(encoded_lens == NULL);
+    maybe_track_block(domain, Val_hp(Caml_state->young_ptr),
+                      samples, wosize, CAML_MEMPROF_SRC_NORMAL);
+    caml_memprof_set_trigger(Caml_state);
+    caml_reset_young_limit(Caml_state);
+    CAMLreturn0;
   }
 
-  /* We need to call the callbacks for this sampled block. Since each
-     callback can potentially allocate, the sampled block will *not*
-     be the one pointed to by [caml_memprof_young_trigger]. Instead,
-     we remember that we need to sample the next allocated word,
-     call the callback and use as a sample the block which will be
-     allocated right after the callback. */
-
-  CAMLassert(Caml_state->young_ptr < caml_memprof_young_trigger &&
-             caml_memprof_young_trigger <= Caml_state->young_ptr + whsize);
-  trigger_ofs = caml_memprof_young_trigger - Caml_state->young_ptr;
-  alloc_ofs = whsize;
-
-  /* Restore the minor heap in a valid state for calling the callbacks.
-     We should not call the GC before these two instructions. */
+  /* The memprof trigger lies in (young_ptr, young_ptr + whsize] */
+  CAMLassert(Caml_state->young_ptr < Caml_state->memprof_young_trigger);
+  CAMLassert(Caml_state->memprof_young_trigger <=
+             Caml_state->young_ptr + whsize);
+
+  /* Trigger offset from the base of the combined allocation. We
+   * reduce this for each sample in this comballoc. Signed so it can
+   * go negative. */
+  intnat trigger_ofs =
+    Caml_state->memprof_young_trigger - Caml_state->young_ptr;
+  /* Sub-allocation offset from the base of the combined
+   * allocation. Signed so we can compare correctly against
+   * trigger_ofs. */
+  intnat alloc_ofs = whsize;
+
+  /* Undo the combined allocation, so that we can allocate callstacks
+   * and in callbacks. */
   Caml_state->young_ptr += whsize;
-  caml_memprof_set_suspended(1); // This also updates the memprof trigger
-
-  /* Perform the sampling of the block in the set of Comballoc'd
-     blocks, insert them in the entries array, and run the
-     callbacks. */
-  for (alloc_idx = nallocs - 1; alloc_idx >= 0; alloc_idx--) {
-    unsigned alloc_wosz = encoded_alloc_lens == NULL ? wosize :
-      Wosize_encoded_alloc_len(encoded_alloc_lens[alloc_idx]);
-    unsigned n_samples = 0;
-    alloc_ofs -= Whsize_wosize(alloc_wosz);
+
+  /* Suspend profiling, so we don't profile allocations of callstacks
+   * or in callbacks. Resets trigger. */
+  update_suspended(domain, true);
+
+  /* Work through the sub-allocations, high address to low address,
+   * identifying which ones are sampled and how many times.  For each
+   * sampled sub-allocation, create an entry in the thread's table. */
+  size_t new_entries = 0; /* useful for debugging */
+  size_t sub_alloc = allocs;
+  do {
+    -- sub_alloc;
+    size_t alloc_wosz =
+      encoded_lens == NULL ? wosize :
+      Wosize_encoded_alloc_len(encoded_lens[sub_alloc]);
+    alloc_ofs -= Whsize_wosize(alloc_wosz); /* base of this sub-alloc */
+
+    /* count samples for this sub-alloc? */
+    size_t samples = 0;
     while (alloc_ofs < trigger_ofs) {
-      n_samples++;
-      trigger_ofs -= rand_geom();
+      ++ samples;
+      trigger_ofs -= rand_geom(domain);
     }
-    if (n_samples > 0) {
-      uintnat t_idx;
-      int stopped;
-
-      callstack = capture_callstack(alloc_idx);
-      t_idx = new_tracked(n_samples, alloc_wosz, SRC_NORMAL, 1,
-                          Placeholder_offs(alloc_ofs), callstack);
-      if (t_idx == Invalid_index) continue;
-      res = run_alloc_callback_exn(t_idx);
-      /* Has [caml_memprof_stop] been called during the callback? */
-      stopped = local->entries.len == 0;
-      if (stopped) {
-        allocs_sampled = 0;
-        if (saved_lambda != lambda) {
-          /* [lambda] changed during the callback. We need to refresh
-             [trigger_ofs]. */
-          saved_lambda = lambda;
-          trigger_ofs = lambda == 0. ? 0 : alloc_ofs - (rand_geom() - 1);
-        }
+
+    if (samples) {
+      value callstack = capture_callstack_GC(domain, sub_alloc);
+      size_t entry =
+        new_entry(entries, (value)alloc_ofs, callstack,
+                  alloc_wosz, samples, CAML_MEMPROF_SRC_NORMAL,
+                  true, true);
+      if (entry != Invalid_index) {
+        ++ new_entries;
       }
-      if (Is_exception_result(res)) break;
-      if (!stopped) allocs_sampled++;
     }
-  }
-
-  CAMLassert(alloc_ofs == 0 || Is_exception_result(res));
-  CAMLassert(allocs_sampled <= nallocs);
-
-  if (!Is_exception_result(res)) {
-    /* The callbacks did not raise. The allocation will take place.
-       We now restore the minor heap in the state needed by
-       [Alloc_small_aux]. */
-    if (Caml_state->young_ptr - whsize < Caml_state->young_trigger) {
+  } while (sub_alloc);
+
+  (void)new_entries; /* this variable is useful to assert */
+  CAMLassert(alloc_ofs == 0);
+  CAMLassert(trigger_ofs <= 0);
+  CAMLassert(new_entries <= allocs);
+
+  /* Run all outstanding callbacks in this thread's table, which
+   * includes these recent allocation callbacks. If one of the
+   * callbacks stops the profile, the other callbacks will still
+   * run. */
+  res = entries_run_callbacks_res(thread, entries);
+
+  /* A callback, or another thread of this domain, may have stopped
+   * the profile and then started another one. This will result in the
+   * entries being transferred to the domain's table which is then
+   * orphaned, deleting all offset entries. In this case,
+   * thread->config will have changed. We will have run the allocation
+   * callbacks up to the one which stopped the old profile. */
+  bool restarted = (config != entries->config);
+
+  /* A callback may have raised an exception. In this case, we are
+   * going to cancel this whole combined allocation and should delete
+   * the newly-created entries (if they are still in our table). */
+  bool cancelled = caml_result_is_exception(res);
+
+  if (!cancelled) {
+    /* No exceptions were raised, so the allocations will
+     * proceed. Make room in the minor heap for the blocks to be
+     * allocated. We must not trigger a GC after this point. */
+    while (Caml_state->young_ptr - whsize < Caml_state->young_trigger) {
       CAML_EV_COUNTER(EV_C_FORCE_MINOR_MEMPROF, 1);
-      caml_gc_dispatch();
+      caml_poll_gc_work();
     }
-
-    /* Re-allocate the blocks in the minor heap. We should not call the
-       GC after this. */
     Caml_state->young_ptr -= whsize;
+  }
+
+  /* If profiling has been stopped and restarted by these callbacks,
+   * the thread's entries table has been transferred to the domain and
+   * orphaned, so must be empty. */
 
-    /* Make sure this block is not going to be sampled again. */
-    shift_sample(whsize);
+  if (restarted) {
+    CAMLassert(entries->size == 0);
   }
 
-  /* Since [local->entries] is local to the current thread, we know for
-     sure that the allocated entries are the [alloc_sampled] last entries of
-     [local->entries]. */
-
-  for (i = 0; i < allocs_sampled; i++) {
-    uintnat idx = local->entries.len-allocs_sampled+i;
-    if (local->entries.t[idx].deleted) continue;
-    if (realloc_entries(&entries_global, 1)) {
-      /* Transfer the entry to the global array. */
-      struct tracked* t = &entries_global.t[entries_global.len];
-      entries_global.len++;
-      *t = local->entries.t[idx];
-
-      if (Is_exception_result(res)) {
-        /* The allocations are cancelled because of the exception,
-           but this callback has already been called. We simulate a
-           deallocation. */
-        t->block = Val_unit;
-        t->deallocated = 1;
-      } else {
-        /* If the execution of the callback has succeeded, then we start the
-           tracking of this block..
-
-           Subtlety: we are actually writing [t->block] with an invalid
-           (uninitialized) block. This is correct because the allocation
-           and initialization happens right after returning from
-           [caml_memprof_track_young]. */
-        t->block = Val_hp(Caml_state->young_ptr + Offs_placeholder(t->block));
-
-        /* We make sure that the action pending flag is not set
-           systematically, which is to be expected, since we created
-           a new block in the global entry array, but this new block
-           does not need promotion or deallocationc callback. */
-        if (callback_idx == entries_global.len - 1)
-          callback_idx = entries_global.len;
+  /* All deleted entries will have been evicted from the thread's
+   * table. This may (often) include the offset entries we've just
+   * created (if an allocation callback returns None, for
+   * example). Any surviving offset entries will still be at the end
+   * of this thread's table. If one of the callbacks has raised an
+   * exception, we will not be allocating the blocks, so these entries
+   * should be deleted (or marked as deallocated if the allocation
+   * callback ran). Otherwise, they must be updated to point to the
+   * blocks which will now be allocated. */
+
+  if (cancelled) {
+    entries_clear_offsets(entries);
+  } else {
+    for (size_t i = 0; i < entries->size; ++i) {
+      entry_t e = &entries->t[i];
+      if (e->offset) { /* an entry we just created */
+        e->block = Val_hp(Caml_state->young_ptr + e->block);
+        e->offset = false;
+        if (i < entries->young) entries->young = i;
       }
     }
-    mark_deleted(&local->entries, idx);
+    /* There are now no outstanding allocation callbacks in the thread's
+     * entries table. Transfer the whole thing to the domain. If this
+     * fails due to allocation failure, the entries stay with the thread,
+     * which is OK. */
+    (void)entries_transfer(entries, &domain->entries);
   }
 
-  flush_deleted(&local->entries);
-  /* We need to reset the suspended flag *after* flushing
-     [local->entries] to make sure the floag is not set back to 1. */
-  caml_memprof_set_suspended(0);
+  /* Unsuspend profiling. Resets trigger. */
+  update_suspended(domain, false);
 
-  if (Is_exception_result(res))
-    caml_raise(Extract_exception(res));
+  (void) caml_get_value_or_raise(res);
+
+  CAMLreturn0;
+}
 
-  /* /!\ Since the heap is in an invalid state before initialization,
-     very little heap operations are allowed until then. */
+/**** Interface with systhread. ****/
 
-  return;
+CAMLexport memprof_thread_t caml_memprof_new_thread(caml_domain_state *state)
+{
+  CAMLassert(state->memprof);
+  return thread_create(state->memprof);
 }
 
-void caml_memprof_track_interned(header_t* block, header_t* blockend)
+CAMLexport memprof_thread_t caml_memprof_main_thread(caml_domain_state *state)
 {
-  header_t *p;
-  value callstack = 0;
-  int is_young = Is_young(Val_hp(block));
-
-  if (lambda == 0 || local->suspended) return;
-
-  p = block;
-  while (1) {
-    uintnat next_sample = rand_geom();
-    header_t *next_sample_p, *next_p;
-    if (next_sample > blockend - p)
-      break;
-    /* [next_sample_p] is the block *following* the next sampled
-       block! */
-    next_sample_p = p + next_sample;
-
-    while (1) {
-      next_p = p + Whsize_hp(p);
-      if (next_p >= next_sample_p) break;
-      p = next_p;
-    }
+  memprof_domain_t domain = state->memprof;
+  CAMLassert(domain);
+  memprof_thread_t thread = domain->threads;
+  CAMLassert(thread);
 
-    if (callstack == 0) callstack = capture_callstack_postponed();
-    if (callstack == 0) break;  /* OOM */
-    new_tracked(rand_binom(next_p - next_sample_p) + 1,
-                Wosize_hp(p), SRC_MARSHAL, is_young, Val_hp(p), callstack);
-    p = next_p;
-  }
-  check_action_pending();
+  /* There should currently be just one thread in this domain */
+  CAMLassert(thread->next == NULL);
+  return thread;
 }
 
-/**** Interface with the OCaml code. ****/
+CAMLexport void caml_memprof_delete_thread(memprof_thread_t thread)
+{
+  /* Transfer entries to the domain. If this fails due to allocation
+   * failure, we will lose the entries.  May discard entries which
+   * haven't run allocation callbacks. */
+  (void)entries_transfer(&thread->entries, &thread->domain->entries);
+  thread_destroy(thread);
+}
 
-static void caml_memprof_init(void)
+CAMLexport void caml_memprof_enter_thread(memprof_thread_t thread)
 {
-  init = 1;
-  xoshiro_init();
+  CAMLassert(thread);
+  thread->domain->current = thread;
+  update_suspended(thread->domain, thread->suspended);
 }
 
-CAMLprim value caml_memprof_start(value lv, value szv, value tracker_param)
+/**** Interface to OCaml ****/
+
+CAMLprim value caml_memprof_start(value lv, value szv, value tracker)
 {
-  CAMLparam3(lv, szv, tracker_param);
+  CAMLparam3(lv, szv, tracker);
+  CAMLlocal1(one_log1m_lambda_v);
 
-  double l = Double_val(lv);
+  double lambda = Double_val(lv);
   intnat sz = Long_val(szv);
 
-  if (started) caml_failwith("Gc.Memprof.start: already started.");
-
-  if (sz < 0 || !(l >= 0.) || l > 1.) /* Checks that [l] is not NAN. */
+  /* Checks that [lambda] is within range (and not NaN). */
+  if (sz < 0 || !(lambda >= 0.0 && lambda <= 1.0))
     caml_invalid_argument("Gc.Memprof.start");
 
-  if (!init) caml_memprof_init();
+  memprof_domain_t domain = Caml_state->memprof;
+  CAMLassert(domain);
+  CAMLassert(domain->current);
 
-  lambda = l;
-  if (l > 0) {
-    one_log1m_lambda = l == 1 ? 0 : 1/caml_log1p(-l);
-    rand_pos = RAND_BLOCK_SIZE;
-    /* next_rand_geom can be zero if the next word is to be sampled,
-       but rand_geom always returns a value >= 1. Subtract 1 to correct. */
-    next_rand_geom = rand_geom() - 1;
+  if (Sampling(thread_config(domain->current))) {
+    caml_failwith("Gc.Memprof.start: already started.");
   }
 
-  caml_memprof_renew_minor_sample();
-
-  callstack_size = sz;
-  started = 1;
+  /* Orphan any surviving tracking entries from a previous profile. */
+  if (!orphans_create(domain)) {
+    caml_raise_out_of_memory();
+  }
 
-  tracker = tracker_param;
-  caml_register_generational_global_root(&tracker);
+  double one_log1m_lambda = lambda == 1.0 ? 0.0 : 1.0/caml_log1p(-lambda);
+  /* Buggy implementations of caml_log1p could produce a
+   * one_log1m_lambda which is positive infinity or NaN, which would
+   * cause chaos in the RNG, so we check against this and set
+   * one_log1m_lambda to negative infinity (which we can test for). We
+   * preserve the user's value of Lambda for inspection or
+   * debugging. */
+  if (!(one_log1m_lambda <= 0.0)) { /* catches NaN, +Inf, +ve */
+    one_log1m_lambda = MIN_ONE_LOG1M_LAMBDA; /* negative infinity */
+  }
 
-  CAMLreturn(Val_unit);
-}
+  one_log1m_lambda_v = caml_copy_double(one_log1m_lambda);
+
+  value config = caml_alloc_shr(CONFIG_FIELDS, 0);
+  caml_initialize(&Field(config, CONFIG_FIELD_STATUS),
+                  Val_int(CONFIG_STATUS_SAMPLING));
+  caml_initialize(&Field(config, CONFIG_FIELD_LAMBDA), lv);
+  caml_initialize(&Field(config, CONFIG_FIELD_1LOG1ML), one_log1m_lambda_v);
+  caml_initialize(&Field(config, CONFIG_FIELD_STACK_FRAMES), szv);
+  for (int i = CONFIG_FIELD_FIRST_CALLBACK;
+       i <= CONFIG_FIELD_LAST_CALLBACK; ++i) {
+    caml_initialize(&Field(config, i), Field(tracker,
+                                             i - CONFIG_FIELD_FIRST_CALLBACK));
+  }
+  CAMLassert(domain->entries.size == 0);
 
-static void empty_entry_array(struct entry_array *ea) {
-  if (ea != NULL) {
-    ea->alloc_len = ea->len = ea->young_idx = ea->delete_idx = 0;
-    caml_stat_free(ea->t);
-    ea->t = NULL;
+  /* Set config pointers of the domain and all its threads */
+  domain->entries.config = config;
+  memprof_thread_t thread = domain->threads;
+  while (thread) {
+    CAMLassert(thread->entries.size == 0);
+    thread->entries.config = config;
+    thread = thread->next;
   }
+
+  /* reset PRNG, generate first batch of random numbers. */
+  rand_init(domain);
+
+  caml_memprof_set_trigger(Caml_state);
+  caml_reset_young_limit(Caml_state);
+  orphans_update_pending(domain);
+  set_action_pending_as_needed(domain);
+
+  CAMLreturn(config);
 }
+
 CAMLprim value caml_memprof_stop(value unit)
 {
-  if (!started) caml_failwith("Gc.Memprof.stop: not started.");
+  memprof_domain_t domain = Caml_state->memprof;
+  CAMLassert(domain);
+  memprof_thread_t thread = domain->current;
+  CAMLassert(thread);
 
-  /* Discard the tracked blocks in the global entries array. */
-  empty_entry_array(&entries_global);
+  /* Final attempt to run allocation callbacks; don't use
+   * caml_memprof_run_callbacks_res as we only really need allocation
+   * callbacks now. */
+  if (!thread->suspended) {
+    update_suspended(domain, true);
+    caml_result res = entries_run_callbacks_res(thread, &thread->entries);
+    update_suspended(domain, false);
+    (void) caml_get_value_or_raise(res);
+  }
 
-  /* Discard the tracked blocks in the local entries array,
-     and set [callback_status] to [CB_STOPPED]. */
-  caml_memprof_th_ctx_iter_hook(th_ctx_memprof_stop, NULL);
+  value config = thread_config(thread);
+  if (config == CONFIG_NONE || Status(config) != CONFIG_STATUS_SAMPLING) {
+    caml_failwith("Gc.Memprof.stop: no profile running.");
+  }
+  Set_status(config, CONFIG_STATUS_STOPPED);
 
-  callback_idx = 0;
+  caml_memprof_set_trigger(Caml_state);
+  caml_reset_young_limit(Caml_state);
 
-  lambda = 0;
-  // Reset the memprof trigger in order to make sure we won't enter
-  // [caml_memprof_track_young].
-  caml_memprof_renew_minor_sample();
-  started = 0;
+  return Val_unit;
+}
 
-  caml_remove_generational_global_root(&tracker);
+CAMLprim value caml_memprof_discard(value config)
+{
+  uintnat status = Status(config);
+  CAMLassert((status == CONFIG_STATUS_STOPPED) ||
+             (status == CONFIG_STATUS_SAMPLING) ||
+             (status == CONFIG_STATUS_DISCARDED));
+
+  switch (status) {
+  case CONFIG_STATUS_STOPPED: /* correct case */
+    break;
+  case CONFIG_STATUS_SAMPLING:
+    caml_failwith("Gc.Memprof.discard: profile not stopped.");
+  case CONFIG_STATUS_DISCARDED:
+    caml_failwith("Gc.Memprof.discard: profile already discarded.");
+  }
 
-  caml_stat_free(callstack_buffer);
-  callstack_buffer = NULL;
-  callstack_buffer_len = 0;
+  Set_status(config, CONFIG_STATUS_DISCARDED);
 
   return Val_unit;
 }
-
-#endif

diff --git a/runtime/meta.c b/runtime/meta.c
index 2d8159e9a2c142ec3ba7dc015597fdfe31b620d9..c3023fe02e27e145442cfee473fcbb92f06ba102 100644 (file)
--- a/runtime/meta.c
+++ b/runtime/meta.c
@@ -131,7 +131,7 @@ CAMLprim value caml_static_release_bytecode(value bc)
 
 CAMLprim value caml_realloc_global(value size)
 {
-  mlsize_t requested_size, actual_size, i;
+  mlsize_t requested_size, actual_size;
   value new_global_data, old_global_data;
   old_global_data = caml_global_data;
 
@@ -143,9 +143,9 @@ CAMLprim value caml_realloc_global(value size)
                      ARCH_INTNAT_PRINTF_FORMAT "u entries\n",
                      requested_size);
     new_global_data = caml_alloc_shr(requested_size, 0);
-    for (i = 0; i < actual_size; i++)
+    for (mlsize_t i = 0; i < actual_size; i++)
       caml_initialize(&Field(new_global_data, i), Field(old_global_data, i));
-    for (i = actual_size; i < requested_size; i++){
+    for (mlsize_t i = actual_size; i < requested_size; i++){
       Field (new_global_data, i) = Val_long (0);
     }
     caml_modify_generational_global_root(&caml_global_data, new_global_data);
@@ -186,12 +186,11 @@ CAMLprim value caml_invoke_traced_function(value codeptr, value env, value arg)
        saved env */
 
   value * osp, * nsp;
-  int i;
 
   osp = Caml_state->current_stack->sp;
   Caml_state->current_stack->sp -= 4;
   nsp = Caml_state->current_stack->sp;
-  for (i = 0; i < 7; i++) nsp[i] = osp[i];
+  for (int i = 0; i < 7; i++) nsp[i] = osp[i];
   nsp[7] = (value) Nativeint_val(codeptr);
   nsp[8] = env;
   nsp[9] = Val_int(0);

diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c
index 0c71c19c75c09b28e112f150452ac0a477ea21c6..875471ae57f0acaa93239adfbcc1b9690131d462 100644 (file)
--- a/runtime/minor_gc.c
+++ b/runtime/minor_gc.c
@@ -15,6 +15,7 @@
 
 #define CAML_INTERNALS
 
+#include <stdbool.h>
 #include <string.h>
 #include <stdio.h>
 
@@ -30,6 +31,7 @@
 #include "caml/globroots.h"
 #include "caml/major_gc.h"
 #include "caml/memory.h"
+#include "caml/memprof.h"
 #include "caml/minor_gc.h"
 #include "caml/misc.h"
 #include "caml/mlvalues.h"
@@ -46,7 +48,7 @@ struct generic_table CAML_TABLE_STRUCT(char);
 CAMLexport atomic_uintnat caml_minor_collections_count;
 CAMLexport atomic_uintnat caml_major_slice_epoch;
 
-static atomic_intnat domains_finished_minor_gc;
+static caml_plat_barrier minor_gc_end_barrier = CAML_PLAT_BARRIER_INITIALIZER;
 
 static atomic_uintnat caml_minor_cycles_started = 0;
 
@@ -240,7 +242,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
   struct oldify_state* st = st_v;
   value result;
   header_t hd;
-  mlsize_t sz, i;
+  mlsize_t sz;
   mlsize_t infix_offset;
   tag_t tag;
 
@@ -271,7 +273,8 @@ static void oldify_one (void* st_v, value v, volatile value *p)
 
   if (tag == Cont_tag) {
     value stack_value = Field(v, 0);
-    CAMLassert(Wosize_hd(hd) == 2 && infix_offset == 0);
+    CAMLassert(Wosize_hd(hd) == 2);
+    CAMLassert(infix_offset == 0);
     result = alloc_shared(st->domain, 2, Cont_tag, Reserved_hd(hd));
     if( try_update_object_header(v, p, result, 0) ) {
       struct stack_info* stk = Ptr_val(stack_value);
@@ -315,8 +318,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
                                     caml_global_heap_state.MARKED);
       #ifdef DEBUG
       {
-        int c;
-        for( c = 0; c < sz ; c++ ) {
+        for (int c = 0; c < sz; c++) {
           Field(result, c) = Val_long(1);
         }
       }
@@ -327,7 +329,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
     sz = Wosize_hd (hd);
     st->live_bytes += Bhsize_hd(hd);
     result = alloc_shared(st->domain, sz, tag, Reserved_hd(hd));
-    for (i = 0; i < sz; i++) {
+    for (mlsize_t i = 0; i < sz; i++) {
       Field(result, i) = Field(v, i);
     }
     CAMLassert (infix_offset == 0);
@@ -336,7 +338,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
       *Hp_val(result) = Make_header(sz, No_scan_tag,
                                     caml_global_heap_state.MARKED);
       #ifdef DEBUG
-      for( i = 0; i < sz ; i++ ) {
+      for(mlsize_t i = 0; i < sz; i++) {
         Field(result, i) = Val_long(1);
       }
       #endif
@@ -386,7 +388,6 @@ CAMLno_tsan_for_perf
 static void oldify_mopup (struct oldify_state* st, int do_ephemerons)
 {
   value v, new_v, f;
-  mlsize_t i;
   caml_domain_state* domain_state = st->domain;
   struct caml_ephe_ref_table ephe_ref_table =
                                     domain_state->minor_tables->ephe_ref;
@@ -407,7 +408,7 @@ again:
     if (Is_block (f) && Is_young(f)) {
       oldify_one (st, f, Op_val (new_v));
     }
-    for (i = 1; i < Wosize_val (new_v); i++){
+    for (mlsize_t i = 1; i < Wosize_val (new_v); i++){
       f = Field(v, i);
       CAMLassert (!Is_debug_tag(f));
       if (Is_block (f) && Is_young(f)) {
@@ -459,8 +460,14 @@ void caml_empty_minor_heap_domain_clear(caml_domain_state* domain)
   domain->extra_heap_resources_minor = 0.0;
 }
 
-void caml_do_opportunistic_major_slice
+/* Try to do a major slice, returns nonzero if there was any work available,
+   used as useful spin work while waiting for synchronisation. The return type
+   is [int] and not [bool] since it is passed as a parameter to
+   [caml_try_run_on_all_domains_with_spin_work]. */
+int caml_do_opportunistic_major_slice
   (caml_domain_state* domain_unused, void* unused);
+static void minor_gc_leave_barrier
+  (caml_domain_state* domain, int participating_count);
 
 void caml_empty_minor_heap_promote(caml_domain_state* domain,
                                    int participating_count,
@@ -485,7 +492,9 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
   CAML_EV_BEGIN(EV_MINOR);
   call_timing_hook(&caml_minor_gc_begin_hook);
 
-  if( participating[0] == Caml_state ) {
+  CAMLassert(domain == Caml_state);
+
+  if( participating[0] == domain ) {
     CAML_EV_BEGIN(EV_MINOR_GLOBAL_ROOTS);
     caml_scan_global_young_roots(oldify_one, &st);
     CAML_EV_END(EV_MINOR_GLOBAL_ROOTS);
@@ -495,7 +504,6 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
 
   if( participating_count > 1 ) {
     int participating_idx = -1;
-    CAMLassert(domain == Caml_state);
 
     for( int i = 0; i < participating_count ; i++ ) {
       if( participating[i] == domain ) {
@@ -569,7 +577,7 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
   }
 
   #ifdef DEBUG
-    caml_global_barrier();
+    caml_global_barrier(participating_count);
     /* At this point all domains should have gone through all remembered set
        entries. We need to verify that all our remembered set entries are now in
        the major heap or promoted */
@@ -586,6 +594,11 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
                              domain, 0);
   CAML_EV_END(EV_MINOR_FINALIZERS_OLDIFY);
 
+  CAML_EV_BEGIN(EV_MINOR_MEMPROF_ROOTS);
+  caml_memprof_scan_roots(&oldify_one, oldify_scanning_flags, &st,
+                          domain, false);
+  CAML_EV_END(EV_MINOR_MEMPROF_ROOTS);
+
   CAML_EV_BEGIN(EV_MINOR_REMEMBERED_SET_PROMOTE);
   oldify_mopup (&st, 1); /* ephemerons promoted here */
   CAML_EV_END(EV_MINOR_REMEMBERED_SET_PROMOTE);
@@ -594,7 +607,7 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
               remembered_roots, st.live_bytes);
 
 #ifdef DEBUG
-  caml_global_barrier();
+  caml_global_barrier(participating_count);
   caml_gc_log("ref_base: %p, ref_ptr: %p",
     self_minor_tables->major_ref.base, self_minor_tables->major_ref.ptr);
   for (r = self_minor_tables->major_ref.base;
@@ -619,11 +632,16 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
   CAML_EV_END(EV_MINOR_LOCAL_ROOTS_PROMOTE);
   CAML_EV_END(EV_MINOR_LOCAL_ROOTS);
 
+  CAML_EV_BEGIN(EV_MINOR_MEMPROF_CLEAN);
+  caml_memprof_after_minor_gc(domain);
+  CAML_EV_END(EV_MINOR_MEMPROF_CLEAN);
+
   domain->young_ptr = domain->young_end;
   /* Trigger a GC poll when half of the minor heap is filled. At that point, a
    * major slice is scheduled. */
   domain->young_trigger = domain->young_start
     + (domain->young_end - domain->young_start) / 2;
+  caml_memprof_set_trigger(domain);
   caml_reset_young_limit(domain);
 
   domain->stat_minor_words += Wsize_bsize (minor_allocated_bytes);
@@ -647,8 +665,10 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
 
   /* arrive at the barrier */
   if( participating_count > 1 ) {
-    atomic_fetch_add_explicit
-      (&domains_finished_minor_gc, 1, memory_order_release);
+    if (caml_plat_barrier_arrive(&minor_gc_end_barrier)
+        == participating_count) {
+      caml_plat_barrier_release(&minor_gc_end_barrier);
+    }
   }
   /* other domains may be executing mutator code from this point, but
      not before */
@@ -660,24 +680,21 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
   CAML_EV_COUNTER(EV_C_MINOR_ALLOCATED, minor_allocated_bytes);
 
   CAML_EV_END(EV_MINOR);
-  caml_gc_log ("Minor collection of domain %d completed: %2.0f%% of %u KB live",
-               domain->id,
-               100.0 * (double)st.live_bytes / (double)minor_allocated_bytes,
-               (unsigned)(minor_allocated_bytes + 512)/1024);
+  if (minor_allocated_bytes == 0)
+    caml_gc_log ("Minor collection of domain %d completed:"
+                 " no minor bytes allocated",
+                 domain->id);
+  else
+    caml_gc_log ("Minor collection of domain %d completed:"
+                 " %2.0f%% of %u KB live",
+                 domain->id,
+                 100.0 * (double)st.live_bytes / (double)minor_allocated_bytes,
+                 (unsigned)(minor_allocated_bytes + 512)/1024);
 
   /* leave the barrier */
   if( participating_count > 1 ) {
     CAML_EV_BEGIN(EV_MINOR_LEAVE_BARRIER);
-    {
-      SPIN_WAIT {
-        if (atomic_load_acquire(&domains_finished_minor_gc) ==
-            participating_count) {
-          break;
-        }
-
-        caml_do_opportunistic_major_slice(domain, 0);
-      }
-    }
+    minor_gc_leave_barrier(domain, participating_count);
     CAML_EV_END(EV_MINOR_LEAVE_BARRIER);
   }
 }
@@ -689,9 +706,9 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
    code, but they cannot have any pointers into our minor heap. */
 static void custom_finalize_minor (caml_domain_state * domain)
 {
-  struct caml_custom_elt *elt;
-  for (elt = domain->minor_tables->custom.base;
-       elt < domain->minor_tables->custom.ptr; elt++) {
+  for (struct caml_custom_elt *elt = domain->minor_tables->custom.base;
+       elt < domain->minor_tables->custom.ptr;
+       elt++) {
     value *v = &elt->block;
     if (Is_block(*v) && Is_young(*v)) {
       if (get_header_val(*v) == 0) { /* value copied to major heap */
@@ -704,26 +721,61 @@ static void custom_finalize_minor (caml_domain_state * domain)
   }
 }
 
-void caml_do_opportunistic_major_slice
-  (caml_domain_state* domain_unused, void* unused)
+/* Increment the counter non-atomically, when it is already known that this
+   thread is alone in trying to increment it. */
+static void nonatomic_increment_counter(atomic_uintnat* counter) {
+  atomic_store_relaxed(counter, 1 + atomic_load_relaxed(counter));
+}
+
+static void minor_gc_leave_barrier
+  (caml_domain_state* domain, int participating_count)
+{
+  /* Spin while we have major work available */
+  SPIN_WAIT_BOUNDED {
+    if (caml_plat_barrier_is_released(&minor_gc_end_barrier)) {
+      return;
+    }
+
+    if (!caml_do_opportunistic_major_slice(domain, 0)) {
+      break;
+    }
+  }
+
+  /* Spin a bit longer, which is far less fruitful if we're waiting on
+     more than one thread */
+  unsigned spins =
+    participating_count == 2 ? Max_spins_long : Max_spins_medium;
+  SPIN_WAIT_NTIMES(spins) {
+    if (caml_plat_barrier_is_released(&minor_gc_end_barrier)) {
+      return;
+    }
+  }
+
+  /* If there's nothing to do, block */
+  caml_plat_barrier_wait(&minor_gc_end_barrier);
+}
+
+int caml_do_opportunistic_major_slice
+  (caml_domain_state* domain_state, void* unused)
 {
-  /* NB: need to put guard around the ev logs to prevent
-    spam when we poll */
-  if (caml_opportunistic_major_work_available()) {
+  int work_available = caml_opportunistic_major_work_available(domain_state);
+  if (work_available) {
+    /* NB: need to put guard around the ev logs to prevent spam when we poll */
     uintnat log_events = atomic_load_relaxed(&caml_verb_gc) & 0x40;
     if (log_events) CAML_EV_BEGIN(EV_MAJOR_MARK_OPPORTUNISTIC);
     caml_opportunistic_major_collection_slice(Major_slice_work_min);
     if (log_events) CAML_EV_END(EV_MAJOR_MARK_OPPORTUNISTIC);
   }
+  return work_available;
 }
 
 /* Make sure the minor heap is empty by performing a minor collection
    if needed.
 */
 void caml_empty_minor_heap_setup(caml_domain_state* domain_unused) {
-  atomic_store_release(&domains_finished_minor_gc, 0);
   /* Increment the total number of minor collections done in the program */
-  atomic_fetch_add (&caml_minor_collections_count, 1);
+  nonatomic_increment_counter (&caml_minor_collections_count);
+  caml_plat_barrier_reset(&minor_gc_end_barrier);
 }
 
 /* must be called within a STW section */
@@ -738,8 +790,8 @@ caml_stw_empty_minor_heap_no_major_slice(caml_domain_state* domain,
   CAMLassert(caml_domain_is_in_stw());
 #endif
 
-  if( participating[0] == Caml_state ) {
-    atomic_fetch_add(&caml_minor_cycles_started, 1);
+  if( participating[0] == domain ) {
+    nonatomic_increment_counter(&caml_minor_cycles_started);
   }
 
   caml_gc_log("running stw empty_minor_heap_promote");
@@ -761,7 +813,7 @@ caml_stw_empty_minor_heap_no_major_slice(caml_domain_state* domain,
 
 #ifdef DEBUG
   {
-    for (uintnat* p = initial_young_ptr; p < (uintnat*)domain->young_end; ++p)
+    for (uintnat *p = initial_young_ptr; p < (uintnat*)domain->young_end; ++p)
       *p = Debug_free_minor;
   }
 #endif
@@ -785,11 +837,9 @@ void caml_empty_minor_heap_no_major_slice_from_stw(
   int participating_count,
   caml_domain_state** participating)
 {
-  barrier_status b = caml_global_barrier_begin();
-  if( caml_global_barrier_is_final(b) ) {
+  Caml_global_barrier_if_final(participating_count) {
     caml_empty_minor_heap_setup(domain);
   }
-  caml_global_barrier_end(b);
 
   /* if we are entering from within a major GC STW section then
      we do not schedule another major collection slice */
@@ -817,7 +867,7 @@ int caml_try_empty_minor_heap_on_all_domains (void)
    minor heap */
 void caml_empty_minor_heaps_once (void)
 {
-  uintnat saved_minor_cycle = atomic_load(&caml_minor_cycles_started);
+  uintnat saved_minor_cycle = atomic_load_relaxed(&caml_minor_cycles_started);
 
   #ifdef DEBUG
   CAMLassert(!caml_domain_is_in_stw());
@@ -827,7 +877,8 @@ void caml_empty_minor_heaps_once (void)
      STW section */
   do {
     caml_try_empty_minor_heap_on_all_domains();
-  } while (saved_minor_cycle == atomic_load(&caml_minor_cycles_started));
+  } while (saved_minor_cycle ==
+           atomic_load_relaxed(&caml_minor_cycles_started));
 }
 
 /* Called by minor allocations when [Caml_state->young_ptr] reaches
@@ -848,7 +899,7 @@ void caml_alloc_small_dispatch (caml_domain_state * dom_st,
     if (flags & CAML_FROM_CAML)
       /* In the case of allocations performed from OCaml, execute
          asynchronous callbacks. */
-      caml_raise_if_exception(caml_do_pending_actions_exn());
+      caml_get_value_or_raise(caml_do_pending_actions_res());
     else {
       /* In the case of allocations performed from C, only perform
          non-delayable actions. */
@@ -869,23 +920,25 @@ void caml_alloc_small_dispatch (caml_domain_state * dom_st,
   /* Re-do the allocation: we now have enough space in the minor heap. */
   dom_st->young_ptr -= whsize;
 
-#if 0
   /* Check if the allocated block has been sampled by memprof. */
-  if (dom_st->young_ptr < caml_memprof_young_trigger) {
+  if (dom_st->young_ptr < dom_st->memprof_young_trigger) {
     if(flags & CAML_DO_TRACK) {
-      caml_memprof_track_young(wosize, flags & CAML_FROM_CAML,
-                               nallocs, encoded_alloc_lens);
-      /* Until the allocation actually takes place, the heap is in an invalid
-         state (see comments in [caml_memprof_track_young]). Hence, very little
-         heap operations are allowed before the actual allocation.
-
-         Moreover, [Caml_state->young_ptr] should not be modified before the
-         allocation, because its value has been used as the pointer to
-         the sampled block.
+      caml_memprof_sample_young(wosize, flags & CAML_FROM_CAML,
+                                nallocs, encoded_alloc_lens);
+      /* Until the allocation actually takes place, the heap is in an
+         invalid state (see comments in [caml_memprof_sample_young]).
+         Hence, very few heap operations are allowed between this point
+         and the actual allocation.
+
+         Specifically, [dom_st->young_ptr] must not now be modified
+         before the allocation, because it has been used to predict
+         addresses of sampled block(s).
       */
-    } else caml_memprof_renew_minor_sample();
+    } else { /* CAML DONT TRACK */
+      caml_memprof_set_trigger(dom_st);
+      caml_reset_young_limit(dom_st);
+    }
   }
-#endif
 }
 
 /* Request a minor collection and enter as if it were an interrupt.

diff --git a/runtime/misc.c b/runtime/misc.c
index caccdc40d43a65d8826de5c600f45c4218ccb45a..f674b97a7bb8c85d984f77fc90fb8294db7e906c 100644 (file)
--- a/runtime/misc.c
+++ b/runtime/misc.c
@@ -15,16 +15,6 @@
 
 #define CAML_INTERNALS
 
-#if defined(_MSC_VER) && _MSC_VER >= 1400 && _MSC_VER < 1700
-/* Microsoft introduced a regression in Visual Studio 2005 (technically it's
-   not present in the Windows Server 2003 SDK which has a pre-release version)
-   and the abort function ceased to be declared __declspec(noreturn). This was
-   fixed in Visual Studio 2012. Trick stdlib.h into not defining abort (this
-   means exit and _exit are not defined either, but they aren't required). */
-#define _CRT_TERMINATE_DEFINED
-__declspec(noreturn) void __cdecl abort(void);
-#endif
-
 #include <stdio.h>
 #include <string.h>
 #include <stdarg.h>
@@ -54,6 +44,9 @@ void caml_failed_assert (char * expr, char_os * file_os, int line)
           (Caml_state_opt != NULL) ? Caml_state_opt->id : -1, file, line, expr);
   fflush(stderr);
   caml_stat_free(file);
+#if __has_builtin(__builtin_trap) || defined(__GNUC__)
+  __builtin_trap();
+#endif
   abort();
 }
 #endif
@@ -182,8 +175,7 @@ int caml_ext_table_add(struct ext_table * tbl, caml_stat_block data)
 
 void caml_ext_table_remove(struct ext_table * tbl, caml_stat_block data)
 {
-  int i;
-  for (i = 0; i < tbl->size; i++) {
+  for (int i = 0; i < tbl->size; i++) {
     if (tbl->contents[i] == data) {
       caml_stat_free(tbl->contents[i]);
       memmove(&tbl->contents[i], &tbl->contents[i + 1],
@@ -195,9 +187,8 @@ void caml_ext_table_remove(struct ext_table * tbl, caml_stat_block data)
 
 void caml_ext_table_clear(struct ext_table * tbl, int free_entries)
 {
-  int i;
   if (free_entries) {
-    for (i = 0; i < tbl->size; i++) caml_stat_free(tbl->contents[i]);
+    for (int i = 0; i < tbl->size; i++) caml_stat_free(tbl->contents[i]);
   }
   tbl->size = 0;
 }
@@ -210,7 +201,8 @@ void caml_ext_table_free(struct ext_table * tbl, int free_entries)
 
 /* Integer arithmetic with overflow detection */
 
-#if ! (__GNUC__ >= 5 || Caml_has_builtin(__builtin_mul_overflow))
+#if ! (__has_builtin(__builtin_mul_overflow) || \
+       defined(__GNUC__) && __GNUC__ >= 5)
 CAMLexport int caml_umul_overflow(uintnat a, uintnat b, uintnat * res)
 {
 #define HALF_SIZE (sizeof(uintnat) * 4)
@@ -280,7 +272,8 @@ void caml_bad_caml_state(void)
    un-instruments function, this simply silences reports when the call stack
    contains a frame matching one of the lines starting with "race:". */
 const char * __tsan_default_suppressions(void) {
-  return "deadlock:caml_plat_lock\n" /* Avoids deadlock inversion messages */
+  return "deadlock:caml_plat_lock_blocking\n" /* Avoids deadlock inversion
+                                                 messages */
          "deadlock:pthread_mutex_lock\n"; /* idem */
 }
 #endif /* WITH_THREAD_SANITIZER */

diff --git a/runtime/obj.c b/runtime/obj.c
index 56db69f5fafa7dd44a5459433895a9f895bdcd87..83b6301d455bb6d949f2cd736c120cfdfe20050e 100644 (file)
--- a/runtime/obj.c
+++ b/runtime/obj.c
@@ -134,7 +134,7 @@ CAMLprim value caml_obj_with_tag(value new_tag_v, value arg)
 {
   CAMLparam2 (new_tag_v, arg);
   CAMLlocal1 (res);
-  mlsize_t sz, i;
+  mlsize_t sz;
   tag_t tg;
 
   sz = Wosize_val(arg);
@@ -145,13 +145,14 @@ CAMLprim value caml_obj_with_tag(value new_tag_v, value arg)
     memcpy(Bp_val(res), Bp_val(arg), sz * sizeof(value));
   } else if (sz <= Max_young_wosize) {
     res = caml_alloc_small(sz, tg);
-    for (i = 0; i < sz; i++) Field(res, i) = Field(arg, i);
+    for (mlsize_t i = 0; i < sz; i++) Field(res, i) = Field(arg, i);
   } else {
     res = caml_alloc_shr(sz, tg);
     /* It is safe to use [caml_initialize] even if [tag == Closure_tag]
        and some of the "values" being copied are actually code pointers.
        That's because the new "value" does not point to the minor heap. */
-    for (i = 0; i < sz; i++) caml_initialize(&Field(res, i), Field(arg, i));
+    for (mlsize_t i = 0; i < sz; i++)
+      caml_initialize(&Field(res, i), Field(arg, i));
     /* Give gc a chance to run, and run memprof callbacks */
     caml_process_pending_actions();
   }

diff --git a/runtime/parsing.c b/runtime/parsing.c
index 11ae99f9bf9b692398bff7e46d913deedd219889..f7687398453917983618d63abbe405b6bf19070f 100644 (file)
--- a/runtime/parsing.c
+++ b/runtime/parsing.c
@@ -75,12 +75,10 @@ struct parser_env {       /* Mirrors parser_env in ../stdlib/parsing.ml */
 
 /* Input codes */
 /* Mirrors parser_input in ../stdlib/parsing.ml */
-#define START 0
-#define TOKEN_READ 1
-#define STACKS_GROWN_1 2
-#define STACKS_GROWN_2 3
-#define SEMANTIC_ACTION_COMPUTED 4
-#define ERROR_DETECTED 5
+enum input_codes {
+  START, TOKEN_READ, STACKS_GROWN_1, STACKS_GROWN_2, SEMANTIC_ACTION_COMPUTED,
+  ERROR_DETECTED,
+};
 
 /* Output codes */
 /* Mirrors parser_output in ../stdlib/parsing.ml */
@@ -167,7 +165,7 @@ CAMLprim value caml_parse_engine(value vtables, value venv,
   int errflag;
   int n, n1, n2, m, state1;
 
-  switch(Int_val(cmd)) {
+  switch((enum input_codes)Int_val(cmd)) {
 
   case START:
     state = 0;
@@ -300,10 +298,8 @@ CAMLprim value caml_parse_engine(value vtables, value venv,
     goto loop;
 
   default:                      /* Should not happen */
-    CAMLassert(0);
-    return RAISE_PARSE_ERROR;   /* Keeps gcc -Wall happy */
+    CAMLunreachable();
   }
-
 }
 
 /* Control printing of debugging info */

diff --git a/runtime/platform.c b/runtime/platform.c
index 5be893f566dd3eb72bc23b04149998e531e879f9..eaa6e18112d7da0e133d13cc3facfd03ca18c391 100644 (file)
--- a/runtime/platform.c
+++ b/runtime/platform.c
@@ -25,6 +25,8 @@
 #include "caml/platform.h"
 #include "caml/fail.h"
 #include "caml/lf_skiplist.h"
+#include "caml/misc.h"
+#include "caml/signals.h"
 #ifdef HAS_SYS_MMAN_H
 #include <sys/mman.h>
 #endif
@@ -77,13 +79,25 @@ void caml_plat_assert_locked(caml_plat_mutex* m)
 #endif
 }
 
+CAMLexport CAMLthread_local int caml_lockdepth = 0;
+
 void caml_plat_assert_all_locks_unlocked(void)
 {
 #ifdef DEBUG
-  if (lockdepth) caml_fatal_error("Locks still locked at termination");
+  if (caml_lockdepth) caml_fatal_error("Locks still locked at termination");
 #endif
 }
 
+CAMLexport void caml_plat_lock_non_blocking_actual(caml_plat_mutex* m)
+{
+  /* Avoid exceptions */
+  caml_enter_blocking_section_no_pending();
+  int rc = pthread_mutex_lock(m);
+  caml_leave_blocking_section();
+  check_err("lock_non_blocking", rc);
+  DEBUG_LOCK(m);
+}
+
 void caml_plat_mutex_free(caml_plat_mutex* m)
 {
   check_err("mutex_free", pthread_mutex_destroy(m));
@@ -98,60 +112,273 @@ static void caml_plat_cond_init_aux(caml_plat_cond *cond)
     _POSIX_MONOTONIC_CLOCK != (-1)
   pthread_condattr_setclock(&attr, CLOCK_MONOTONIC);
 #endif
-  pthread_cond_init(&cond->cond, &attr);
+  pthread_cond_init(cond, &attr);
 }
 
 /* Condition variables */
-void caml_plat_cond_init(caml_plat_cond* cond, caml_plat_mutex* m)
+void caml_plat_cond_init(caml_plat_cond* cond)
 {
   caml_plat_cond_init_aux(cond);
-  cond->mutex = m;
 }
 
-void caml_plat_wait(caml_plat_cond* cond)
+void caml_plat_wait(caml_plat_cond* cond, caml_plat_mutex* mut)
 {
-  caml_plat_assert_locked(cond->mutex);
-  check_err("wait", pthread_cond_wait(&cond->cond, cond->mutex));
+  caml_plat_assert_locked(mut);
+  check_err("wait", pthread_cond_wait(cond, mut));
 }
 
 void caml_plat_broadcast(caml_plat_cond* cond)
 {
-  caml_plat_assert_locked(cond->mutex);
-  check_err("cond_broadcast", pthread_cond_broadcast(&cond->cond));
+  check_err("cond_broadcast", pthread_cond_broadcast(cond));
 }
 
 void caml_plat_signal(caml_plat_cond* cond)
 {
-  caml_plat_assert_locked(cond->mutex);
-  check_err("cond_signal", pthread_cond_signal(&cond->cond));
+  check_err("cond_signal", pthread_cond_signal(cond));
 }
 
 void caml_plat_cond_free(caml_plat_cond* cond)
 {
-  check_err("cond_free", pthread_cond_destroy(&cond->cond));
-  cond->mutex=0;
+  check_err("cond_free", pthread_cond_destroy(cond));
 }
 
+/* Futexes */
 
-/* Memory management */
+#ifdef CAML_PLAT_FUTEX_FALLBACK
+
+/* Condition-variable-based futex implementation, for when a native OS
+   version isn't available. This also illustrates the semantics of the
+   [wait()] and [wake_all()] operations. */
+
+void caml_plat_futex_wait(caml_plat_futex* futex,
+                          caml_plat_futex_value undesired) {
+  caml_plat_lock_blocking(&futex->mutex);
+  while (atomic_load_acquire(&futex->value) == undesired) {
+    caml_plat_wait(&futex->cond, &futex->mutex);
+  }
+  caml_plat_unlock(&futex->mutex);
+}
+
+void caml_plat_futex_wake_all(caml_plat_futex* futex) {
+  caml_plat_lock_blocking(&futex->mutex);
+  caml_plat_broadcast(&futex->cond);
+  caml_plat_unlock(&futex->mutex);
+}
+
+void caml_plat_futex_init(caml_plat_futex* ftx, caml_plat_futex_value value) {
+  ftx->value = value;
+  caml_plat_mutex_init(&ftx->mutex);
+  caml_plat_cond_init(&ftx->cond);
+}
+
+void caml_plat_futex_free(caml_plat_futex* ftx) {
+  caml_plat_mutex_free(&ftx->mutex);
+  check_err("cond_destroy", pthread_cond_destroy(&ftx->cond));
+}
+
+#else /* ! CAML_PLAT_FUTEX_FALLBACK */
+
+/* Platform-specific futex implementation.
+
+   For each platform we define [WAIT(futex_word* ftx, futex_value
+   undesired)] and [WAKE(futex_word* ftx)] in terms of
+   platform-specific syscalls. The exact semantics vary, but these are
+   the weakest expected guarantees:
+
+   - [WAIT()] compares the value at [ftx] to [undesired], and if they
+     are equal, goes to sleep on [ftx].
+
+   - [WAKE()] wakes up all [WAIT()]-ers on [ftx].
+
+   - [WAIT()] must be atomic with respect to [WAKE()], in that if the
+     [WAIT()]-ing thread observes the undesired value and goes to
+     sleep, it will not miss a wakeup from the [WAKE()]-ing thread
+     between the comparison and sleep.
+
+   - [WAIT()]'s initial read of [ftx] is to be treated as being atomic
+     with [memory_order_relaxed]. That is, no memory ordering is
+     guaranteed around it.
+
+   - Spurious wakeups of [WAIT()] may be possible.
+*/
+
+#  if defined(_WIN32)
+#    include <synchapi.h>
+#    define CAML_PLAT_FUTEX_WAIT(ftx, undesired)  \
+  WaitOnAddress((volatile void *)ftx, &undesired, \
+                sizeof(undesired), INFINITE)
+#    define CAML_PLAT_FUTEX_WAKE(ftx)           \
+  WakeByAddressAll((void *)ftx)
+
+#  elif defined(__linux__)
+#    include <linux/futex.h>
+#    include <sys/syscall.h>
+#    define CAML_PLAT_FUTEX_WAIT(ftx, undesired)    \
+  syscall(SYS_futex, ftx, FUTEX_WAIT_PRIVATE,       \
+          /* expected */ undesired,                 \
+          /* timeout */ NULL,                       \
+          /* ignored */ NULL, 0)
+#    define CAML_PLAT_FUTEX_WAKE(ftx)           \
+  syscall(SYS_futex, ftx, FUTEX_WAKE_PRIVATE,   \
+          /* count */ INT_MAX,                  \
+          /* timeout */ NULL,                   \
+          /* ignored */ NULL, 0)
+
+#  elif 0 /* defined(__APPLE__)
+   macOS has [__ulock_(wait|wake)()] which is used in implementations
+   of libc++, (e.g. by LLVM) but the API is private and unstable.
+   Therefore, we currently use the condition variable fallback on
+   macOS. */
+
+#  elif defined(__FreeBSD__)
+#    include <sys/umtx.h>
+#    define CAML_PLAT_FUTEX_WAIT(ftx, undesired) \
+  _umtx_op(ftx, UMTX_OP_WAIT_UINT_PRIVATE,       \
+           /* expected */ undesired,             \
+           /* timeout */ NULL, NULL)
+#    define CAML_PLAT_FUTEX_WAKE(ftx) \
+  _umtx_op(ftx, UMTX_OP_WAKE_PRIVATE, \
+           /* count */ INT_MAX,       \
+           /* unused */ NULL, NULL)
+
+#  elif defined(__OpenBSD__)
+#    include <sys/futex.h>
+#    define CAML_PLAT_FUTEX_WAIT(ftx, undesired)      \
+  futex((volatile uint32_t*)ftx, FUTEX_WAIT_PRIVATE,  \
+        /* expected */ undesired,                     \
+        /* timeout */ NULL,                           \
+        /* ignored */ NULL)
+#    define CAML_PLAT_FUTEX_WAKE(ftx)                \
+  futex((volatile uint32_t*)ftx, FUTEX_WAKE_PRIVATE, \
+        /* count */ INT_MAX,                         \
+        /* ignored */ NULL, NULL)
+
+#  elif 0 /* defined(__NetBSD__)
+   TODO The following code for NetBSD is untested,
+   we currently use the fallback instead. */
+#    include <sys/futex.h>
+#    include <sys/syscall.h>
+#    define CAML_PLAT_FUTEX_WAIT(ftx, undesired)    \
+  syscall(SYS___futex, ftx,                         \
+          FUTEX_WAIT | FUTEX_PRIVATE_FLAG,          \
+          /* expected */ undesired,                 \
+          /* timeout */ NULL,                       \
+          /* ignored */ NULL, 0, 0)
+#    define CAML_PLAT_FUTEX_WAKE(ftx)            \
+  sycall(SYS___futex, ftx,                       \
+         FUTEX_WAKE | FUTEX_PRIVATE_FLAG,        \
+         /* count */ INT_MAX,                    \
+         /* ignored */ NULL, NULL, 0, 0)
+
+#  elif 0 /* defined(__DragonFly__)
+   TODO The following code for DragonFly is untested,
+   we currently use the fallback instead. */
+#    define CAML_PLAT_FUTEX_WAIT(ftx, undesired)        \
+  umtx_sleep((volatile const int*)ftx, undesired, 0)
+#    define CAML_PLAT_FUTEX_WAKE(ftx)               \
+  umtx_wakeup((volatile const int*)ftx, INT_MAX)
+
+#  else
+#    error "No futex implementation available"
+#  endif
+
+void caml_plat_futex_wait(caml_plat_futex* ftx,
+                          caml_plat_futex_value undesired) {
+  while (atomic_load_acquire(&ftx->value) == undesired) {
+    CAML_PLAT_FUTEX_WAIT(&ftx->value, undesired);
+  }
+}
+
+void caml_plat_futex_wake_all(caml_plat_futex* ftx) {
+  CAML_PLAT_FUTEX_WAKE(&ftx->value);
+}
+
+void caml_plat_futex_init(caml_plat_futex* ftx,
+                          caml_plat_futex_value value) {
+  ftx->value = value;
+}
+
+void caml_plat_futex_free(caml_plat_futex* ftx) {
+  (void) ftx; /* noop */
+}
+
+#endif /* CAML_PLAT_FUTEX_FALLBACK */
+
+/* Latches */
+
+void caml_plat_latch_release(caml_plat_binary_latch* latch) {
+  /* if nobody is blocking, release in user-space */
+  if (atomic_exchange(&latch->value, Latch_released)
+      != Latch_unreleased) {
+    /* at least one thread is (going to be) blocked on the futex, notify */
+    caml_plat_futex_wake_all(latch);
+  }
+}
 
-static uintnat round_up(uintnat size, uintnat align) {
-  CAMLassert(Is_power_of_2(align));
-  return (size + align - 1) & ~(align - 1);
+Caml_inline void latchlike_wait(caml_plat_futex *ftx,
+                                caml_plat_futex_value unreleased,
+                                caml_plat_futex_value contested) {
+  /* indicate that we are about to block */
+  caml_plat_futex_value expected = unreleased;
+  (void)atomic_compare_exchange_strong
+    (&ftx->value, &expected, contested);
+  /* ftx is either already released (neither [unreleased] nor
+     [contested]), or we are going to block (== [contested]),
+     [futex_wait()] here will take care of both */
+  caml_plat_futex_wait(ftx, contested);
 }
 
+void caml_plat_latch_wait(caml_plat_binary_latch* latch) {
+  latchlike_wait(latch, Latch_unreleased, Latch_contested);
+}
+
+/* Sense-reversing barrier */
+/* futex states:
+   - X...0 if nobody is blocking (but they may be spinning)
+   - X...1 if anybody is blocking (or about to)
+
+   where X is the sense bit
+ */
+
+void caml_plat_barrier_flip(caml_plat_barrier* barrier,
+                            barrier_status current_sense) {
+  uintnat new_sense = current_sense ^ BARRIER_SENSE_BIT;
+  atomic_store_relaxed(&barrier->arrived, new_sense);
+  /* if a thread observes the flip below, it will also observe the
+     reset counter, since any currently waiting threads will check the
+     futex before leaving, they will see the counter correctly */
+
+  caml_plat_futex_value
+    current_sense_word = (caml_plat_futex_value) current_sense,
+    new_sense_word = (caml_plat_futex_value) new_sense;
+
+  /* if nobody is blocking, flip in user-space */
+  if (atomic_exchange(&barrier->futex.value, new_sense_word)
+      != current_sense_word) {
+    /* a thread is (about to be) blocked, notify */
+    caml_plat_futex_wake_all(&barrier->futex);
+  }
+}
+
+void caml_plat_barrier_wait_sense(caml_plat_barrier* barrier,
+                                  barrier_status sense_bit) {
+  latchlike_wait(&barrier->futex, sense_bit, sense_bit | 1);
+}
+
+/* Memory management */
+
 intnat caml_plat_pagesize = 0;
 intnat caml_plat_mmap_alignment = 0;
 
 uintnat caml_mem_round_up_pages(uintnat size)
 {
-  return round_up(size, caml_plat_pagesize);
+  return caml_round_up(size, caml_plat_pagesize);
 }
 
 #define Is_page_aligned(size) ((size & (caml_plat_pagesize - 1)) == 0)
 
 #ifdef DEBUG
-static struct lf_skiplist mmap_blocks = {NULL};
+static struct lf_skiplist mmap_blocks;
 #endif
 
 #ifndef _WIN32
@@ -222,21 +449,20 @@ void caml_mem_unmap(void* mem, uintnat size)
 #define Slow_sleep_ns    1000000 //  1 ms
 #define Max_sleep_ns  1000000000 //  1 s
 
-unsigned caml_plat_spin_wait(unsigned spins,
-                             const char* file, int line,
-                             const char* function)
+unsigned caml_plat_spin_back_off(unsigned sleep_ns,
+                                 const struct caml_plat_srcloc* loc)
 {
-  unsigned next_spins;
-  if (spins < Min_sleep_ns) spins = Min_sleep_ns;
-  if (spins > Max_sleep_ns) spins = Max_sleep_ns;
-  next_spins = spins + spins / 4;
-  if (spins < Slow_sleep_ns && Slow_sleep_ns <= next_spins) {
-    caml_gc_log("Slow spin-wait loop in %s at %s:%d", function, file, line);
+  if (sleep_ns < Min_sleep_ns) sleep_ns = Min_sleep_ns;
+  if (sleep_ns > Max_sleep_ns) sleep_ns = Max_sleep_ns;
+  unsigned next_sleep_ns = sleep_ns + sleep_ns / 4;
+  if (sleep_ns < Slow_sleep_ns && Slow_sleep_ns <= next_sleep_ns) {
+    caml_gc_log("Slow spin-wait loop in %s at %s:%d",
+                loc->function, loc->file, loc->line);
   }
 #ifdef _WIN32
-  Sleep(spins/1000000);
+  Sleep(sleep_ns/1000000);
 #else
-  usleep(spins/1000);
+  usleep(sleep_ns/1000);
 #endif
-  return next_spins;
+  return next_sleep_ns;
 }

diff --git a/runtime/power.S b/runtime/power.S
index dcd8444b36e1ce71ee950e4b9212e5d73241dec1..e05a612f288d2d0d011c3126a562dfc5c51adbc8 100644 (file)
--- a/runtime/power.S
+++ b/runtime/power.S
@@ -13,6 +13,8 @@
 /*                                                                        */
 /**************************************************************************/
 
+#include "caml/m.h"
+
         .abiversion 2
 
 #if _CALL_ELF != 2
@@ -65,8 +67,26 @@
 
 /* Function definitions */
 
-.macro FUNCTION name
+.macro TEXT_SECTION name
+#if defined(FUNCTION_SECTIONS)
+        .section ".text.caml.\name","ax",@progbits
+#else
         .section ".text"
+#endif
+.endm
+
+#if defined(FUNCTION_SECTIONS)
+        TEXT_SECTION caml_hot.code_begin
+        .globl caml_hot.code_begin
+caml_hot.code_begin:
+
+        TEXT_SECTION caml_hot.code_end
+        .globl caml_hot.code_end
+caml_hot.code_end:
+#endif
+
+.macro FUNCTION name
+        TEXT_SECTION \name
         .globl \name
         .type \name, @function
 \name:
@@ -79,6 +99,20 @@
        .size \name, . - \name
 .endm
 
+/* Function prologue and epilogue */
+
+.macro ENTER_FUNCTION
+   /* Save return address in caller's frame. */
+        mflr    0
+        std     0, LR_SAVE(SP)
+.endm
+
+.macro LEAVE_FUNCTION
+   /* Restore return address. */
+        ld      0, LR_SAVE(SP)
+        mtlr    0
+.endm
+
 /* Accessing global variables.  */
 
 #define LSYMB(glob) .L##glob
@@ -240,9 +274,7 @@
 #if defined(WITH_THREAD_SANITIZER) /* { */
 
 .macro TSAN_SETUP_C_CALL size
-   /* Save return address in caller's frame. */
-        mflr    0
-        std     0, LR_SAVE(SP)
+        ENTER_FUNCTION
    /* Setup new frame for a function call and possibly some register saves. */
         addi    SP, SP, -(RESERVED_STACK + \size)
         std     2, TOC_SAVE(SP)
@@ -251,9 +283,7 @@
 .macro TSAN_CLEANUP_AFTER_C_CALL size
    /* Undo call frame. */
         addi    SP, SP, (RESERVED_STACK + \size)
-   /* Restore return address. */
-        ld      0, LR_SAVE(SP)
-        mtlr    0
+        LEAVE_FUNCTION
 .endm
 
 .macro TSAN_ENTER_FUNCTION
@@ -353,7 +383,7 @@
 
 #endif /* } WITH_THREAD_SANITIZER */
 
-        .section ".text"
+        TEXT_SECTION caml_system__code_begin
         .globl  caml_system__code_begin
 caml_system__code_begin:
 
@@ -361,9 +391,7 @@ caml_system__code_begin:
 /* Desired size is passed in register r27. */
 
 FUNCTION caml_call_realloc_stack
-   /* Save return address in caller's frame. */
-        mflr    0
-        std     0, LR_SAVE(SP)
+        ENTER_FUNCTION
    /* Save all registers, as well as ALLOC_PTR and TRAP_PTR */
         SAVE_ALL_REGS  /* r27 is preserved */
    /* Recover desired size, to be passed in r3 */
@@ -375,8 +403,7 @@ FUNCTION caml_call_realloc_stack
         cmpdi   3, 0
    /* Restore all registers, and also return address */
         RESTORE_ALL_REGS
-        ld      0, LR_SAVE(SP)
-        mtlr    0
+        LEAVE_FUNCTION
    /* Check status */
         beq     1f
    /* Reallocation successful: return to caller */
@@ -389,9 +416,7 @@ ENDFUNCTION caml_call_realloc_stack
 /* Invoke the garbage collector. */
 
 FUNCTION caml_call_gc
-   /* Save return address in caller's frame */
-        mflr    0
-        std     0, LR_SAVE(SP)
+        ENTER_FUNCTION
    /* Save all registers, as well as ALLOC_PTR and TRAP_PTR */
         SAVE_ALL_REGS
         TSAN_ENTER_FUNCTION
@@ -407,8 +432,7 @@ FUNCTION caml_call_gc
         SWITCH_C_TO_OCAML
    /* Restore registers and return to caller */
         RESTORE_ALL_REGS
-        ld      0, LR_SAVE(SP)
-        mtlr    0
+        LEAVE_FUNCTION
         ld      2, TOC_SAVE(SP)
         blr
 ENDFUNCTION caml_call_gc
@@ -586,8 +610,7 @@ FUNCTION caml_raise_exception
         ld      TMP, Caml_state(current_stack)
         ld      SP, Stack_sp(TMP)
     /* Reload return address from caller's frame (for the backtrace) */
-        ld      0, LR_SAVE(SP)
-        mtlr    0
+        LEAVE_FUNCTION
 #if defined(WITH_THREAD_SANITIZER)
     /* Call __tsan_func_exit for every OCaml stack frame exited due to the
        exception */
@@ -875,8 +898,7 @@ ENDFUNCTION caml_callback3_asm
    Preserves old_stack and new_stack registers */
 .macro SWITCH_OCAML_STACKS old_stack, new_stack
     /* Save return address for old_stack */
-        mflr    0
-        std     0, LR_SAVE(SP)
+        ENTER_FUNCTION
     /* Save OCaml SP and exn_handler in the stack info */
         std     SP, Stack_sp(\old_stack)
         std     TRAP_PTR, Stack_exception(\old_stack)
@@ -886,8 +908,7 @@ ENDFUNCTION caml_callback3_asm
     /* restore exn_handler for new stack */
         ld      TRAP_PTR, Stack_exception(\new_stack)
     /* Restore return address for new_stack */
-        ld      0, LR_SAVE(SP)
-        mtlr    0
+        LEAVE_FUNCTION
 .endm
 
 /*
@@ -920,6 +941,7 @@ FUNCTION caml_perform
         SWITCH_C_TO_OCAML
         TSAN_RESTORE_CALLER_REGS
 #endif
+        std     6, 8(4) /* Set the last fiber field in the continuation */
         ld      7, Stack_handler(5)  /* r7 := old stack -> handler */
         ld      8, Handler_parent(7) /* r8 := parent stack */
         cmpdi   8, 0
@@ -1071,8 +1093,7 @@ FUNCTION caml_runstack
      r4: fun
      r5: arg */
     /* save return address and TOC on old stack */
-        mflr    0
-        std     0, LR_SAVE(SP)
+        ENTER_FUNCTION
         std     2, TOC_SAVE_PARENT(SP)
         addi    3, 3, -1   /* r3 := Ptr_val(r3) */
         ld      12, 0(4)   /* r12 := code pointer */
@@ -1139,8 +1160,7 @@ FUNCTION caml_runstack
         ld      12, 0(4) /* code pointer */
         mtctr   12       /* code pointer */
     /* Invoke handle_value (or handle_exn) */
-        ld      0, LR_SAVE(SP)
-        mtlr    0
+        LEAVE_FUNCTION
         bctr
 .Lfiber_exn_handler:
         addi    8, SP, (RESERVED_STACK + 16) /* r8 := stack_handler */
@@ -1152,9 +1172,9 @@ FUNCTION caml_ml_array_bound_error
         TSAN_ENTER_FUNCTION /* needed since we skip caml_c_call entry */
         Addrglobal(C_CALL_FUN, caml_array_bound_error_asm)
         b       .Lcaml_c_call
-ENDFUNCTION caml_resume
+ENDFUNCTION caml_ml_array_bound_error
 
-        .section ".text"
+        TEXT_SECTION caml_system__code_end
         .globl  caml_system__code_end
 caml_system__code_end:
 

diff --git a/runtime/printexc.c b/runtime/printexc.c
index f7fa56a3fa12a3cef4604b55dc6f1df05283c8f8..1b1c768902a617583f7ce773624b94ec17e09b95 100644 (file)
--- a/runtime/printexc.c
+++ b/runtime/printexc.c
@@ -53,7 +53,7 @@ static void add_string(struct stringbuf *buf, const char *s)
 CAMLexport char * caml_format_exception(value exn)
 {
   Caml_check_caml_state();
-  mlsize_t start, i;
+  mlsize_t start, len;
   value bucket, v;
   struct stringbuf buf;
   char intbuf[64];
@@ -75,7 +75,7 @@ CAMLexport char * caml_format_exception(value exn)
       start = 1;
     }
     add_char(&buf, '(');
-    for (i = start; i < Wosize_val(bucket); i++) {
+    for (mlsize_t i = start; i < Wosize_val(bucket); i++) {
       if (i > start) add_string(&buf, ", ");
       v = Field(bucket, i);
       if (Is_long(v)) {
@@ -95,10 +95,10 @@ CAMLexport char * caml_format_exception(value exn)
     add_string(&buf, String_val(Field(exn, 0)));
 
   *buf.ptr = 0;              /* Terminate string */
-  i = buf.ptr - buf.data + 1;
-  res = caml_stat_alloc_noexc(i);
+  len = buf.ptr - buf.data + 1;
+  res = caml_stat_alloc_noexc(len);
   if (res == NULL) return NULL;
-  memmove(res, buf.data, i);
+  memmove(res, buf.data, len);
   return res;
 }
 
@@ -124,7 +124,7 @@ static void default_fatal_uncaught_exception(value exn)
   saved_backtrace_pos = Caml_state->backtrace_pos;
   Caml_state->backtrace_active = 0;
   at_exit = caml_named_value("Pervasives.do_at_exit");
-  if (at_exit != NULL) caml_callback_exn(*at_exit, Val_unit);
+  if (at_exit != NULL) caml_callback_res(*at_exit, Val_unit);
   Caml_state->backtrace_active = saved_backtrace_active;
   Caml_state->backtrace_pos = saved_backtrace_pos;
   /* Display the uncaught exception */

diff --git a/runtime/riscv.S b/runtime/riscv.S
index 8934db0bb395acaa18a574dd8018da5dcec55065..a3b796bc5396ead6ae5ca506e1c8b6de53aca492 100644 (file)
--- a/runtime/riscv.S
+++ b/runtime/riscv.S
@@ -32,27 +32,18 @@
 #define C_ARG_3 a2
 #define C_ARG_4 a3
 
-/* Support for CFI directives */
-
-#if defined(ASM_CFI_SUPPORTED)
-#define CFI_STARTPROC .cfi_startproc
-#define CFI_ENDPROC .cfi_endproc
-#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
-#define CFI_REGISTER(r1,r2) .cfi_register r1,r2
-#define CFI_OFFSET(r,n) .cfi_offset r,n
-#define CFI_DEF_CFA_REGISTER(r) .cfi_def_cfa_register r
-#define CFI_REMEMBER_STATE .cfi_remember_state
-#define CFI_RESTORE_STATE .cfi_restore_state
-#else
-#define CFI_STARTPROC
-#define CFI_ENDPROC
-#define CFI_ADJUST(n)
-#define CFI_REGISTER(r1,r2)
-#define CFI_OFFSET(r,n)
-#define CFI_DEF_CFA_REGISTER(r)
-#define CFI_REMEMBER_STATE
-#define CFI_RESTORE_STATE
-#endif
+
+/* DWARF
+
+   These RISC-V specific register numbers come from
+   Table 19. "DWARF register number encodings" of:
+
+   RISC-V ABIs Specification, Document Version 1.0
+   https://github.com/riscv-non-isa/riscv-elf-psabi-doc/releases/tag/v1.0
+
+*/
+#define DW_REG_s4                 20
+#define DW_REG_sp                 2
 
         .set    domain_curr_field, 0
 #define DOMAIN_STATE(c_type, name) \
@@ -63,10 +54,29 @@
 
 #define Caml_state(var) (8*domain_field_caml_##var)(DOMAIN_STATE_PTR)
 
+#if defined(FUNCTION_SECTIONS)
+#define TEXT_SECTION(name) \
+        .section .text.caml.##name,"ax",@progbits
+#else
+#define TEXT_SECTION(name) \
+        .section .text
+#endif
+
+#if defined(FUNCTION_SECTIONS)
+        TEXT_SECTION(caml_hot.code_begin)
+        .globl caml_hot.code_begin
+caml_hot.code_begin:
+
+        TEXT_SECTION(caml_hot.code_end)
+        .globl caml_hot.code_end
+caml_hot.code_end:
+#endif
+
 /* Globals and labels */
 #define L(lbl) .L##lbl
 
 #define FUNCTION(name) \
+        TEXT_SECTION(name); \
         .align 2; \
         .globl name; \
         .type  name, @function; \
@@ -94,10 +104,28 @@ name:
 #define END_OBJECT(name) \
         .size   name, .-name
 
+#include "../runtime/caml/asm.h"
+
+/* Function prologue and epilogue */
+
+.macro ENTER_FUNCTION
+        CFI_OFFSET(ra, -8)
+        addi    sp, sp, -16
+        sd      ra, 8(sp)
+        CFI_ADJUST(16)
+.endm
+
+.macro LEAVE_FUNCTION
+        ld      ra, 8(sp)
+        addi    sp, sp, 16
+        CFI_ADJUST(-16)
+.endm
+
 /* Stack switching operations */
 
 /* struct stack_info */
 #define Stack_sp(reg)           0(reg)
+#define Stack_sp_offset         0
 #define Stack_exception(reg)    8(reg)
 #define Stack_handler(reg)      16(reg)
 #define Stack_handler_from_cont(reg) 15(reg)
@@ -105,6 +133,7 @@ name:
 /* struct c_stack_link */
 #define Cstack_stack(reg)       0(reg)
 #define Cstack_sp(reg)          8(reg)
+#define Cstack_sp_offset        8
 #define Cstack_prev(reg)        16(reg)
 
 /* struct stack_handler */
@@ -112,6 +141,7 @@ name:
 #define Handler_exception(reg)  8(reg)
 #define Handler_effect(reg)     16(reg)
 #define Handler_parent(reg)     24(reg)
+#define Handler_parent_offset   24
 
 /* Switch from OCaml to C stack. */
 .macro SWITCH_OCAML_TO_C
@@ -124,7 +154,13 @@ name:
         sd      sp, Cstack_sp(TMP2)
     /* Switch to C stack */
         mv      sp, TMP2
+#ifdef ASM_CFI_SUPPORTED
         CFI_REMEMBER_STATE
+    /* sp points to the c_stack_link. */
+        .cfi_escape DW_CFA_def_cfa_expression, 5,                 \
+           DW_OP_breg + DW_REG_sp, Cstack_sp_offset, DW_OP_deref, \
+           DW_OP_plus_uconst, 16 /* fp + retaddr */
+#endif
 .endm
 
 /* Switch from C to OCaml stack. */
@@ -254,27 +290,12 @@ name:
 
 #if defined(WITH_THREAD_SANITIZER) /* { */
 
-/* Push the current value of the return address to the stack. */
-.macro TSAN_SETUP_C_CALL
-        addi    sp, sp, -16
-        CFI_ADJUST(16)
-        CFI_OFFSET(ra, 8)
-        sd      ra, 8(sp)
-.endm
-
-/* Restore the value of the return address from the stack. */
-.macro TSAN_CLEANUP_AFTER_C_CALL
-        ld      ra, 8(sp)
-        addi    sp, sp, 16
-        CFI_ADJUST(-16)
-.endm
-
 /* Invoke a C function, switching back and forth the OCaml and C stacks. */
 .macro TSAN_C_CALL fun
         SWITCH_OCAML_TO_C
-        TSAN_SETUP_C_CALL
+        ENTER_FUNCTION
         call    PLT(\fun)
-        TSAN_CLEANUP_AFTER_C_CALL
+        LEAVE_FUNCTION
         SWITCH_C_TO_OCAML
 .endm
 
@@ -405,18 +426,16 @@ name:
 
 #endif /* } WITH_THREAD_SANITIZER */
 
-        .section        .text
 /* Invoke the garbage collector. */
 
+        TEXT_SECTION(caml_system__code_begin)
         .globl  caml_system__code_begin
 caml_system__code_begin:
 
 FUNCTION(caml_call_realloc_stack)
+        CFI_SIGNAL_FRAME
     /* Save return address */
-        CFI_OFFSET(ra, -8)
-        addi    sp, sp, -16
-        sd      ra, 8(sp)
-        CFI_ADJUST(16)
+        ENTER_FUNCTION
     /* Save all registers (including ALLOC_PTR & TRAP_PTR) */
         SAVE_ALL_REGS
         ld      C_ARG_1, 16(sp) /* argument */
@@ -426,13 +445,11 @@ FUNCTION(caml_call_realloc_stack)
         beqz    a0, 1f
         RESTORE_ALL_REGS
     /* Free stack space and return to caller */
-        ld      ra, 8(sp)
-        addi    sp, sp, 16
+        LEAVE_FUNCTION
         ret
 1:      RESTORE_ALL_REGS
     /* Raise the Stack_overflow exception */
-        ld      ra, 8(sp)
-        addi    sp, sp, 16
+        LEAVE_FUNCTION
         addi    sp, sp, 16 /* pop argument */
         la      a0, caml_exn_Stack_overflow
         j       L(caml_raise_exn)
@@ -440,11 +457,9 @@ END_FUNCTION(caml_call_realloc_stack)
 
 FUNCTION(caml_call_gc)
 L(caml_call_gc):
+        CFI_SIGNAL_FRAME
     /* Save return address */
-        CFI_OFFSET(ra, -8)
-        addi    sp, sp, -16
-        sd      ra, 8(sp)
-        CFI_ADJUST(16)
+        ENTER_FUNCTION
     /* Store all registers (including ALLOC_PTR & TRAP_PTR) */
         SAVE_ALL_REGS
         TSAN_ENTER_FUNCTION
@@ -455,8 +470,7 @@ L(caml_call_gc):
         TSAN_EXIT_FUNCTION
         RESTORE_ALL_REGS
     /* Free stack space and return to caller */
-        ld      ra, 8(sp)
-        addi    sp, sp, 16
+        LEAVE_FUNCTION
         ret
 END_FUNCTION(caml_call_gc)
 
@@ -502,10 +516,8 @@ END_FUNCTION(caml_allocN)
 
 FUNCTION(caml_c_call)
 L(caml_c_call):
-        CFI_OFFSET(ra, -8)
-        addi    sp, sp, -16
-        sd      ra, 8(sp)
-        CFI_ADJUST(16)
+        CFI_SIGNAL_FRAME
+        ENTER_FUNCTION
         TSAN_SAVE_CALLER_REGS
         TSAN_ENTER_FUNCTION
         TSAN_RESTORE_CALLER_REGS
@@ -539,21 +551,18 @@ L(caml_c_call):
         CFI_ADJUST(-32)
 #endif
     /* Return */
-        ld      ra, 8(sp)
-        addi    sp, sp, 16
+        LEAVE_FUNCTION
         RET_FROM_C_CALL
 END_FUNCTION(caml_c_call)
 
 FUNCTION(caml_c_call_stack_args)
+        CFI_SIGNAL_FRAME
     /* Arguments:
         C arguments  : a0 to a7, fa0 to fa7
         C function   : ADDITIONAL_ARG
         C stack args : begin=STACK_ARG_BEGIN
                        end=STACK_ARG_END */
-        CFI_OFFSET(ra, -8)
-        addi    sp, sp, -16
-        sd      ra, 8(sp)
-        CFI_ADJUST(16)
+        ENTER_FUNCTION
     /* Switch from OCaml to C */
         SWITCH_OCAML_TO_C
     /* Make the exception handler alloc ptr available to the C code */
@@ -582,14 +591,14 @@ FUNCTION(caml_c_call_stack_args)
     /* Switch from C to OCaml */
         SWITCH_C_TO_OCAML
     /* Return */
-        ld      ra, 8(sp)
-        addi    sp, sp, 16
+        LEAVE_FUNCTION
         RET_FROM_C_CALL
 END_FUNCTION(caml_c_call_stack_args)
 
 /* Start the OCaml program */
 
 FUNCTION(caml_start_program)
+        CFI_SIGNAL_FRAME
 #if defined(WITH_THREAD_SANITIZER)
         addi    sp, sp, -16
         CFI_ADJUST(16)
@@ -597,9 +606,9 @@ FUNCTION(caml_start_program)
     /* We can't use the TSAN_ENTER_FUNCTION macro here, as it assumes to run
        on an OCaml stack, yet we are still on a C stack at this point. */
         mv      a0, ra
-        TSAN_SETUP_C_CALL
+        ENTER_FUNCTION
         call    PLT(__tsan_func_entry)
-        TSAN_CLEANUP_AFTER_C_CALL
+        LEAVE_FUNCTION
         ld      a0, 0(sp)
         addi    sp, sp, 16
         CFI_ADJUST(-16)
@@ -615,8 +624,10 @@ FUNCTION(caml_start_program)
 
 L(jump_to_caml):
     /* Set up stack frame and save callee-save registers */
+        CFI_OFFSET(s0, -208)
         CFI_OFFSET(ra, -200)
         addi    sp, sp, -208
+        sd      s0, 0(sp)
         sd      ra, 8(sp)
         CFI_ADJUST(208)
         sd      s0, (2*8)(sp)
@@ -650,10 +661,10 @@ L(jump_to_caml):
     /* Build (16-byte aligned) struct c_stack_link on the C stack */
         ld      t2, Caml_state(c_stack)
         addi    sp, sp, -32
+        CFI_ADJUST(32)
         sd      t2, Cstack_prev(sp)
         sd      x0, Cstack_stack(sp)
         sd      x0, Cstack_sp(sp)
-        CFI_ADJUST(32)
         sd      sp, Caml_state(c_stack)
     /* Load the OCaml stack */
         ld      t2, Caml_state(current_stack)
@@ -674,7 +685,18 @@ L(jump_to_caml):
         mv      TRAP_PTR, t2
     /* Switch stacks and call the OCaml code */
         mv      sp, t2
+#ifdef ASM_CFI_SUPPORTED
         CFI_REMEMBER_STATE
+        .cfi_escape DW_CFA_def_cfa_expression, 3 + 2 + 2,             \
+            /* sp points to the exn handler on the OCaml stack */     \
+            /* sp + 16 contains the C_STACK_SP */                     \
+          DW_OP_breg + DW_REG_sp, 16 /* exn handler */, DW_OP_deref,  \
+            /* 32   struct c_stack_link + pad */                      \
+            /* 24*8 callee save regs */                               \
+            /* 16   fp + ret addr */                                  \
+            /* need to split to get under 127 limit */                \
+          DW_OP_plus_uconst, 120, DW_OP_plus_uconst, 120
+#endif
     /* Call the OCaml code */
         jalr    TMP2
 L(caml_retaddr):
@@ -710,9 +732,9 @@ L(return_result):
         CFI_ADJUST(16)
         sd      a0, 0(sp)
         mv      a0, x0
-        TSAN_SETUP_C_CALL
+        ENTER_FUNCTION
         call    PLT(__tsan_func_exit)
-        TSAN_CLEANUP_AFTER_C_CALL
+        LEAVE_FUNCTION
         ld      a0, 0(sp)
         addi    sp, sp, 16
         CFI_ADJUST(-16)
@@ -855,8 +877,7 @@ FUNCTION(caml_raise_exception)
         CFI_ADJUST(-16)
 #endif
     /* Restore frame and link on return to OCaml */
-        ld      ra, 8(sp)
-        addi    sp, sp, 16
+        LEAVE_FUNCTION
         j       L(caml_raise_exn)
 END_FUNCTION(caml_raise_exception)
 
@@ -954,9 +975,7 @@ END_FUNCTION(caml_callback3_asm)
    Preserves old_stack and new_stack registers */
 .macro SWITCH_OCAML_STACKS old_stack, new_stack
     /* Save frame pointer and return address for old_stack */
-        addi    sp, sp, -16
-        sd      ra, 8(sp)
-        CFI_ADJUST(16)
+        ENTER_FUNCTION
     /* Save OCaml SP and exn_handler in the stack info */
         sd      sp, Stack_sp(\old_stack)
         sd      TRAP_PTR, Stack_exception(\old_stack)
@@ -967,8 +986,7 @@ END_FUNCTION(caml_callback3_asm)
     /* restore exn_handler for new stack */
         ld      TRAP_PTR, Stack_exception(\new_stack)
     /* Restore frame pointer and return address for new_stack */
-        ld      ra, 8(sp)
-        addi    sp, sp, 16
+        LEAVE_FUNCTION
 .endm
 
 /*
@@ -997,6 +1015,7 @@ L(do_perform):
         TSAN_C_CALL caml_tsan_exit_on_perform
         TSAN_RESTORE_CALLER_REGS
 #endif
+        sd      a3, 8(a1) /* Set the last fiber field in the continuation */
         ld      t3, Stack_handler(a2)  /* t3 := old stack -> handler */
         ld      t4, Handler_parent(t3) /* t4 := parent stack */
         beqz    t4, 1f
@@ -1135,13 +1154,11 @@ FUNCTION(caml_runstack)
         addi    sp, sp, 32
         CFI_ADJUST(-32)
 #endif
+        CFI_SIGNAL_FRAME
     /*  a0: fiber
         a1: fun
         a2: arg */
-        CFI_OFFSET(ra, -8)
-        addi    sp, sp, -16
-        sd      ra, 8(sp)
-        CFI_ADJUST(16)
+        ENTER_FUNCTION
         addi    a0, a0, -1  /* a0 := Ptr_val(a0) */
         ld      a3, 0(a1)   /* code pointer */
     /*  save old stack pointer and exception handler */
@@ -1164,7 +1181,17 @@ FUNCTION(caml_runstack)
         mv      TRAP_PTR, t3
     /* Switch to the new stack */
         mv      sp, t3
+#ifdef ASM_CFI_SUPPORTED
         CFI_REMEMBER_STATE
+        .cfi_escape DW_CFA_def_cfa_expression, 3+3+2,       \
+          DW_OP_breg + DW_REG_sp,                           \
+            16 /* exn */ +                                  \
+            8 /* gc_regs slot (unused) */ +                 \
+            8 /* C_STACK_SP for DWARF (unused) */           \
+            + Handler_parent_offset, DW_OP_deref,           \
+          DW_OP_plus_uconst, Stack_sp_offset, DW_OP_deref,  \
+          DW_OP_plus_uconst, 16 /* fp + ret addr */
+#endif
     /* Call the function on the new stack */
         mv      a0, a2
         jalr    a3
@@ -1184,6 +1211,7 @@ L(frame_runstack):
         ld      s4, Stack_sp(TMP) /* saved across C call */
         CFI_RESTORE_STATE
         CFI_REMEMBER_STATE
+        CFI_DEF_CFA_REGISTER(DW_REG_s4)
         ld      TMP, Caml_state(c_stack)
         mv      sp, TMP
         call    PLT(caml_free_stack)
@@ -1197,9 +1225,7 @@ L(frame_runstack):
         mv      a1, s2
         ld      TMP, 0(s2)  /* code pointer */
     /* Invoke handle_value (or handle_exn) */
-        ld      ra, 8(sp)
-        addi    sp, sp, 16
-        CFI_ADJUST(-16)
+        LEAVE_FUNCTION
         jr      TMP
 L(fiber_exn_handler):
         addi    t2, sp, 16  /* t2 := stack_handler */
@@ -1214,6 +1240,7 @@ FUNCTION(caml_ml_array_bound_error)
         j       L(caml_c_call)
 END_FUNCTION(caml_ml_array_bound_error)
 
+        TEXT_SECTION(caml_system__code_end)
         .globl  caml_system__code_end
 caml_system__code_end:
 
@@ -1230,3 +1257,6 @@ OBJECT(caml_system.frametable)
         .short  0                 /* no roots */
         .align  3
 END_OBJECT(caml_system.frametable)
+
+/* Mark stack as non-executable */
+        .section .note.GNU-stack,"",%progbits

diff --git a/runtime/roots.c b/runtime/roots.c
index 42dd222149cbf366f448ef36ca58d9704741aeee..30e7f6c57a44452b6ffe0424634c522e4410d478 100644 (file)
--- a/runtime/roots.c
+++ b/runtime/roots.c
@@ -52,14 +52,10 @@ CAMLexport void caml_do_local_roots (
   struct stack_info *current_stack,
   value * v_gc_regs)
 {
-  struct caml__roots_block *lr;
-  int i, j;
-  value* sp;
-
-  for (lr = local_roots; lr != NULL; lr = lr->next) {
-    for (i = 0; i < lr->ntables; i++){
-      for (j = 0; j < lr->nitems; j++){
-        sp = &(lr->tables[i][j]);
+  for (struct caml__roots_block *lr = local_roots; lr != NULL; lr = lr->next) {
+    for (int i = 0; i < lr->ntables; i++) {
+      for (int j = 0; j < lr->nitems; j++) {
+        value* sp = &(lr->tables[i][j]);
         if (*sp != 0) {
           f (fdata, *sp, sp);
         }

diff --git a/runtime/runtime_events.c b/runtime/runtime_events.c
index bc5284f00f2192d39a16a4de6c9408bb81d92328..52c66d87f012ff84c4e2e0b59734e4e07818bd16 100644 (file)
--- a/runtime/runtime_events.c
+++ b/runtime/runtime_events.c
@@ -22,6 +22,7 @@
 #include "caml/memory.h"
 #include "caml/mlvalues.h"
 #include "caml/osdeps.h"
+#include "caml/platform.h"
 #include "caml/startup_aux.h"
 
 #include <fcntl.h>
@@ -64,22 +65,22 @@ potentially only read the ring when some anomalous event occurs. No coordination
 is needed with consumers who read the events - they detect races with the
 producer and discard events when that happens.
 
-The producer code is contained here . By default a <pid>.events file is
-created in the current directory (overridable by setting
-OCAML_RUNTIME_EVENTS_DIR). This file contains a ring buffer for each possible
-domain (Max_domains). It is laid out in a structure that enables sparsity.
-On-disk (or in-memory) footprint is proportional to the max number of concurrent
-domains the process has ever run.
+The producer code is contained here . By default a <pid>.events file is created
+in the current directory (overridable by setting OCAML_RUNTIME_EVENTS_DIR).
+This file contains a ring buffer for each possible domain
+(caml_params->max_domains). It is laid out in a structure that enables sparsity.
+On-disk (or in-memory) footprint is proportional to the max number of
+concurrent domains the process has ever run.
 
 On disk structure:
 
 ----------------------------------------------------------------
 | File header (version, offsets, etc..)                        |
 ----------------------------------------------------------------
-| Ring 0..Max_domains metadata                                 |
+| Ring 0..caml_params->max_domains metadata                     |
 | (head and tail indexes, one per cache line)                  |
 ----------------------------------------------------------------
-| Ring 0..Max_domains data                                     |
+| Ring 0..caml_params->max_domains data                         |
 | (actual ring data, default 2^16 words = 512k bytes)          |
 ----------------------------------------------------------------
 | Custom event IDs                                             |
@@ -129,6 +130,11 @@ static void write_to_ring(ev_category category, ev_message_type type,
 static void events_register_write_buffer(int index, value event_name);
 static void runtime_events_create_from_stw_single(void);
 
+static void stw_teardown_runtime_events(
+  caml_domain_state *domain_state,
+  void *remove_file_data, int num_participating,
+  caml_domain_state **participating_domains);
+
 void caml_runtime_events_init(void) {
 
   caml_plat_mutex_init(&user_events_lock);
@@ -180,21 +186,6 @@ static void runtime_events_teardown_from_stw_single(int remove_file) {
     atomic_store_release(&runtime_events_enabled, 0);
 }
 
-/* Stop-the-world which calls the teardown code */
-static void stw_teardown_runtime_events(
-  caml_domain_state *domain_state,
-  void *remove_file_data, int num_participating,
-  caml_domain_state **participating_domains)
-{
-  caml_global_barrier();
-  if (participating_domains[0] == domain_state) {
-    int remove_file = *(int*)remove_file_data;
-    runtime_events_teardown_from_stw_single(remove_file);
-  }
-  caml_global_barrier();
-}
-
-
 void caml_runtime_events_post_fork(void) {
   /* We are here in the child process after a call to fork (which can only
      happen when there is a single domain) and no mutator code that can spawn a
@@ -214,11 +205,13 @@ void caml_runtime_events_post_fork(void) {
   }
 }
 
-/* Return the current location for the ring buffers of this process. This is
-  used in the consumer to read the ring buffers of the current process */
+/* Return the path of the ring buffers file of this process, or NULL
+   if runtime events are not enabled. This is used in the consumer to
+   read the ring buffers of the current process. Always returns a
+   freshly-allocated string. */
 char_os* caml_runtime_events_current_location(void) {
   if( atomic_load_acquire(&runtime_events_enabled) ) {
-    return current_ring_loc;
+    return caml_stat_strdup_noexc_os(current_ring_loc);
   } else {
     return NULL;
   }
@@ -249,11 +242,11 @@ void caml_runtime_events_destroy(void) {
 static void runtime_events_create_from_stw_single(void) {
   /* Don't initialise runtime_events twice */
   if (!atomic_load_acquire(&runtime_events_enabled)) {
-    int ret, ring_headers_length, ring_data_length;
+    int ring_headers_length, ring_data_length;
 #ifdef _WIN32
     DWORD pid = GetCurrentProcessId();
 #else
-    int ring_fd;
+    int ring_fd, ret;
     long int pid = getpid();
 #endif
 
@@ -270,7 +263,7 @@ static void runtime_events_create_from_stw_single(void) {
     current_ring_total_size =
         RUNTIME_EVENTS_MAX_CUSTOM_EVENTS *
           sizeof(struct runtime_events_custom_event) +
-        Max_domains * (ring_size_words * sizeof(uint64_t) +
+        caml_params->max_domains * (ring_size_words * sizeof(uint64_t) +
                         sizeof(struct runtime_events_buffer_header)) +
         sizeof(struct runtime_events_metadata_header);
 
@@ -287,9 +280,13 @@ static void runtime_events_create_from_stw_single(void) {
 
     if (ring_file_handle == INVALID_HANDLE_VALUE) {
       char* ring_loc_u8 = caml_stat_strdup_of_os(current_ring_loc);
-      caml_fatal_error("Couldn't open ring buffer loc: %s",
-                        ring_loc_u8);
-      caml_stat_free(ring_loc_u8);
+      if (ring_loc_u8) {
+        caml_fatal_error("Couldn't open ring buffer file: %s",
+                         ring_loc_u8);
+        caml_stat_free(ring_loc_u8);
+      } else {
+        caml_fatal_error("Couldn't open ring buffer file");
+      }
     }
 
     ring_handle = CreateFileMapping(
@@ -344,12 +341,12 @@ static void runtime_events_create_from_stw_single(void) {
     close(ring_fd);
 #endif
     ring_headers_length =
-        Max_domains * sizeof(struct runtime_events_buffer_header);
+        caml_params->max_domains * sizeof(struct runtime_events_buffer_header);
     ring_data_length =
-        Max_domains * ring_size_words * sizeof(uint64_t);
+        caml_params->max_domains * ring_size_words * sizeof(uint64_t);
 
     current_metadata->version = RUNTIME_EVENTS_VERSION;
-    current_metadata->max_domains = Max_domains;
+    current_metadata->max_domains = caml_params->max_domains;
     current_metadata->ring_header_size_bytes =
         sizeof(struct runtime_events_buffer_header);
     current_metadata->ring_size_bytes =
@@ -366,9 +363,11 @@ static void runtime_events_create_from_stw_single(void) {
       current_metadata->data_offset + ring_data_length;
 
 
-    for (int domain_num = 0; domain_num < Max_domains; domain_num++) {
+    for (int domain_num = 0; domain_num < caml_params->max_domains;
+         domain_num++) {
       /* we initialise each ring's metadata. We use the offset to the headers
-        and then find the slot for each of domain in Max_domains */
+         and then find the slot for each of domain in caml_params->max_domains
+         */
       struct runtime_events_buffer_header *ring_buffer =
           (struct runtime_events_buffer_header
                 *)((char *)current_metadata +
@@ -381,7 +380,7 @@ static void runtime_events_create_from_stw_single(void) {
 
     // at the same instant: snapshot user_events list and set
     // runtime_events_enabled to 1
-    caml_plat_lock(&user_events_lock);
+    caml_plat_lock_blocking(&user_events_lock);
     value current_user_event = user_events;
     atomic_store_release(&runtime_events_enabled, 1);
     caml_plat_unlock(&user_events_lock);
@@ -401,18 +400,40 @@ static void runtime_events_create_from_stw_single(void) {
   }
 }
 
+/* create/teardown STWs
+
+   The STW API does have an enter barrier before the handler code is
+   run, however, the enter barrier itself calls the runtime events API
+   after arrival, which may otherwise race with code inside the STW
+   section. Thus, the barrier in the STWs below is needed both to
+   ensure that all domains have actually reached the handler before we
+   start/stop (to avoid the aforementioned race), and of course to
+   ensure that the setup/teardown is observed by all domains returning
+   from the STW. */
+
+/* Stop the world section which calls [runtime_events_create_raw], used when we
+   can't be sure there is only a single domain running. */
 static void stw_create_runtime_events(
   caml_domain_state *domain_state, void *unused,
   int num_participating,
   caml_domain_state **participating_domains)
 {
-  caml_global_barrier();
-
-  /* Only do this on one domain */
-  if (participating_domains[0] == domain_state) {
+  /* Everyone must be stopped for starting and stopping runtime_events */
+  Caml_global_barrier_if_final(num_participating) {
     runtime_events_create_from_stw_single();
   }
-  caml_global_barrier();
+}
+
+/* Stop-the-world which calls the teardown code */
+static void stw_teardown_runtime_events(
+  caml_domain_state *domain_state,
+  void *remove_file_data, int num_participating,
+  caml_domain_state **participating_domains)
+{
+  Caml_global_barrier_if_final(num_participating) {
+    int remove_file = *(int*)remove_file_data;
+    runtime_events_teardown_from_stw_single(remove_file);
+  }
 }
 
 CAMLexport void caml_runtime_events_start(void) {
@@ -465,6 +486,23 @@ CAMLprim value caml_ml_runtime_events_resume(value vunit) {
   caml_runtime_events_resume(); return Val_unit;
 }
 
+CAMLprim value caml_ml_runtime_events_path(value vunit) {
+  CAMLparam0();
+  CAMLlocal1 (res);
+  res = Val_none;
+  if (atomic_load_acquire(&runtime_events_enabled)) {
+    res = caml_alloc_small(1, Tag_some);
+    /* The allocation might GC, which could allow another domain to
+     * nuke current_ring_loc, so we check again. */
+    if (atomic_load_acquire(&runtime_events_enabled)) {
+      Field(res, 0) = caml_copy_string_of_os(current_ring_loc);
+    } else {
+      res = Val_none;
+    }
+  }
+  CAMLreturn(res);
+}
+
 CAMLprim value caml_ml_runtime_events_are_active(void) {
   return Val_bool(caml_runtime_events_are_active());
 }
@@ -623,15 +661,13 @@ void caml_ev_alloc(uint64_t sz) {
 }
 
 void caml_ev_alloc_flush(void) {
-  int i;
-
   if ( !ring_is_active() )
     return;
 
   write_to_ring(EV_RUNTIME, (ev_message_type){.runtime=EV_ALLOC}, 0,
                   RUNTIME_EVENTS_NUM_ALLOC_BUCKETS, alloc_buckets, 0);
 
-  for (i = 1; i < RUNTIME_EVENTS_NUM_ALLOC_BUCKETS; i++) {
+  for (int i = 1; i < RUNTIME_EVENTS_NUM_ALLOC_BUCKETS; i++) {
     alloc_buckets[i] = 0;
   }
 }
@@ -684,7 +720,7 @@ CAMLprim value caml_runtime_events_user_register(value event_name,
   Field(event, 3) = event_tag;
 
 
-  caml_plat_lock(&user_events_lock);
+  caml_plat_lock_blocking(&user_events_lock);
   // critical section: when we update the user_events list we need to make sure
   // it is not updated while we construct the pointer to the next element
 
@@ -738,12 +774,12 @@ CAMLprim value caml_runtime_events_user_write(
     value record = Field(event_type, 0);
     value serializer = Field(record, 0);
 
-    res = caml_callback2_exn(serializer, write_buffer, event_content);
+    res = caml_callback2(serializer, write_buffer, event_content);
 
-    if (Is_exception_result(res)) {
-      res = Extract_exception(res);
-      caml_raise(res);
-    }
+    /* Need to check whether the ring is active again as the ring might
+     * potentially have been destroyed during the callback. */
+    if ( !ring_is_active() )
+      CAMLreturn(Val_unit);
 
     uintnat len_bytes = Int_val(res);
     uintnat len_64bit_word = (len_bytes + sizeof(uint64_t)) / sizeof(uint64_t);
@@ -800,7 +836,7 @@ CAMLexport value caml_runtime_events_user_resolve(
   CAMLlocal3(event, cur_event_name, ml_event_name);
 
   // TODO: it might be possible to atomic load instead
-  caml_plat_lock(&user_events_lock);
+  caml_plat_lock_blocking(&user_events_lock);
   value current_user_event = user_events;
   caml_plat_unlock(&user_events_lock);
 

diff --git a/runtime/s390x.S b/runtime/s390x.S
index 113831a376dd7da1b0055371b233ca222f3657f5..e67765bca254dc87c602ce24d2854ff16b9af51b 100644 (file)
--- a/runtime/s390x.S
+++ b/runtime/s390x.S
@@ -37,7 +37,25 @@
 #define G(r) r
 #define GREL(r) r@GOT
 #define GCALL(r) r@PLT
-#define TEXT_SECTION(name)
+
+#if defined(FUNCTION_SECTIONS)
+#define TEXT_SECTION(name) \
+        .section .text.caml.##name,"ax",@progbits
+#else
+#define TEXT_SECTION(name) \
+        .section .text
+#endif
+
+#if defined(FUNCTION_SECTIONS)
+        TEXT_SECTION(caml_hot.code_begin)
+        .globl caml_hot.code_begin
+caml_hot.code_begin:
+
+        TEXT_SECTION(caml_hot.code_end)
+        .globl caml_hot.code_end
+caml_hot.code_end:
+#endif
+
 #define FUNCTION(name) \
         TEXT_SECTION(name); \
         .globl name; \
@@ -46,32 +64,6 @@
 
 #define ENDFUNCTION(name)
 
-#ifdef ASM_CFI_SUPPORTED
-#define CFI_STARTPROC .cfi_startproc
-#define CFI_ENDPROC .cfi_endproc
-#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
-#define CFI_OFFSET(r, n) .cfi_offset r, n
-#define CFI_DEF_CFA_OFFSET(n) .cfi_def_cfa_offset n
-#define CFI_DEF_CFA_REGISTER(r) .cfi_def_cfa_register r
-#define CFI_SAME_VALUE(r) .cfi_same_value r
-#define CFI_SIGNAL_FRAME .cfi_signal_frame
-#define CFI_REMEMBER_STATE .cfi_remember_state
-#define CFI_RESTORE_STATE .cfi_restore_state
-#define CFI_RESTORE(r) .cfi_restore r
-#else
-#define CFI_STARTPROC
-#define CFI_ENDPROC
-#define CFI_ADJUST(n)
-#define CFI_OFFSET(r, n)
-#define CFI_DEF_CFA_OFFSET(n)
-#define CFI_DEF_CFA_REGISTER(r)
-#define CFI_SAME_VALUE(r)
-#define CFI_SIGNAL_FRAME
-#define CFI_REMEMBER_STATE
-#define CFI_RESTORE_STATE
-#define CFI_RESTORE(r)
-#endif
-
 /* Stack space to be reserved by the caller of a C function */
 #define RESERVED_STACK          160
 
@@ -88,8 +80,18 @@
 
 #define RETADDR_ENTRY_SIZE   8 /* retaddr */
 
-#define ENTER_FUNCTION
-#define LEAVE_FUNCTION
+/* Function prologue and epilogue */
+
+#define ENTER_FUNCTION \
+        lay     %r15, -8(%r15); \
+        CFI_ADJUST(8); \
+        stg     %r14, 0(%r15)
+
+#define LEAVE_FUNCTION \
+        lg      %r14, 0(%r15); \
+        CFI_RESTORE(14); \
+        la      %r15, 8(%r15); \
+        CFI_ADJUST(-8)
 
 #define PREPARE_FOR_C_CALL      CFI_REMEMBER_STATE
 #define CLEANUP_AFTER_C_CALL    CFI_RESTORE_STATE
@@ -115,12 +117,7 @@
 /* DWARF */
 /******************************************************************************/
 
-/* These constants are taken from:
-
-     DWARF Debugging Information Format, Version 3
-     http://dwarfstd.org/doc/Dwarf3.pdf
-
-   with the s390-specific register numbers coming from
+/* These s390x-specific register numbers are taken from
    Table 1.17 ("DWARF Register Number Mapping") of:
 
      ELF Application Binary Interface
@@ -129,13 +126,11 @@
      https://github.com/IBM/s390x-abi/releases/download/v1.6/lzsabi_s390x.pdf
 */
 
-#define DW_CFA_def_cfa_expression 0x0f
 #define DW_REG_r9                 9
 #define DW_REG_r12                12
 #define DW_REG_r15                15
-#define DW_OP_breg                0x70
-#define DW_OP_deref               0x06
-#define DW_OP_plus_uconst         0x23
+
+#include "../runtime/caml/asm.h"
 
 /******************************************************************************/
 /* Access to the current domain state block. */
@@ -153,10 +148,9 @@
 
 #define Caml_state(var) 8*domain_field_caml_##var(%r10)
 
-        .section ".text"
-
 /* Invoke the garbage collector. */
 
+        TEXT_SECTION(caml_system__code_begin)
         .globl  caml_system__code_begin
 caml_system__code_begin:
 
@@ -203,9 +197,7 @@ caml_system__code_begin:
 
 #define SWITCH_OCAML_STACKS(old_stack, new_stack) \
     /* Save return address for old_stack */   \
-        lay     %r15, -8(%r15);                                 \
-        stg     %r14, 0(%r15);                                  \
-        CFI_ADJUST(8);                                          \
+        ENTER_FUNCTION;                                         \
     /* Save OCaml SP and exn_handler in the stack info */       \
         stg     %r15, Stack_sp(old_stack);                      \
         stg     TRAP_PTR, Stack_exception(old_stack);           \
@@ -215,8 +207,7 @@ caml_system__code_begin:
     /* restore exn_handler for new stack */                     \
         lg      TRAP_PTR,  Stack_exception(new_stack);          \
     /* Restore return address for new_stack */                  \
-        lg      %r14, 0(%r15);                                  \
-        la      %r15, 8(%r15);
+        LEAVE_FUNCTION
 
 /******************************************************************************/
 /* Allocation */
@@ -291,7 +282,8 @@ caml_system__code_begin:
 #if defined(WITH_THREAD_SANITIZER) /* { */
 
 /* Setup a C call stack frame (which is the caller's duty), and save the
-   current value of the return address to the stack. */
+   current value of the return address to the stack.
+   This is similar to ENTER_FUNCTION, but allocating more stack space. */
 #define TSAN_SETUP_C_CALL                              \
         lay     %r15, -(RESERVED_STACK+8)(%r15);                  \
         CFI_ADJUST(RESERVED_STACK+8);                             \
@@ -382,9 +374,7 @@ caml_system__code_begin:
 FUNCTION(G(caml_call_realloc_stack))
 CFI_STARTPROC
         CFI_SIGNAL_FRAME
-        lay     %r15, -8(%r15)
-        CFI_ADJUST(8)
-        stg     %r14, 0(%r15)
+        ENTER_FUNCTION
         CFI_OFFSET(14, -168)
         SAVE_ALL_REGS
         lgr    C_ARG_1, %r12 /* requested size */
@@ -400,14 +390,11 @@ CFI_STARTPROC
         cgfi    %r2, 0
         je      LBL(120)
         RESTORE_ALL_REGS
-        lg      %r14, 0(%r15)
-        CFI_RESTORE(14)
-        la      %r15, 8(%r15)
+        LEAVE_FUNCTION
         br      %r14
 LBL(120):
         RESTORE_ALL_REGS
-        lg      %r14, 0(%r15)
-        CFI_RESTORE(14)
+        LEAVE_FUNCTION
         LEA_VAR(caml_exn_Stack_overflow, %r2)
         brcl    15, GCALL(caml_raise_exn)
 CFI_ENDPROC
@@ -417,9 +404,7 @@ FUNCTION(G(caml_call_gc))
 CFI_STARTPROC
 LBL(caml_call_gc):
         CFI_SIGNAL_FRAME
-        lay     %r15, -8(%r15)
-        CFI_ADJUST(8)
-        stg     %r14, 0(%r15)
+        ENTER_FUNCTION
         CFI_OFFSET(14, -168)
         SAVE_ALL_REGS
         TSAN_ENTER_FUNCTION
@@ -434,9 +419,7 @@ LBL(caml_call_gc):
         SWITCH_C_TO_OCAML
         TSAN_EXIT_FUNCTION
         RESTORE_ALL_REGS
-        lg      %r14, 0(%r15)
-        CFI_RESTORE(14)
-        la      %r15, 8(%r15)
+        LEAVE_FUNCTION
         br      %r14
 CFI_ENDPROC
 ENDFUNCTION(G(caml_call_gc))
@@ -491,9 +474,7 @@ ENDFUNCTION(G(caml_allocN))
 FUNCTION(G(caml_c_call))
 CFI_STARTPROC
         CFI_SIGNAL_FRAME
-        lay     %r15, -8(%r15)
-        CFI_ADJUST(8)
-        stg     %r14, 0(%r15)
+        ENTER_FUNCTION
         CFI_OFFSET(14, -168)
         TSAN_SAVE_CALLER_REGS
         TSAN_ENTER_FUNCTION
@@ -536,9 +517,7 @@ LBL(caml_c_call):
         CFI_ADJUST(-16)
 #endif
     /* Return to OCaml caller */
-        lg      %r14, 0(%r15)
-        CFI_RESTORE(14)
-        la      %r15, 8(%r15)
+        LEAVE_FUNCTION
         RET_FROM_C_CALL
 CFI_ENDPROC
 ENDFUNCTION(G(caml_c_call))
@@ -546,9 +525,7 @@ ENDFUNCTION(G(caml_c_call))
 FUNCTION(G(caml_c_call_stack_args))
 CFI_STARTPROC
         CFI_SIGNAL_FRAME
-        lay     %r15, -8(%r15)
-        CFI_ADJUST(8)
-        stg     %r14, 0(%r15)
+        ENTER_FUNCTION
         CFI_OFFSET(14, -168)
     /* Arguments:
         C arguments         : %r2, %r3, %r4, %r5, %r6
@@ -590,9 +567,7 @@ LBL(106):
     /* Switch from C to OCaml */
         SWITCH_C_TO_OCAML
     /* Return */
-        lg      %r14, 0(%r15)
-        CFI_RESTORE(14)
-        la      %r15, 8(%r15)
+        LEAVE_FUNCTION
         RET_FROM_C_CALL
 CFI_ENDPROC
 ENDFUNCTION(G(caml_c_call_stack_args))
@@ -842,9 +817,7 @@ CFI_STARTPROC
         CFI_ADJUST(-8)
 #endif
     /* Restore frame and link on return to OCaml */
-        lg      %r14, 0(%r15)
-        CFI_RESTORE(14)
-        la      %r15, 8(%r15)
+        LEAVE_FUNCTION
         brcl    15, LBL(caml_raise_exn)
 CFI_ENDPROC
 ENDFUNCTION(G(caml_raise_exception))
@@ -975,6 +948,7 @@ LBL(do_perform):
         TSAN_C_CALL(caml_tsan_exit_on_perform)
         TSAN_RESTORE_CALLER_REGS
 #endif
+        stg     %r5, 8(%r3) /* Set the last fiber field in the continuation */
         lg      %r9, Stack_handler(%r4)  /* %r9 := old stack -> handler */
         lg      %r8, Handler_parent(%r9)
         clgfi   %r8, 0   /* %r8 := parent stack; is parent NULL? */
@@ -1119,11 +1093,8 @@ CFI_STARTPROC
         CFI_ADJUST(-24)
 #endif
         CFI_SIGNAL_FRAME
-        lay     %r15, -8(%r15)
-        CFI_ADJUST(8)
-        stg     %r14, 0(%r15)
-        CFI_OFFSET(14, -168)
         ENTER_FUNCTION
+        CFI_OFFSET(14, -168)
     /* %r2 -> fiber, %r3 -> fun, %r4 -> arg */
         lay     %r2, -1(%r2)  /* %r2 (new stack) = Ptr_val(%r2) */
         lg      %r5,  0(%r3)  /* code pointer */
@@ -1199,9 +1170,7 @@ LBL(caml_runstack_1):
         lgr     %r3,  %r7
         lg      TMP, 0(%r3) /* code pointer */
     /* Invoke handle_value (or handle_exn) */
-        lg      %r14, 0(%r15)
-        CFI_RESTORE(14)
-        la      %r15, 8(%r15)
+        LEAVE_FUNCTION
         br      TMP
 LBL(fiber_exn_handler):
         lay     %r8, 16(%r15)
@@ -1212,11 +1181,8 @@ ENDFUNCTION(G(caml_runstack))
 
 FUNCTION(G(caml_ml_array_bound_error))
 CFI_STARTPROC
-        lay     %r15, -8(%r15)
-        CFI_ADJUST(8)
-        stg     %r14, 0(%r15)
-        CFI_OFFSET(14, -168)
         ENTER_FUNCTION
+        CFI_OFFSET(14, -168)
     /* No registers require saving before C call to TSan */
         TSAN_ENTER_FUNCTION
         LEA_VAR(caml_array_bound_error_asm, ADDITIONAL_ARG)
@@ -1226,6 +1192,7 @@ CFI_STARTPROC
 CFI_ENDPROC
 ENDFUNCTION(G(caml_ml_array_bound_error))
 
+        TEXT_SECTION(caml_system__code_end)
         .globl  caml_system__code_end
 caml_system__code_end:
 

diff --git a/runtime/sak.c b/runtime/sak.c
index 35a9b19b57160946adb682debfc245ba29183971..029ca5258d8e0656ce66a0ef2d5a271fd1975c37 100644 (file)
--- a/runtime/sak.c
+++ b/runtime/sak.c
@@ -28,18 +28,6 @@
 #include <string.h>
 #include <ctype.h>
 
-#ifdef _WIN32
-#define strncmp_os wcsncmp
-#define toupper_os towupper
-#define printf_os wprintf
-#else
-#define strncmp_os strncmp
-/* NOTE: See CAVEATS section in https://man.netbsd.org/ctype.3 */
-/* and NOTE section in https://man7.org/linux/man-pages/man3/toupper.3.html */
-#define toupper_os(x) toupper((unsigned char)x)
-#define printf_os printf
-#endif
-
 /* Operations
    - encode-C-literal. Used for the OCAML_STDLIB_DIR macro in
      runtime/build_config.h to ensure the LIBDIR make variable is correctly
@@ -51,7 +39,7 @@
      `L"C:\\OCaml\xd83d\xdc2b\\lib"`
  */
 
-void usage(void)
+static void usage(void)
 {
   printf(
     "OCaml Build System Swiss Army Knife\n"
@@ -63,7 +51,7 @@ void usage(void)
 
 /* Converts the supplied path (UTF-8 on Unix and UCS-2ish on Windows) to a valid
    C string literal. On Windows, this is always a wchar_t* (L"..."). */
-void encode_C_literal(char_os *path)
+static void encode_C_literal(const char_os * path)
 {
   char_os c;
 

diff --git a/runtime/shared_heap.c b/runtime/shared_heap.c
index 44d4aa5f970373c76e3ca8e629224e054609f7dd..8398e5590189c38433c3e79371bb3d938a5c961d 100644 (file)
--- a/runtime/shared_heap.c
+++ b/runtime/shared_heap.c
@@ -15,6 +15,7 @@
 /**************************************************************************/
 #define CAML_INTERNALS
 
+#include <stdbool.h>
 #include <stdlib.h>
 #include <string.h>
 #include <assert.h>
@@ -27,6 +28,7 @@
 #include "caml/globroots.h"
 #include "caml/major_gc.h"
 #include "caml/memory.h"
+#include "caml/memprof.h"
 #include "caml/mlvalues.h"
 #include "caml/platform.h"
 #include "caml/roots.h"
@@ -112,12 +114,11 @@ static void adopt_pool_stats_with_lock(struct caml_heap_state *,
                                        pool *, sizeclass);
 
 struct caml_heap_state* caml_init_shared_heap (void) {
-  int i;
   struct caml_heap_state* heap;
 
   heap = caml_stat_alloc_noexc(sizeof(struct caml_heap_state));
   if(heap != NULL) {
-    for (i = 0; i<NUM_SIZECLASSES; i++) {
+    for (int i = 0; i<NUM_SIZECLASSES; i++) {
       heap->avail_pools[i] = heap->full_pools[i] =
         heap->unswept_avail_pools[i] = heap->unswept_full_pools[i] = 0;
     }
@@ -146,10 +147,9 @@ static int move_all_pools(pool** src, _Atomic(pool*)* dst,
 }
 
 void caml_teardown_shared_heap(struct caml_heap_state* heap) {
-  int i;
   int released = 0, released_large = 0;
-  caml_plat_lock(&pool_freelist.lock);
-  for (i = 0; i < NUM_SIZECLASSES; i++) {
+  caml_plat_lock_blocking(&pool_freelist.lock);
+  for (int i = 0; i < NUM_SIZECLASSES; i++) {
     released +=
       move_all_pools(&heap->avail_pools[i],
                      &pool_freelist.global_avail_pools[i], NULL);
@@ -183,7 +183,7 @@ void caml_teardown_shared_heap(struct caml_heap_state* heap) {
 static pool* pool_acquire(struct caml_heap_state* local) {
   pool* r;
 
-  caml_plat_lock(&pool_freelist.lock);
+  caml_plat_lock_blocking(&pool_freelist.lock);
   if (!pool_freelist.free) {
     void* mem = caml_mem_map(Bsize_wsize(POOL_WSIZE), 0);
 
@@ -214,7 +214,7 @@ static void pool_release(struct caml_heap_state* local,
   CAMLassert(pool->sz == sz);
   local->stats.pool_words -= POOL_WSIZE;
   local->stats.pool_frag_words -= POOL_HEADER_WSIZE + wastage_sizeclass[sz];
-  caml_plat_lock(&pool_freelist.lock);
+  caml_plat_lock_blocking(&pool_freelist.lock);
   pool->next = pool_freelist.free;
   pool_freelist.free = pool;
   caml_plat_unlock(&pool_freelist.lock);
@@ -305,7 +305,7 @@ static pool* pool_global_adopt(struct caml_heap_state* local, sizeclass sz)
     return NULL;
 
   /* Haven't managed to find a pool locally, try the global ones */
-  caml_plat_lock(&pool_freelist.lock);
+  caml_plat_lock_blocking(&pool_freelist.lock);
   if( atomic_load_relaxed(&pool_freelist.global_avail_pools[sz]) ) {
     r = atomic_load_relaxed(&pool_freelist.global_avail_pools[sz]);
 
@@ -460,8 +460,7 @@ value* caml_shared_try_alloc(struct caml_heap_state* local, mlsize_t wosize,
   CAML_TSAN_ANNOTATE_HAPPENS_BEFORE(p);
 #ifdef DEBUG
   {
-    int i;
-    for (i = 0; i < wosize; i++) {
+    for (int i = 0; i < wosize; i++) {
       Field(Val_hp(p), i) = Debug_free_major;
     }
   }
@@ -473,7 +472,7 @@ value* caml_shared_try_alloc(struct caml_heap_state* local, mlsize_t wosize,
 
 static intnat pool_sweep(struct caml_heap_state* local, pool** plist,
                          sizeclass sz, int release_to_global_pool) {
-  intnat work = 0;
+  intnat work;
   pool* a = *plist;
   if (!a) return 0;
   *plist = a->next;
@@ -485,7 +484,11 @@ static intnat pool_sweep(struct caml_heap_state* local, pool** plist,
     int all_used = 1;
     struct heap_stats* s = &local->stats;
 
-    while (p + wh <= end) {
+    /* conceptually, this is incremented by [wh] for every iteration
+       below, however we can hoist these increments knowing that [p ==
+       end] on exit from the loop (as asserted) */
+    work = end - p;
+    do {
       header_t hd = (header_t)atomic_load_relaxed((atomic_uintnat*)p);
       if (hd == 0) {
         /* already on freelist */
@@ -501,12 +504,8 @@ static intnat pool_sweep(struct caml_heap_state* local, pool** plist,
         p[1] = (value)a->next_obj;
         CAMLassert(Is_block((value)p));
 #ifdef DEBUG
-        {
-          int i;
-          mlsize_t wo = Wosize_whsize(wh);
-          for (i = 1; i < wo; i++) {
-            Field(Val_hp(p), i) = Debug_free_major;
-          }
+        for (mlsize_t i = 1, wo = Wosize_whsize(wh); i < wo; i++) {
+          Field(Val_hp(p), i) = Debug_free_major;
         }
 #endif
         a->next_obj = (value*)p;
@@ -521,8 +520,8 @@ static intnat pool_sweep(struct caml_heap_state* local, pool** plist,
         release_to_global_pool = 0;
       }
       p += wh;
-      work += wh;
-    }
+    } while (p + wh <= end);
+    CAMLassert(p == end);
 
     if (release_to_global_pool) {
       pool_release(local, a, sz);
@@ -673,7 +672,7 @@ void caml_collect_heap_stats_sample(
 /* Add the orphan pool stats to a stats accumulator. */
 void caml_accum_orphan_heap_stats(struct heap_stats* acc)
 {
-  caml_plat_lock(&pool_freelist.lock);
+  caml_plat_lock_blocking(&pool_freelist.lock);
   caml_accum_heap_stats(acc, &pool_freelist.stats);
   caml_plat_unlock(&pool_freelist.lock);
 }
@@ -980,7 +979,7 @@ void caml_compact_heap(caml_domain_state* domain_state,
   filled pools, determine pools to be evacuated and then evacuate from them.
   For the first phase we need not consider full pools, they
   cannot be evacuated to or from. */
-  caml_global_barrier();
+  caml_global_barrier(participating_count);
   CAML_EV_BEGIN(EV_COMPACT_EVACUATE);
 
   struct caml_heap_state* heap = Caml_state->shared_heap;
@@ -1207,7 +1206,7 @@ void caml_compact_heap(caml_domain_state* domain_state,
   }
 
   CAML_EV_END(EV_COMPACT_EVACUATE);
-  caml_global_barrier();
+  caml_global_barrier(participating_count);
   CAML_EV_BEGIN(EV_COMPACT_FORWARD);
 
   /* Second phase: at this point all live blocks in evacuated pools
@@ -1222,6 +1221,10 @@ void caml_compact_heap(caml_domain_state* domain_state,
   /* First we do roots (locals and finalisers) */
   caml_do_roots(&compact_update_value, 0, NULL, Caml_state, 1);
 
+  /* Memprof roots and "weak" pointers to tracked blocks */
+  caml_memprof_scan_roots(&compact_update_value, 0, NULL,
+                          Caml_state, true);
+
   /* Next, one domain does the global roots */
   if (participants[0] == Caml_state) {
     caml_scan_global_roots(&compact_update_value, NULL);
@@ -1234,7 +1237,7 @@ void caml_compact_heap(caml_domain_state* domain_state,
   }
 
   /* Large allocations */
-  for (large_alloc* la = heap->unswept_large; la != NULL; la = la->next) {
+  for (large_alloc *la = heap->unswept_large; la != NULL; la = la->next) {
     header_t* p = (header_t*)((char*)la + LARGE_ALLOC_HEADER_SZ);
     if (Has_status_val(Val_hp(p), caml_global_heap_state.UNMARKED)) {
       compact_update_block(p);
@@ -1247,7 +1250,7 @@ void caml_compact_heap(caml_domain_state* domain_state,
   compact_update_ephe_list(&ephe_info->live);
 
   CAML_EV_END(EV_COMPACT_FORWARD);
-  caml_global_barrier();
+  caml_global_barrier(participating_count);
   CAML_EV_BEGIN(EV_COMPACT_RELEASE);
 
   /* Third phase: free all evacuated pools and release the mappings back to
@@ -1272,14 +1275,14 @@ void caml_compact_heap(caml_domain_state* domain_state,
   }
 
   CAML_EV_END(EV_COMPACT_RELEASE);
-  caml_global_barrier();
+  caml_global_barrier(participating_count);
 
   /* Fourth phase: one domain also needs to release the free list */
   if( participants[0] == Caml_state ) {
     pool* cur_pool;
     pool* next_pool;
 
-    caml_plat_lock(&pool_freelist.lock);
+    caml_plat_lock_blocking(&pool_freelist.lock);
     cur_pool = pool_freelist.free;
 
     while( cur_pool ) {
@@ -1314,8 +1317,7 @@ struct mem_stats {
 };
 
 static void verify_pool(pool* a, sizeclass sz, struct mem_stats* s) {
-  value* v;
-  for (v = a->next_obj; v; v = (value*)v[1]) {
+  for (value *v = a->next_obj; v; v = (value *)v[1]) {
     CAMLassert(*v == 0);
   }
 
@@ -1357,18 +1359,16 @@ static void verify_large(large_alloc* a, struct mem_stats* s) {
 }
 
 static void verify_swept (struct caml_heap_state* local) {
-  int i;
   struct mem_stats pool_stats = {0,}, large_stats = {0,};
 
   /* sweeping should be done by this point */
   CAMLassert(local->next_to_sweep == NUM_SIZECLASSES);
-  for (i = 0; i < NUM_SIZECLASSES; i++) {
-    pool* p;
-    CAMLassert(local->unswept_avail_pools[i] == NULL &&
-               local->unswept_full_pools[i] == NULL);
-    for (p = local->avail_pools[i]; p; p = p->next)
+  for (int i = 0; i < NUM_SIZECLASSES; i++) {
+    CAMLassert(local->unswept_avail_pools[i] == NULL);
+    CAMLassert(local->unswept_full_pools[i] == NULL);
+    for (pool *p = local->avail_pools[i]; p; p = p->next)
       verify_pool(p, i, &pool_stats);
-    for (p = local->full_pools[i]; p; p = p->next) {
+    for (pool *p = local->full_pools[i]; p; p = p->next) {
       CAMLassert(p->next_obj == NULL);
       verify_pool(p, i, &pool_stats);
     }
@@ -1410,10 +1410,10 @@ void caml_cycle_heap_from_stw_single (void) {
 }
 
 void caml_cycle_heap(struct caml_heap_state* local) {
-  int i, received_p = 0, received_l = 0;
+  int received_p = 0, received_l = 0;
 
   caml_gc_log("Cycling heap [%02d]", local->owner->id);
-  for (i = 0; i < NUM_SIZECLASSES; i++) {
+  for (int i = 0; i < NUM_SIZECLASSES; i++) {
     CAMLassert(local->unswept_avail_pools[i] == NULL);
     local->unswept_avail_pools[i] = local->avail_pools[i];
     local->avail_pools[i] = NULL;
@@ -1425,8 +1425,8 @@ void caml_cycle_heap(struct caml_heap_state* local) {
   local->unswept_large = local->swept_large;
   local->swept_large = NULL;
 
-  caml_plat_lock(&pool_freelist.lock);
-  for (i = 0; i < NUM_SIZECLASSES; i++) {
+  caml_plat_lock_blocking(&pool_freelist.lock);
+  for (int i = 0; i < NUM_SIZECLASSES; i++) {
     received_p += move_all_pools(
         (pool**)&pool_freelist.global_avail_pools[i],
         (_Atomic(pool*)*)&local->unswept_avail_pools[i],

diff --git a/runtime/signals.c b/runtime/signals.c
index b567bc2e850cc0f02934e935a51dcd293d3ae30a..ab6106beae0b1508856e2db39ae0a38f6ef13e9c 100644 (file)
--- a/runtime/signals.c
+++ b/runtime/signals.c
@@ -30,6 +30,7 @@
 #include "caml/memory.h"
 #include "caml/misc.h"
 #include "caml/mlvalues.h"
+#include "caml/platform.h"
 #include "caml/roots.h"
 #include "caml/signals.h"
 #include "caml/sys.h"
@@ -48,8 +49,7 @@ static caml_plat_mutex signal_install_mutex = CAML_PLAT_MUTEX_INITIALIZER;
 
 CAMLexport int caml_check_pending_signals(void)
 {
-  int i;
-  for (i = 0; i < NSIG_WORDS; i++) {
+  for (int i = 0; i < NSIG_WORDS; i++) {
     if (atomic_load_relaxed(&caml_pending_signals[i]))
       return 1;
   }
@@ -58,11 +58,10 @@ CAMLexport int caml_check_pending_signals(void)
 
 /* Execute all pending signals */
 
-CAMLexport value caml_process_pending_signals_exn(void)
+CAMLexport caml_result caml_process_pending_signals_res(void)
 {
-  int i, j, signo;
+  int signo;
   uintnat curr, mask ;
-  value exn;
 #ifdef POSIX_SIGNALS
   sigset_t set;
 #endif
@@ -70,17 +69,17 @@ CAMLexport value caml_process_pending_signals_exn(void)
   /* Check that there is indeed a pending signal before issuing the
       syscall in [pthread_sigmask]. */
   if (!caml_check_pending_signals())
-    return Val_unit;
+    return Result_unit;
 
 #ifdef POSIX_SIGNALS
   pthread_sigmask(/* dummy */ SIG_BLOCK, NULL, &set);
 #endif
 
-  for (i = 0; i < NSIG_WORDS; i++) {
+  for (int i = 0; i < NSIG_WORDS; i++) {
     curr = atomic_load_relaxed(&caml_pending_signals[i]);
     if (curr == 0) goto next_word;
     /* Scan curr for bits set */
-    for (j = 0; j < BITS_PER_WORD; j++) {
+    for (int j = 0; j < BITS_PER_WORD; j++) {
       mask = (uintnat)1 << j;
       if ((curr & mask) == 0) goto next_bit;
       signo = i * BITS_PER_WORD + j + 1;
@@ -93,8 +92,8 @@ CAMLexport value caml_process_pending_signals_exn(void)
         if (curr == 0) goto next_word;
         if ((curr & mask) == 0) goto next_bit;
       }
-      exn = caml_execute_signal_exn(signo);
-      if (Is_exception_result(exn)) return exn;
+      caml_result result = caml_execute_signal_res(signo);
+      if (caml_result_is_exception(result)) return result;
       /* curr probably changed during the evaluation of the signal handler;
          refresh it from memory */
       curr = atomic_load_relaxed(&caml_pending_signals[i]);
@@ -103,7 +102,7 @@ CAMLexport value caml_process_pending_signals_exn(void)
     }
   next_word: /* skip */;
   }
-  return Val_unit;
+  return Result_unit;
 }
 
 /* Record the delivery of a signal, and arrange for it to be processed
@@ -171,14 +170,14 @@ CAMLexport void caml_enter_blocking_section(void)
          are further async callbacks pending beyond OCaml signal
          handlers. */
       caml_handle_gc_interrupt();
-      caml_raise_if_exception(caml_process_pending_signals_exn());
+      caml_get_value_or_raise(caml_process_pending_signals_res());
     }
     caml_enter_blocking_section_hook ();
     /* Check again if a signal arrived in the meanwhile. If none,
        done; otherwise, try again. Since we do not hold the domain
        lock, we cannot read [young_ptr] and we cannot call
        [Caml_check_gc_interrupt]. */
-    if (atomic_load_relaxed(&domain->young_limit) != UINTNAT_MAX) break;
+    if (atomic_load_relaxed(&domain->young_limit) != CAML_UINTNAT_MAX) break;
     caml_leave_blocking_section_hook ();
   }
 }
@@ -218,17 +217,15 @@ CAMLexport void caml_leave_blocking_section(void)
 static value caml_signal_handlers;
 
 void caml_init_signal_handling(void) {
-  mlsize_t i;
-
   caml_signal_handlers = caml_alloc_shr(NSIG, 0);
-  for (i = 0; i < NSIG; i++)
+  for (mlsize_t i = 0; i < NSIG; i++)
     Field(caml_signal_handlers, i) = Val_unit;
   caml_register_generational_global_root(&caml_signal_handlers);
 }
 
 /* Execute a signal handler immediately */
 
-value caml_execute_signal_exn(int signal_number)
+caml_result caml_execute_signal_res(int signal_number)
 {
 #ifdef POSIX_SIGNALS
   sigset_t nsigs, sigs;
@@ -240,7 +237,7 @@ value caml_execute_signal_exn(int signal_number)
 #endif
   value handler = Field(caml_signal_handlers, signal_number);
   value signum = Val_int(caml_rev_convert_signal_number(signal_number));
-  value res = caml_callback_exn(handler, signum);
+  caml_result res = caml_callback_res(handler, signum);
 #ifdef POSIX_SIGNALS
   /* Restore the original signal mask */
   pthread_sigmask(SIG_SETMASK, &sigs, NULL);
@@ -333,7 +330,7 @@ CAMLexport int caml_check_pending_actions(void)
   return check_pending_actions(Caml_state);
 }
 
-value caml_do_pending_actions_exn(void)
+caml_result caml_do_pending_actions_res(void)
 {
   /* 1. Non-delayable actions that do not run OCaml code. */
 
@@ -349,18 +346,16 @@ value caml_do_pending_actions_exn(void)
   Caml_state->action_pending = 0;
 
   /* Call signal handlers first */
-  value exn = caml_process_pending_signals_exn();
-  if (Is_exception_result(exn)) goto exception;
+  caml_result result = caml_process_pending_signals_res();
+  if (caml_result_is_exception(result)) goto exception;
 
-#if 0
   /* Call memprof callbacks */
-  exn = caml_memprof_handle_postponed_exn();
-  if (Is_exception_result(exn)) goto exception;
-#endif
+  result = caml_memprof_run_callbacks_res();
+  if (caml_result_is_exception(result)) goto exception;
 
   /* Call finalisers */
-  exn = caml_final_do_calls_exn();
-  if (Is_exception_result(exn)) goto exception;
+  result = caml_final_do_calls_res();
+  if (caml_result_is_exception(result)) goto exception;
 
   /* Process external interrupts (e.g. preemptive systhread switching).
      By doing this last, we do not need to set the action pending flag
@@ -368,7 +363,7 @@ value caml_do_pending_actions_exn(void)
      at this point. */
   caml_process_external_interrupt();
 
-  return Val_unit;
+  return Result_unit;
 
 exception:
   /* If an exception is raised during an asynchronous callback, then
@@ -376,34 +371,46 @@ exception:
      needed. Therefore, we set [Caml_state->action_pending] again in
      order to force reexamination of callbacks. */
   caml_set_action_pending(Caml_state);
-  return exn;
+  return result;
 }
 
-value caml_process_pending_actions_with_root_exn(value root)
+caml_result caml_process_pending_actions_with_root_res(value root)
 {
   if (caml_check_pending_actions()) {
     CAMLparam1(root);
-    value exn = caml_do_pending_actions_exn();
-    if (Is_exception_result(exn)) CAMLreturn(exn);
+    caml_result result = caml_do_pending_actions_res();
+    if (caml_result_is_exception(result)) CAMLreturnT(caml_result, result);
     CAMLdrop;
   }
-  return root;
+  return Result_value(root);
 }
 
-value caml_process_pending_actions_with_root(value root)
+CAMLprim value caml_process_pending_actions_with_root(value root)
 {
-  return caml_raise_if_exception(
-    caml_process_pending_actions_with_root_exn(root));
+  return caml_get_value_or_raise(
+    caml_process_pending_actions_with_root_res(root));
 }
 
-CAMLexport value caml_process_pending_actions_exn(void)
+CAMLexport caml_result caml_process_pending_actions_res(void)
 {
-  return caml_process_pending_actions_with_root_exn(Val_unit);
+  if (caml_check_pending_actions()) {
+    return caml_do_pending_actions_res();
+  } else {
+    return Result_unit;
+  }
 }
 
 CAMLexport void caml_process_pending_actions(void)
 {
-  caml_process_pending_actions_with_root(Val_unit);
+  caml_get_value_or_raise(
+    caml_process_pending_actions_res());
+}
+
+/* deprecated, but kept around for backward-compatibility */
+CAMLexport value caml_process_pending_actions_exn(void)
+{
+  caml_result res = caml_process_pending_actions_res();
+  return caml_result_get_encoded_exception(res);
 }
 
 /* OS-independent numbering of signals */
@@ -502,7 +509,7 @@ static const int posix_signals[] = {
 
 CAMLexport int caml_convert_signal_number(int signo)
 {
-  if (signo < 0 && signo >= -(sizeof(posix_signals) / sizeof(int)))
+  if (signo < 0 && signo >= -(int)(sizeof(posix_signals) / sizeof(int)))
     return posix_signals[-signo-1];
   else
     return signo;
@@ -510,8 +517,7 @@ CAMLexport int caml_convert_signal_number(int signo)
 
 CAMLexport int caml_rev_convert_signal_number(int signo)
 {
-  int i;
-  for (i = 0; i < sizeof(posix_signals) / sizeof(int); i++)
+  for (int i = 0; i < (int)(sizeof(posix_signals) / sizeof(int)); i++)
     if (signo == posix_signals[i]) return -i - 1;
   return signo;
 }
@@ -702,7 +708,7 @@ CAMLprim value caml_install_signal_handler(value signal_number, value action)
     if (caml_signal_handlers == 0) {
       tmp_signal_handlers = caml_alloc(NSIG, 0);
     }
-    caml_plat_lock(&signal_install_mutex);
+    caml_plat_lock_blocking(&signal_install_mutex);
     if (caml_signal_handlers == 0) {
       /* caml_alloc cannot raise asynchronous exceptions from signals
          so this is safe */
@@ -712,6 +718,6 @@ CAMLprim value caml_install_signal_handler(value signal_number, value action)
     caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
     caml_plat_unlock(&signal_install_mutex);
   }
-  caml_raise_if_exception(caml_process_pending_signals_exn());
+  caml_get_value_or_raise(caml_process_pending_signals_res());
   CAMLreturn (res);
 }

diff --git a/runtime/signals_nat.c b/runtime/signals_nat.c
index 3efb0580a6f70e49cf2433b3566721ea8a3722fe..fa167cc40e233f8537d4ee4ec6994dc7ff58c4aa 100644 (file)
--- a/runtime/signals_nat.c
+++ b/runtime/signals_nat.c
@@ -43,7 +43,7 @@ void caml_garbage_collection(void)
 {
   frame_descr* d;
   caml_domain_state * dom_st = Caml_state;
-  caml_frame_descrs fds = caml_get_frame_descrs();
+  caml_frame_descrs * fds = caml_get_frame_descrs();
   struct stack_info* stack = dom_st->current_stack;
 
   char * sp = (char*)stack->sp;
@@ -57,13 +57,15 @@ void caml_garbage_collection(void)
   { /* Find the frame descriptor for the current allocation */
     d = caml_find_frame_descr(fds, retaddr);
     /* Must be an allocation frame */
-    CAMLassert(d && !frame_return_to_C(d) && frame_has_allocs(d));
+    CAMLassert(d);
+    CAMLassert(!frame_return_to_C(d));
+    CAMLassert(frame_has_allocs(d));
   }
 
   { /* Compute the total allocation size at this point,
        including allocations combined by Comballoc */
     unsigned char* alloc_len = (unsigned char*)(&d->live_ofs[d->num_live]);
-    int i, nallocs = *alloc_len++;
+    int nallocs = *alloc_len++;
     intnat allocsz = 0;
 
     if (nallocs == 0) {
@@ -73,7 +75,7 @@ void caml_garbage_collection(void)
     }
     else
     {
-      for (i = 0; i < nallocs; i++) {
+      for (int i = 0; i < nallocs; i++) {
         allocsz += Whsize_wosize(Wosize_encoded_alloc_len(alloc_len[i]));
       }
       /* We have computed whsize (including header)

diff --git a/runtime/skiplist.c b/runtime/skiplist.c
index ad77c9f5a541b8a30620658ba208aae22b201573..21d62a6f4e672720c5dc569510e21176d6a4de88 100644 (file)
--- a/runtime/skiplist.c
+++ b/runtime/skiplist.c
@@ -57,8 +57,7 @@ static int random_level(void)
 
 void caml_skiplist_init(struct skiplist * sk)
 {
-  int i;
-  for (i = 0; i < NUM_LEVELS; i++) sk->forward[i] = NULL;
+  for (int i = 0; i < NUM_LEVELS; i++) sk->forward[i] = NULL;
   sk->level = 0;
 }
 
@@ -66,11 +65,10 @@ void caml_skiplist_init(struct skiplist * sk)
 
 int caml_skiplist_find(struct skiplist * sk, uintnat key, uintnat * data)
 {
-  int i;
   struct skipcell ** e, * f;
 
   e = sk->forward;
-  for (i = sk->level; i >= 0; i--) {
+  for (int i = sk->level; i >= 0; i--) {
     while (1) {
       f = e[i];
       if (f == NULL || f->key > key) break;
@@ -87,11 +85,10 @@ int caml_skiplist_find(struct skiplist * sk, uintnat key, uintnat * data)
 int caml_skiplist_find_below(struct skiplist * sk, uintnat k,
                              uintnat * key, uintnat * data)
 {
-  int i;
   struct skipcell ** e, * f, * last = NULL;
 
   e = sk->forward;
-  for (i = sk->level; i >= 0; i--) {
+  for (int i = sk->level; i >= 0; i--) {
     while (1) {
       f = e[i];
       if (f == NULL || f->key > k) break;
@@ -113,12 +110,12 @@ int caml_skiplist_insert(struct skiplist * sk,
 {
   struct skipcell ** update[NUM_LEVELS];
   struct skipcell ** e, * f;
-  int i, new_level;
+  int new_level;
 
   /* Init "cursor" to list head */
   e = sk->forward;
   /* Find place to insert new node */
-  for (i = sk->level; i >= 0; i--) {
+  for (int i = sk->level; i >= 0; i--) {
     while (1) {
       f = e[i];
       if (f == NULL || f->key >= key) break;
@@ -135,7 +132,7 @@ int caml_skiplist_insert(struct skiplist * sk,
   /* Insert additional element, updating list level if necessary */
   new_level = random_level();
   if (new_level > sk->level) {
-    for (i = sk->level + 1; i <= new_level; i++)
+    for (int i = sk->level + 1; i <= new_level; i++)
       update[i] = &sk->forward[i];
     sk->level = new_level;
   }
@@ -143,7 +140,7 @@ int caml_skiplist_insert(struct skiplist * sk,
                       (new_level + 1) * sizeof(struct skipcell *));
   f->key = key;
   f->data = data;
-  for (i = 0; i <= new_level; i++) {
+  for (int i = 0; i <= new_level; i++) {
     f->forward[i] = *update[i];
     *update[i] = f;
   }
@@ -156,12 +153,11 @@ int caml_skiplist_remove(struct skiplist * sk, uintnat key)
 {
   struct skipcell ** update[NUM_LEVELS];
   struct skipcell ** e, * f;
-  int i;
 
   /* Init "cursor" to list head */
   e = sk->forward;
   /* Find element in list */
-  for (i = sk->level; i >= 0; i--) {
+  for (int i = sk->level; i >= 0; i--) {
     while (1) {
       f = e[i];
       if (f == NULL || f->key >= key) break;
@@ -173,7 +169,7 @@ int caml_skiplist_remove(struct skiplist * sk, uintnat key)
   /* If not found, nothing to do */
   if (f == NULL || f->key != key) return 0;
   /* Rebuild list without node */
-  for (i = 0; i <= sk->level; i++) {
+  for (int i = 0; i <= sk->level; i++) {
     if (*update[i] == f)
       *update[i] = f->forward[i];
   }
@@ -190,13 +186,10 @@ int caml_skiplist_remove(struct skiplist * sk, uintnat key)
 
 void caml_skiplist_empty(struct skiplist * sk)
 {
-  struct skipcell * e, * next;
-  int i;
-
-  for (e = sk->forward[0]; e != NULL; e = next) {
+  for (struct skipcell *e = sk->forward[0], *next; e != NULL; e = next) {
     next = e->forward[0];
     caml_stat_free(e);
   }
-  for (i = 0; i <= sk->level; i++) sk->forward[i] = NULL;
+  for (int i = 0; i <= sk->level; i++) sk->forward[i] = NULL;
   sk->level = 0;
 }

diff --git a/runtime/startup_aux.c b/runtime/startup_aux.c
index e40820b4e590af15c516d66bc77dcd11883096a1..138f97dac1495641d98fb04c88d011b691bfc1ba 100644 (file)
--- a/runtime/startup_aux.c
+++ b/runtime/startup_aux.c
@@ -52,6 +52,7 @@ static void init_startup_params(void)
   params.init_custom_minor_ratio = Custom_minor_ratio_def;
   params.init_custom_minor_max_bsz = Custom_minor_max_bsz_def;
   params.init_max_stack_wsz = Max_stack_def;
+  params.max_domains = Max_domains_def;
   params.runtime_events_log_wsize = Default_runtime_events_log_wsize;
 
 #ifdef DEBUG
@@ -80,7 +81,6 @@ static void scanmult (char_os *opt, uintnat *var)
   case 'k':   *var = (uintnat) val * 1024; break;
   case 'M':   *var = (uintnat) val * (1024 * 1024); break;
   case 'G':   *var = (uintnat) val * (1024 * 1024 * 1024); break;
-  case 'v':   atomic_store_relaxed((atomic_uintnat *)var, val); break;
   default:    *var = (uintnat) val; break;
   }
 }
@@ -88,6 +88,7 @@ static void scanmult (char_os *opt, uintnat *var)
 void caml_parse_ocamlrunparam(void)
 {
   init_startup_params();
+  uintnat val;
 
   char_os *opt = caml_secure_getenv (T("OCAMLRUNPARAM"));
   if (opt == NULL) opt = caml_secure_getenv (T("CAMLRUNPARAM"));
@@ -97,6 +98,7 @@ void caml_parse_ocamlrunparam(void)
       switch (*opt++){
       case 'b': scanmult (opt, &params.backtrace_enabled); break;
       case 'c': scanmult (opt, &params.cleanup_on_exit); break;
+      case 'd': scanmult (opt, &params.max_domains); break;
       case 'e': scanmult (opt, &params.runtime_events_log_wsize); break;
       case 'l': scanmult (opt, &params.init_max_stack_wsz); break;
       case 'M': scanmult (opt, &params.init_custom_major_ratio); break;
@@ -107,7 +109,10 @@ void caml_parse_ocamlrunparam(void)
       case 'R': break; /*  see stdlib/hashtbl.mli */
       case 's': scanmult (opt, &params.init_minor_heap_wsz); break;
       case 't': scanmult (opt, &params.trace_level); break;
-      case 'v': scanmult (opt, (uintnat *)&caml_verb_gc); break;
+      case 'v':
+        scanmult (opt, &val);
+        atomic_store_relaxed(&caml_verb_gc, val);
+        break;
       case 'V': scanmult (opt, &params.verify_heap); break;
       case 'W': scanmult (opt, &caml_runtime_warnings); break;
       case ',': continue;
@@ -117,6 +122,15 @@ void caml_parse_ocamlrunparam(void)
       }
     }
   }
+
+  /* Validate */
+  if (params.max_domains < 1) {
+    caml_fatal_error("OCAMLRUNPARAM: max_domains(d) must be at least 1");
+  }
+  if (params.max_domains > Max_domains_max) {
+    caml_fatal_error("OCAMLRUNPARAM: max_domains(d) is too large. "
+                     "The maximum value is %d.", Max_domains_max);
+  }
 }
 
 
@@ -133,6 +147,12 @@ int caml_startup_aux(int pooling)
     caml_fatal_error("caml_startup was called after the runtime "
                      "was shut down with caml_shutdown");
 
+#ifdef DEBUG
+  /* Note this must be executed after the call to caml_parse_ocamlrunparam. */
+  caml_gc_message (-1, "### OCaml runtime: debug mode ###\n");
+  caml_gc_message (-1, "### set OCAMLRUNPARAM=v=0 to silence this message\n");
+#endif
+
   /* Second and subsequent calls are ignored,
      since the runtime has already started */
   startup_count++;
@@ -149,7 +169,7 @@ static void call_registered_value(char* name)
 {
   const value *f = caml_named_value(name);
   if (f != NULL)
-    caml_callback_exn(*f, Val_unit);
+    caml_callback_res(*f, Val_unit);
 }
 
 CAMLexport void caml_shutdown(void)

diff --git a/runtime/startup_byt.c b/runtime/startup_byt.c
index 8f9a0dbc2d38e2d0ae6df977ad257c2e1f9f2cf5..ffb4eb0bebdd8f9c314976d40693d96c403391c0 100644 (file)
--- a/runtime/startup_byt.c
+++ b/runtime/startup_byt.c
@@ -27,6 +27,7 @@
 #include <unistd.h>
 #endif
 #ifdef _WIN32
+#include <io.h>
 #include <process.h>
 #endif
 #include "caml/alloc.h"
@@ -159,7 +160,7 @@ int caml_attempt_open(char_os **name, struct exec_trailer *trail,
 
 void caml_read_section_descriptors(int fd, struct exec_trailer *trail)
 {
-  int toc_size, i;
+  int toc_size;
 
   toc_size = trail->num_sections * 8;
   trail->section = caml_stat_alloc(toc_size);
@@ -167,7 +168,7 @@ void caml_read_section_descriptors(int fd, struct exec_trailer *trail)
   if (read(fd, (char *) trail->section, toc_size) != toc_size)
     caml_fatal_error("cannot read section table");
   /* Fixup endianness of lengths */
-  for (i = 0; i < trail->num_sections; i++)
+  for (int i = 0; i < trail->num_sections; i++)
     fixup_endianness_trailer(&(trail->section[i].len));
 }
 
@@ -179,10 +180,9 @@ int32_t caml_seek_optional_section(int fd, struct exec_trailer *trail,
                                    char *name)
 {
   long ofs;
-  int i;
 
   ofs = TRAILER_SIZE + trail->num_sections * 8;
-  for (i = trail->num_sections - 1; i >= 0; i--) {
+  for (int i = trail->num_sections - 1; i >= 0; i--) {
     ofs += trail->section[i].len;
     if (strncmp(trail->section[i].name, name, 4) == 0) {
       lseek(fd, -ofs, SEEK_END);
@@ -300,7 +300,7 @@ static void do_print_help(void)
 
 static int parse_command_line(char_os **argv)
 {
-  int i, j, len, parsed;
+  int i, len, parsed;
   /* cast to make caml_params mutable; this assumes we are only called
      by one thread at startup */
   struct caml_params* params = (struct caml_params*)caml_params;
@@ -321,7 +321,7 @@ static int parse_command_line(char_os **argv)
         atomic_store_relaxed(&caml_verb_gc, 0x001+0x004+0x008+0x010+0x020);
         break;
       case 'p':
-        for (j = 0; caml_names_of_builtin_cprim[j] != NULL; j++)
+        for (int j = 0; caml_names_of_builtin_cprim[j] != NULL; j++)
           printf("%s\n", caml_names_of_builtin_cprim[j]);
         exit(0);
         break;
@@ -378,7 +378,6 @@ static int parse_command_line(char_os **argv)
    freed, since the runtime will terminate after calling this. */
 static void do_print_config(void)
 {
-  int i;
   char_os * dir;
 
   /* Print the runtime configuration */
@@ -422,7 +421,7 @@ static void do_print_config(void)
   /* Parse ld.conf and print the effective search path */
   puts("shared_libs_path:");
   caml_parse_ld_conf();
-  for (i = 0; i < caml_shared_libs_path.size; i++) {
+  for (int i = 0; i < caml_shared_libs_path.size; i++) {
     dir = caml_shared_libs_path.contents[i];
     if (dir[0] == 0)
 #ifdef _WIN32
@@ -461,9 +460,6 @@ CAMLexport void caml_main(char_os **argv)
   /* Determine options */
   caml_parse_ocamlrunparam();
 
-#ifdef DEBUG
-  caml_gc_message (-1, "### OCaml runtime: debug mode ###\n");
-#endif
   if (!caml_startup_aux(/* pooling */ caml_params->cleanup_on_exit))
     return;
 
@@ -602,9 +598,6 @@ CAMLexport value caml_startup_code_exn(
   /* Determine options */
   caml_parse_ocamlrunparam();
 
-#ifdef DEBUG
-  caml_gc_message (-1, "### OCaml runtime: debug mode ###\n");
-#endif
   if (caml_params->cleanup_on_exit)
     pooling = 1;
   if (!caml_startup_aux(pooling))

diff --git a/runtime/startup_nat.c b/runtime/startup_nat.c
index 38fd4a80016f7c0ad7a141128d9eae22d9e70b8b..61cb97b837e5f50407256f17701c1f8c9572e1c4 100644 (file)
--- a/runtime/startup_nat.c
+++ b/runtime/startup_nat.c
@@ -39,7 +39,6 @@
 #include "caml/startup_aux.h"
 #include "caml/sys.h"
 
-extern int caml_parser_trace;
 extern char caml_system__code_begin, caml_system__code_end;
 /* The two symbols above are defined in runtime/$ARCH.S.
    They use the old `__` separator convention because the new convention
@@ -53,11 +52,10 @@ static void init_segments(void)
 {
   extern struct segment caml_code_segments[];
   char * caml_code_area_start, * caml_code_area_end;
-  int i;
 
   caml_code_area_start = caml_code_segments[0].begin;
   caml_code_area_end = caml_code_segments[0].end;
-  for (i = 1; caml_code_segments[i].begin != 0; i++) {
+  for (int i = 1; caml_code_segments[i].begin != 0; i++) {
     if (caml_code_segments[i].begin < caml_code_area_start)
       caml_code_area_start = caml_code_segments[i].begin;
     if (caml_code_segments[i].end > caml_code_area_end)
@@ -93,9 +91,6 @@ value caml_startup_common(char_os **argv, int pooling)
   /* Determine options */
   caml_parse_ocamlrunparam();
 
-#ifdef DEBUG
-  caml_gc_message (-1, "### OCaml runtime: debug mode ###\n");
-#endif
   if (caml_params->cleanup_on_exit)
     pooling = 1;
   if (!caml_startup_aux(pooling))

diff --git a/runtime/sync_posix.h b/runtime/sync_posix.h
index 7ef3bd241bccaec924039bc7dad5928f78cac2a9..a3123146cd9c63acd55c93d0d9007935154c90cd 100644 (file)
--- a/runtime/sync_posix.h
+++ b/runtime/sync_posix.h
@@ -23,14 +23,12 @@
 #include <pthread.h>
 #include <string.h>
 
+#include "caml/sync.h"
+
 typedef int sync_retcode;
 
 /* Mutexes */
 
-/* Already defined in <caml/sync.h> */
-/* typedef pthread_mutex_t * sync_mutex; */
-/* #define Mutex_val(v) (* ((sync_mutex *) Data_custom_val(v))) */
-
 Caml_inline int sync_mutex_create(sync_mutex * res)
 {
   int rc;
@@ -84,10 +82,6 @@ Caml_inline int sync_mutex_unlock(sync_mutex m)
 
 /* Condition variables */
 
-typedef pthread_cond_t * sync_condvar;
-
-#define Condition_val(v) (* (sync_condvar *) Data_custom_val(v))
-
 Caml_inline int sync_condvar_create(sync_condvar * res)
 {
   int rc;

diff --git a/runtime/sys.c b/runtime/sys.c
index f3ef0ef11c1f407747de369ee2393f7f39d4fbe8..3356664ecdbd2ef85373e4e27c5fefb1bafea491 100644 (file)
--- a/runtime/sys.c
+++ b/runtime/sys.c
@@ -28,6 +28,7 @@
 #include <sys/stat.h>
 #ifdef _WIN32
 #include <direct.h> /* for _wchdir and _wgetcwd */
+#include <io.h> /* for _wopen and close */
 #else
 #include <sys/wait.h>
 #endif
@@ -45,8 +46,8 @@
 #ifdef HAS_GETTIMEOFDAY
 #include <sys/time.h>
 #endif
-#ifdef __APPLE__
-#include <sys/random.h> /* for getentropy */
+#if defined(HAS_GETENTROPY) && defined(__APPLE__)
+#include <sys/random.h>
 #endif
 #include "caml/alloc.h"
 #include "caml/debugger.h"
@@ -180,8 +181,6 @@ CAMLexport void caml_do_exit(int retcode)
                     heap_words);
       caml_gc_message(0x400, "top_heap_words: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
                       top_heap_words);
-      caml_gc_message(0x400, "mean_space_overhead: %lf\n",
-                      caml_mean_space_overhead());
     }
   }
 
@@ -603,7 +602,7 @@ int caml_unix_random_seed(intnat data[16])
   int nread = 0;
 
   /* Try kernel entropy first */
-#if defined(HAS_GETENTROPY) || defined(__APPLE__)
+#ifdef HAS_GETENTROPY
   if (getentropy(buffer, 12) != -1) {
     nread = 12;
   } else
@@ -642,7 +641,7 @@ int caml_unix_random_seed(intnat data[16])
 CAMLprim value caml_sys_random_seed (value unit)
 {
   intnat data[16];
-  int n, i;
+  int n;
   value res;
 #ifdef _WIN32
   n = caml_win32_random_seed(data);
@@ -651,7 +650,7 @@ CAMLprim value caml_sys_random_seed (value unit)
 #endif
   /* Convert to an OCaml array of ints */
   res = caml_alloc_small(n, 0);
-  for (i = 0; i < n; i++) Field(res, i) = Val_long(data[i]);
+  for (int i = 0; i < n; i++) Field(res, i) = Val_long(data[i]);
   return res;
 }
 

diff --git a/runtime/tsan.c b/runtime/tsan.c
index 48b03ff8827ba10618582335432201fa72c9024e..428c716adf3687033e047fb6057d0fba44f3eeae 100644 (file)
--- a/runtime/tsan.c
+++ b/runtime/tsan.c
@@ -120,9 +120,9 @@
                      | atomic_exchange(seq_cst)|
                      | fence(release)          |
    ------------------|-------------------------|--------------------------------
-   Non-atomic load   | atomic_load(relaxed)    | __tsan_read8()
+   Non-atomic load   | atomic_load(relaxed)    | __tsan_readN()
    ------------------|-------------------------|--------------------------------
-   Non-atomic store  | fence(acquire)          | __tsan_write8()
+   Non-atomic store  | fence(acquire)          | __tsan_writeN()
    (assignment, int) | atomic_store(release)   |
    ------------------|-------------------------|--------------------------------
    Non-atomic store  | fence(acquire)          | __tsan_write8()
@@ -133,7 +133,7 @@
    (initialization)  |                         |
    ------------------|-------------------------|--------------------------------
    Non-atomic store  | plain store             | __tsan_writeN()
-   (unaligned size)  |                         |
+   (unaligned)       |                         |
    ------------------|-------------------------|--------------------------------
 
    This mapping dictates which instrumentation calls are generated by the
@@ -159,7 +159,7 @@
      the FFI rules on the condition that the GC does not run between the
      allocation and the end of initialization) and a conflicting access is made
      from OCaml after publication to other threads. There should be no data
-     race thanks to data dependency (see [MMOC] coment in memory.c), but TSan
+     race thanks to data dependency (see [MMOC] comment in memory.c), but TSan
      does not take data dependencies into account.
    - A field is accessed from C with `Field`, or more generally using a
      `volatile value *` or a relaxed atomic access, and that field is modified
@@ -185,7 +185,7 @@
    More details and examples can be found in PR #12681.
 
    Our current make-do solution is that `__tsan_volatile_readN` performs a
-   dummy call to `__tsan_atomic64_load`, which is sufficient for TSan to view
+   dummy call to `__tsan_atomicNN_load`, which is sufficient for TSan to view
    them as relaxed loads; and `__tsan_volatile_writeN` performs a dummy
    fetch_add of zero. */
 
@@ -215,7 +215,7 @@ Caml_inline void caml_tsan_debug_log_pc(const char* msg, uintnat pc)
 void caml_tsan_exit_on_raise(uintnat pc, char* sp, char* trapsp)
 {
   caml_domain_state* domain_state = Caml_state;
-  caml_frame_descrs fds = caml_get_frame_descrs();
+  caml_frame_descrs* fds = caml_get_frame_descrs();
   uintnat next_pc = pc;
 
   /* iterate on each frame  */
@@ -299,7 +299,7 @@ void caml_tsan_exit_on_raise_c(char* limit)
 void caml_tsan_exit_on_perform(uintnat pc, char* sp)
 {
   struct stack_info* stack = Caml_state->current_stack;
-  caml_frame_descrs fds = caml_get_frame_descrs();
+  caml_frame_descrs* fds = caml_get_frame_descrs();
   uintnat next_pc = pc;
 
   /* iterate on each frame  */
@@ -330,7 +330,7 @@ void caml_tsan_exit_on_perform(uintnat pc, char* sp)
 CAMLno_tsan void caml_tsan_entry_on_resume(uintnat pc, char* sp,
     struct stack_info const* stack)
 {
-  caml_frame_descrs fds = caml_get_frame_descrs();
+  caml_frame_descrs* fds = caml_get_frame_descrs();
   uintnat next_pc = pc;
 
   caml_next_frame_descriptor(fds, &next_pc, &sp, (struct stack_info*)stack);
@@ -351,19 +351,26 @@ CAMLno_tsan void caml_tsan_entry_on_resume(uintnat pc, char* sp,
 
 #endif // NATIVE_CODE
 
-
 #include "caml/mlvalues.h"
+
 #include <stdbool.h>
+#include <stdint.h>
+
+/*
+   Make TSan see aligned volatile reads, and word-aligned volatile writes as
+   relaxed atomic accesses.
+
+   Refer to the detailed comments at the beginning of this file.
+
+   [The `is_aligned' checks are probably unnecessary here as one would expect
+   unaligned accesses to cause __tsan_unaligned_volatile_* to be invoked, but
+   they don't hurt and we'd better be correct here.] */
 
 Caml_inline bool is_aligned(void *ptr, size_t byte_count)
 {
   return (uintptr_t)ptr % byte_count == 0;
 }
 
-#include <stdint.h>
-
-/* Make TSan see word-aligned volatile accesses as relaxed atomic accesses.
-   Refer to the detailed comments at the beginning of this file. */
 #define DEFINE_TSAN_VOLATILE_READ_WRITE(size, bitsize)                         \
                                                                                \
 extern void __tsan_read##size(void*);                                          \
@@ -375,7 +382,10 @@ extern uint##bitsize##_t __tsan_atomic##bitsize##_fetch_add(                   \
                                                                                \
 CAMLno_tsan void __tsan_volatile_read##size(void *ptr)                         \
 {                                                                              \
-  const bool is_atomic = size <= sizeof(long long) && is_aligned(ptr, 8);      \
+  /* read accesses are considered atomic if they are not larger than the       \
+     native register size, and the address is properly aligned for the         \
+     width of the access. */                                                   \
+  const bool is_atomic = size <= sizeof(void *) && is_aligned(ptr, size);      \
   if (is_atomic)                                                               \
     __tsan_atomic##bitsize##_load(ptr, memory_order_relaxed);                  \
   else                                                                         \
@@ -383,11 +393,14 @@ CAMLno_tsan void __tsan_volatile_read##size(void *ptr)                         \
 }                                                                              \
 CAMLno_tsan void __tsan_unaligned_volatile_read##size(void *ptr)               \
 {                                                                              \
-  __tsan_volatile_read##size(ptr);                                             \
+  __tsan_read##size(ptr);                                                      \
 }                                                                              \
 CAMLno_tsan void __tsan_volatile_write##size(void *ptr)                        \
 {                                                                              \
-  const bool is_atomic = size <= sizeof(long long) && is_aligned(ptr, 8);      \
+  /* write accesses are considered atomic only if they are the size of the     \
+     native register, and the address is properly aligned for the              \
+     width of the access. */                                                   \
+  const bool is_atomic = size == sizeof(void *) && is_aligned(ptr, size);      \
   if (is_atomic) {                                                             \
     /* Signal a relaxed atomic store to TSan. We don't have access to the      \
        actual value written so we do a fetch_add of 0 which has the effect of  \
@@ -398,7 +411,7 @@ CAMLno_tsan void __tsan_volatile_write##size(void *ptr)                        \
 }                                                                              \
 CAMLno_tsan void __tsan_unaligned_volatile_write##size(void *ptr)              \
 {                                                                              \
-  __tsan_volatile_write##size(ptr);                                            \
+  __tsan_write##size(ptr);                                                     \
 }
 
 DEFINE_TSAN_VOLATILE_READ_WRITE(1, 8);
@@ -411,7 +424,7 @@ DEFINE_TSAN_VOLATILE_READ_WRITE(8, 64);
    are needed because, without them, building a C library for OCaml with TSan
    enabled will fail at the linking step with an unresolved symbol error if it
    contains volatile accesses to 128-bit values. It is better to have 128-bit
-   volatiles behave silently like plain 128-bit values. */
+   volatiles behave silently like plain, non-volatile, 128-bit values. */
 
 extern void __tsan_read16(void*);
 extern void __tsan_write16(void*);

diff --git a/runtime/unix.c b/runtime/unix.c
index b5fd4de17b9c1338111911c1b7b32611c8575cfc..e19d5a26a86db7ee8e8a40d692cbda99963b205b 100644 (file)
--- a/runtime/unix.c
+++ b/runtime/unix.c
@@ -27,13 +27,12 @@
 #include <errno.h>
 #include <sys/ioctl.h>
 #include <sys/types.h>
+#include "caml/config.h"
 #ifdef HAS_GETTIMEOFDAY
 #include <sys/time.h>
 #endif
 #include <sys/stat.h>
 #include <fcntl.h>
-#include <errno.h>
-#include "caml/config.h"
 #if defined(SUPPORT_DYNAMIC_LINKING) && !defined(BUILDING_LIBCAMLRUNS)
 #define WITH_DYNAMIC_LINKING
 #ifdef __CYGWIN__
@@ -47,7 +46,7 @@
 #endif
 #ifdef HAS_POSIX_MONOTONIC_CLOCK
 #include <time.h>
-#elif HAS_CLOCK_GETTIME_NSEC_NP
+#elif defined(HAS_CLOCK_GETTIME_NSEC_NP)
 #include <time.h>
 #endif
 #ifdef HAS_DIRENT
@@ -136,15 +135,13 @@ caml_stat_string caml_decompose_path(struct ext_table * tbl, char * path)
 
 caml_stat_string caml_search_in_path(struct ext_table * path, const char * name)
 {
-  const char * p;
   char * dir, * fullname;
-  int i;
   struct stat st;
 
-  for (p = name; *p != 0; p++) {
+  for (const char *p = name; *p != 0; p++) {
     if (*p == '/') goto not_found;
   }
-  for (i = 0; i < path->size; i++) {
+  for (int i = 0; i < path->size; i++) {
     dir = path->contents[i];
     if (dir[0] == 0) dir = ".";  /* empty path component = current dir */
     fullname = caml_stat_strconcat(3, dir, "/", name);
@@ -176,14 +173,11 @@ static int cygwin_file_exists(const char * name)
 static caml_stat_string cygwin_search_exe_in_path(struct ext_table * path,
                                                   const char * name)
 {
-  const char * p;
   char * dir, * fullname;
-  int i;
-
-  for (p = name; *p != 0; p++) {
+  for (const char *p = name; *p != 0; p++) {
     if (*p == '/' || *p == '\\') goto not_found;
   }
-  for (i = 0; i < path->size; i++) {
+  for (int i = 0; i < path->size; i++) {
     dir = path->contents[i];
     if (dir[0] == 0) dir = ".";  /* empty path component = current dir */
     fullname = caml_stat_strconcat(3, dir, "/", name);

diff --git a/runtime/weak.c b/runtime/weak.c
index 1d6a01c3d61ef73afbd297ceea27034c27c9efbf..ceb1361c249323d898551576e3ee8b116df83d0d 100644 (file)
--- a/runtime/weak.c
+++ b/runtime/weak.c
@@ -46,7 +46,7 @@ struct caml_ephe_info* caml_alloc_ephe_info (void)
 /* [len] is a value that represents a number of words (fields) */
 CAMLprim value caml_ephe_create (value len)
 {
-  mlsize_t size, i;
+  mlsize_t size;
   value res;
   caml_domain_state* domain_state = Caml_state;
 
@@ -59,7 +59,7 @@ CAMLprim value caml_ephe_create (value len)
 
   Ephe_link(res) = domain_state->ephe_info->live;
   domain_state->ephe_info->live = res;
-  for (i = CAML_EPHE_DATA_OFFSET; i < size; i++)
+  for (mlsize_t i = CAML_EPHE_DATA_OFFSET; i < size; i++)
     Field(res, i) = caml_ephe_none;
   /* run memprof callbacks */
   return caml_process_pending_actions_with_root(res);
@@ -123,14 +123,14 @@ static void do_check_key_clean(value e, mlsize_t offset)
 void caml_ephe_clean (value v) {
   value child;
   int release_data = 0;
-  mlsize_t size, i;
+  mlsize_t size;
   header_t hd;
 
   if (caml_gc_phase != Phase_sweep_ephe) return;
 
   hd = Hd_val(v);
   size = Wosize_hd (hd);
-  for (i = CAML_EPHE_FIRST_KEY; i < size; i++) {
+  for (mlsize_t i = CAML_EPHE_FIRST_KEY; i < size; i++) {
     child = Field(v, i);
   ephemeron_again:
     if (child != caml_ephe_none && Is_block(child)) {
@@ -425,7 +425,6 @@ static value ephe_blit_field (value es, mlsize_t offset_s,
 {
   CAMLparam2(es,ed);
   CAMLlocal1(ar);
-  long i;
 
   if (length == 0) CAMLreturn(Val_unit);
 
@@ -436,11 +435,11 @@ static value ephe_blit_field (value es, mlsize_t offset_s,
   caml_ephe_clean(ed);
 
   if (offset_d < offset_s) {
-    for (i = 0; i < length; i++) {
+    for (long i = 0; i < length; i++) {
       do_set(ed, offset_d + i, Field(es, (offset_s + i)));
     }
   } else {
-    for (i = length - 1; i >= 0; i--) {
+    for (long i = length - 1; i >= 0; i--) {
       do_set(ed, offset_d + i, Field(es, (offset_s + i)));
     }
   }

diff --git a/runtime/win32.c b/runtime/win32.c
index 862c6d33497fb7fff19c6c4212db4be24bd585bc..3ec659d42ad9b2154c4b52e8ec1f3038a89d0679 100644 (file)
--- a/runtime/win32.c
+++ b/runtime/win32.c
@@ -28,6 +28,7 @@
 #include <winsock2.h>
 #include <winioctl.h>
 #include <shlobj.h>
+#include <shlwapi.h>
 #include <direct.h>
 #include <stdlib.h>
 #include <stdio.h>
@@ -72,7 +73,7 @@ unsigned short caml_win32_minor = 0;
 unsigned short caml_win32_build = 0;
 unsigned short caml_win32_revision = 0;
 
-static CAMLnoret void caml_win32_sys_error(int errnum)
+CAMLnoret static void caml_win32_sys_error(int errnum)
 {
   wchar_t buffer[512];
   value msg;
@@ -153,14 +154,12 @@ wchar_t * caml_search_in_path(struct ext_table * path, const wchar_t * name)
 {
   wchar_t * dir, * fullname;
   char * u8;
-  const wchar_t * p;
-  int i;
   struct _stati64 st;
 
-  for (p = name; *p != 0; p++) {
+  for (const wchar_t *p = name; *p != 0; p++) {
     if (*p == '/' || *p == '\\') goto not_found;
   }
-  for (i = 0; i < path->size; i++) {
+  for (int i = 0; i < path->size; i++) {
     dir = path->contents[i];
     if (dir[0] == 0) continue;
          /* not sure what empty path components mean under Windows */
@@ -349,9 +348,7 @@ static void store_argument(wchar_t * arg)
 
 static void expand_argument(wchar_t * arg)
 {
-  wchar_t * p;
-
-  for (p = arg; *p != 0; p++) {
+  for (wchar_t *p = arg; *p != 0; p++) {
     if (*p == L'*' || *p == L'?') {
       expand_pattern(arg);
       return;
@@ -362,7 +359,7 @@ static void expand_argument(wchar_t * arg)
 
 static void expand_pattern(wchar_t * pat)
 {
-  wchar_t * prefix, * p, * name;
+  wchar_t * prefix, * name;
   intptr_t handle;
   struct _wfinddata_t ffblk;
   size_t i;
@@ -394,12 +391,11 @@ static void expand_pattern(wchar_t * pat)
 
 CAMLexport void caml_expand_command_line(int * argcp, wchar_t *** argvp)
 {
-  int i;
   argc = 0;
   argvsize = 16;
   argv = (wchar_t **) caml_stat_alloc_noexc(argvsize * sizeof(wchar_t *));
   if (argv == NULL) out_of_memory();
-  for (i = 0; i < *argcp; i++) expand_argument((*argvp)[i]);
+  for (int i = 0; i < *argcp; i++) expand_argument((*argvp)[i]);
   argv[argc] = NULL;
   *argcp = argc;
   *argvp = argv;
@@ -809,7 +805,8 @@ int caml_win32_rename(const wchar_t * oldpath, const wchar_t * newpath)
   if ((old_attribs != INVALID_FILE_ATTRIBUTES) &&
       (old_attribs & FILE_ATTRIBUTE_DIRECTORY) != 0 &&
       (new_attribs != INVALID_FILE_ATTRIBUTES) &&
-      (new_attribs & FILE_ATTRIBUTE_DIRECTORY) != 0) {
+      (new_attribs & FILE_ATTRIBUTE_DIRECTORY) != 0 &&
+      !PathIsPrefix(oldpath, newpath)) {
     /* Try to delete: RemoveDirectoryW fails on non-empty dirs as intended.
        Then try again. */
     RemoveDirectoryW(newpath);
@@ -967,15 +964,25 @@ CAMLexport wchar_t* caml_stat_strdup_to_utf16(const char *s)
   return ws;
 }
 
-CAMLexport caml_stat_string caml_stat_strdup_of_utf16(const wchar_t *s)
+CAMLexport caml_stat_string caml_stat_strdup_noexc_of_utf16(const wchar_t *s)
 {
   caml_stat_string out;
   int retcode;
 
   retcode = caml_win32_wide_char_to_multi_byte(s, -1, NULL, 0);
-  out = caml_stat_alloc(retcode);
-  caml_win32_wide_char_to_multi_byte(s, -1, out, retcode);
+  out = caml_stat_alloc_noexc(retcode);
+  if (out != NULL) {
+    caml_win32_wide_char_to_multi_byte(s, -1, out, retcode);
+  }
+
+  return out;
+}
 
+CAMLexport caml_stat_string caml_stat_strdup_of_utf16(const wchar_t *s)
+{
+  caml_stat_string out = caml_stat_strdup_noexc_of_utf16(s);
+  if (out == NULL)
+    caml_raise_out_of_memory();
   return out;
 }
 
@@ -1095,7 +1102,6 @@ CAMLexport clock_t caml_win32_clock(void)
 {
   FILETIME _creation, _exit;
   CAML_ULONGLONG_FILETIME stime, utime;
-  ULARGE_INTEGER tmp;
   ULONGLONG clocks_per_sec;
 
   if (!(GetProcessTimes(GetCurrentProcess(), &_creation, &_exit,
@@ -1162,7 +1168,7 @@ void caml_plat_mem_unmap(void* mem, uintnat size)
 
 struct error_entry { DWORD win_code; int range; int posix_code; };
 
-static struct error_entry win_error_table[] = {
+static const struct error_entry win_error_table[] = {
   { ERROR_INVALID_FUNCTION, 0, EINVAL},
   { ERROR_FILE_NOT_FOUND, 0, ENOENT},
   { ERROR_PATH_NOT_FOUND, 0, ENOENT},

diff --git a/stdlib/.depend b/stdlib/.depend
index 7b517bfadd261ae0dae439b29f922a5c60a900c9..80bcf06a2b924ab9d289c5eb133830747a44fcc8 100644 (file)
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -18,9 +18,11 @@ stdlib__Arg.cmx : arg.ml \
     stdlib__Arg.cmi
 stdlib__Arg.cmi : arg.mli
 stdlib__Array.cmo : array.ml \
+    stdlib__String.cmi \
     stdlib__Seq.cmi \
     stdlib__Array.cmi
 stdlib__Array.cmx : array.ml \
+    stdlib__String.cmx \
     stdlib__Seq.cmx \
     stdlib__Array.cmi
 stdlib__Array.cmi : array.mli \
@@ -234,16 +236,20 @@ stdlib__Domain.cmx : domain.ml \
 stdlib__Domain.cmi : domain.mli
 stdlib__Dynarray.cmo : dynarray.ml \
     stdlib__Sys.cmi \
+    stdlib.cmi \
     stdlib__Seq.cmi \
     stdlib__Printf.cmi \
-    stdlib__List.cmi \
+    stdlib__Obj.cmi \
+    camlinternalOO.cmi \
     stdlib__Array.cmi \
     stdlib__Dynarray.cmi
 stdlib__Dynarray.cmx : dynarray.ml \
     stdlib__Sys.cmx \
+    stdlib.cmx \
     stdlib__Seq.cmx \
     stdlib__Printf.cmx \
-    stdlib__List.cmx \
+    stdlib__Obj.cmx \
+    camlinternalOO.cmx \
     stdlib__Array.cmx \
     stdlib__Dynarray.cmi
 stdlib__Dynarray.cmi : dynarray.mli \
@@ -469,14 +475,12 @@ stdlib__Lazy.cmi : lazy.mli \
     camlinternalLazy.cmi
 stdlib__Lexing.cmo : lexing.ml \
     stdlib__Sys.cmi \
-    stdlib__String.cmi \
     stdlib__Int.cmi \
     stdlib__Bytes.cmi \
     stdlib__Array.cmi \
     stdlib__Lexing.cmi
 stdlib__Lexing.cmx : lexing.ml \
     stdlib__Sys.cmx \
-    stdlib__String.cmx \
     stdlib__Int.cmx \
     stdlib__Bytes.cmx \
     stdlib__Array.cmx \

diff --git a/stdlib/CONTRIBUTING.md b/stdlib/CONTRIBUTING.md
index 45b66bcd3466404becf78ad8098f2c6fa2fd8897..240ac219c89e67c8b05b564b806522aa40a55f76 100644 (file)
--- a/stdlib/CONTRIBUTING.md
+++ b/stdlib/CONTRIBUTING.md
@@ -16,7 +16,7 @@ So: please contribute!
 
 Obviously, proposals made to evolve the standard library will be
 evaluated with very high standards, similar to those applied to the
-evolution of the surface langage, and much higher than those for
+evolution of the surface language, and much higher than those for
 internal compiler changes (optimizations, etc).
 
 A key property of the standard library is its stability.  Backward

diff --git a/stdlib/Makefile b/stdlib/Makefile
index 50f825a1b3229c8c5956d6bc2af75f0769076931..a7f2e60a7aa0903d9be86261e381b68b7418f311 100644 (file)
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -96,10 +96,7 @@ endif
 .INTERMEDIATE: tmpheader.exe
 tmpheader.exe: $(HEADERPROGRAM).$(O)
        $(V_MKEXE)$(call MKEXE_VIA_CC,$@,$^)
-# FIXME This is wrong - mingw could invoke strip; MSVC equivalent?
-ifneq "$(UNIX_OR_WIN32)" "win32"
-       strip $@
-endif
+       $(STRIP) $@
 
 stdlib.cma: $(OBJS)
        $(V_LINKC)$(CAMLC) -a -o $@ $^

diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules
index 37575c1cfa75475d2b20f18b06c4e8053cd2123f..cd474c049efa02dbe0aec40a0dd4637787754059 100644 (file)
--- a/stdlib/StdlibModules
+++ b/stdlib/StdlibModules
@@ -73,7 +73,6 @@ STDLIB_MODULE_BASENAMES = \
   domain \
   camlinternalFormat \
   printf \
-  dynarray \
   arg \
   printexc \
   fun \
@@ -91,6 +90,7 @@ STDLIB_MODULE_BASENAMES = \
   camlinternalOO \
   oo \
   camlinternalMod \
+  dynarray \
   ephemeron \
   filename \
   complex \

diff --git a/stdlib/array.ml b/stdlib/array.ml
index eac27d5fa28794450fbc0cc562fddd304c1c8067..27b8f3990232d6a20fa611783ce84fd0b7b85395 100644 (file)
--- a/stdlib/array.ml
+++ b/stdlib/array.ml
@@ -23,8 +23,8 @@ external get: 'a array -> int -> 'a = "%array_safe_get"
 external set: 'a array -> int -> 'a -> unit = "%array_safe_set"
 external unsafe_get: 'a array -> int -> 'a = "%array_unsafe_get"
 external unsafe_set: 'a array -> int -> 'a -> unit = "%array_unsafe_set"
-external make: int -> 'a -> 'a array = "caml_make_vect"
-external create: int -> 'a -> 'a array = "caml_make_vect"
+external make: int -> 'a -> 'a array = "caml_array_make"
+external create: int -> 'a -> 'a array = "caml_array_make"
 external unsafe_sub : 'a array -> int -> int -> 'a array = "caml_array_sub"
 external append_prim : 'a array -> 'a array -> 'a array = "caml_array_append"
 external concat : 'a array list -> 'a array = "caml_array_concat"
@@ -32,7 +32,7 @@ external unsafe_blit :
   'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit"
 external unsafe_fill :
   'a array -> int -> int -> 'a -> unit = "caml_array_fill"
-external create_float: int -> float array = "caml_make_float_vect"
+external create_float: int -> float array = "caml_array_create_float"
 
 module Floatarray = struct
   external create : int -> floatarray = "caml_floatarray_create"
@@ -439,11 +439,21 @@ let stable_sort cmp a =
 
 let fast_sort = stable_sort
 
+let shuffle_contract_violation i j =
+  let int = string_of_int in
+  String.concat "" [
+    "Array.shuffle: 'rand "; int (i + 1);
+    "' returned "; int j;
+    ", out of expected range [0; "; int i; "]"
+  ]
+  |> invalid_arg
+
 let shuffle ~rand a = (* Fisher-Yates *)
   for i = length a - 1 downto 1 do
     let j = rand (i + 1) in
+    if not (0 <= j && j <= i) then shuffle_contract_violation i j;
     let v = unsafe_get a i in
-    unsafe_set a i (get a j);
+    unsafe_set a i (unsafe_get a j);
     unsafe_set a j v
   done
 

diff --git a/stdlib/array.mli b/stdlib/array.mli
index bba00c5a518d12b50110e325b8295a9f49b978af..03497dd091c9b1fdd0e622fe3004aa9ce6f0b26a 100644 (file)
--- a/stdlib/array.mli
+++ b/stdlib/array.mli
@@ -50,7 +50,7 @@ external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
    @raise Invalid_argument
    if [n] is outside the range 0 to [length a - 1]. *)
 
-external make : int -> 'a -> 'a array = "caml_make_vect"
+external make : int -> 'a -> 'a array = "caml_array_make"
 (** [make n x] returns a fresh array of length [n],
    initialized with [x].
    All the elements of this new array are initially
@@ -63,7 +63,7 @@ external make : int -> 'a -> 'a array = "caml_make_vect"
    If the value of [x] is a floating-point number, then the maximum
    size is only [Sys.max_array_length / 2].*)
 
-external create_float: int -> float array = "caml_make_float_vect"
+external create_float: int -> float array = "caml_array_create_float"
 (** [create_float n] returns a fresh float array of length [n],
     with uninitialized data.
     @since 4.03 *)
@@ -326,7 +326,7 @@ val sort : ('a -> 'a -> int) -> 'a array -> unit
 
    When [sort] returns, [a] contains the same elements as before,
    reordered in such a way that for all i and j valid indices of [a] :
--   [cmp a.(i) a.(j)] >= 0 if and only if i >= j
+-   [cmp a.(i) a.(j)] >= 0 if i >= j
 *)
 
 val stable_sort : ('a -> 'a -> int) -> 'a array -> unit

diff --git a/stdlib/arrayLabels.mli b/stdlib/arrayLabels.mli
index 84a413f05f76203667d36e5940b9dfefff22ac90..912120b74a7c7df12043ba3370a1e29b49bdec03 100644 (file)
--- a/stdlib/arrayLabels.mli
+++ b/stdlib/arrayLabels.mli
@@ -50,7 +50,7 @@ external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
    @raise Invalid_argument
    if [n] is outside the range 0 to [length a - 1]. *)
 
-external make : int -> 'a -> 'a array = "caml_make_vect"
+external make : int -> 'a -> 'a array = "caml_array_make"
 (** [make n x] returns a fresh array of length [n],
    initialized with [x].
    All the elements of this new array are initially
@@ -63,7 +63,7 @@ external make : int -> 'a -> 'a array = "caml_make_vect"
    If the value of [x] is a floating-point number, then the maximum
    size is only [Sys.max_array_length / 2].*)
 
-external create_float: int -> float array = "caml_make_float_vect"
+external create_float: int -> float array = "caml_array_create_float"
 (** [create_float n] returns a fresh float array of length [n],
     with uninitialized data.
     @since 4.03 *)
@@ -326,7 +326,7 @@ val sort : cmp:('a -> 'a -> int) -> 'a array -> unit
 
    When [sort] returns, [a] contains the same elements as before,
    reordered in such a way that for all i and j valid indices of [a] :
--   [cmp a.(i) a.(j)] >= 0 if and only if i >= j
+-   [cmp a.(i) a.(j)] >= 0 if i >= j
 *)
 
 val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit

diff --git a/stdlib/bigarray.mli b/stdlib/bigarray.mli
index 015f899d6601b92d4719bacb075c501ad1bad30c..26dca616268bbaa292a5111eee744375c4bfaf82 100644 (file)
--- a/stdlib/bigarray.mli
+++ b/stdlib/bigarray.mli
@@ -61,7 +61,7 @@
      and {!Stdlib.input_value}).
 *)
 
-(** {1 Element kinds} *)
+(** {1:elementkinds Element kinds} *)
 
 (** Bigarrays can contain elements of the following kinds:
 - IEEE half precision (16 bits) floating-point numbers
@@ -186,7 +186,12 @@ val int16_unsigned : (int, int16_unsigned_elt) kind
 (** See {!Bigarray.char}. *)
 
 val int : (int, int_elt) kind
-(** See {!Bigarray.char}. *)
+(** See {!Bigarray.char} and {!section:elementkinds}.
+
+   Beware that this is a bigarray containing OCaml integers
+   (signed, 31 bits on 32-bit architectures, 63 bits on 64-bit architectures),
+   which does not match the [C] int type.
+ *)
 
 val int32 : (int32, int32_elt) kind
 (** See {!Bigarray.char}. *)

diff --git a/stdlib/buffer.ml b/stdlib/buffer.ml
index 964d70935bcb1b90b4e64fed934ac7d7ef95dc19..3e4d93e7fba7d744bcc3a0174cde3cb0a110c8c7 100644 (file)
--- a/stdlib/buffer.ml
+++ b/stdlib/buffer.ml
@@ -148,7 +148,7 @@ let rec add_utf_16le_uchar b u =
 
 let add_substring b s offset len =
   if offset < 0 || len < 0 || offset > String.length s - len
-  then invalid_arg "Buffer.add_substring/add_subbytes";
+  then invalid_arg "Buffer.add_substring";
   let position = b.position in
   let {buffer;length} = b.inner in
   let new_position = position + len in
@@ -159,22 +159,24 @@ let add_substring b s offset len =
     Bytes.unsafe_blit_string s offset buffer position len;
   b.position <- new_position
 
-let add_subbytes b s offset len =
-  add_substring b (Bytes.unsafe_to_string s) offset len
-
-let add_string b s =
-  let len = String.length s in
+let add_subbytes b bytes offset len =
+  if offset < 0 || len < 0 || offset > Bytes.length bytes - len
+  then invalid_arg "Buffer.add_subbytes";
   let position = b.position in
-  let {buffer; length} = b.inner in
+  let {buffer;length} = b.inner in
   let new_position = position + len in
   if new_position > length then (
     resize b len;
-    Bytes.blit_string s 0 b.inner.buffer b.position len;
+    Bytes.blit bytes offset b.inner.buffer b.position len
   ) else
-    Bytes.unsafe_blit_string s 0 buffer position len;
+    Bytes.unsafe_blit bytes offset buffer position len;
   b.position <- new_position
 
-let add_bytes b s = add_string b (Bytes.unsafe_to_string s)
+let add_string b s =
+  add_substring b s 0 (String.length s)
+
+let add_bytes b bytes =
+  add_subbytes b bytes 0 (Bytes.length bytes)
 
 let add_buffer b bs =
   add_subbytes b bs.inner.buffer 0 bs.position

diff --git a/stdlib/bytes.mli b/stdlib/bytes.mli
index 98592b06b2b0c85ff0d7075ccb32508e27af836b..e1300c4c537e2e29834abc8ac61d0826cf6b45f1 100644 (file)
--- a/stdlib/bytes.mli
+++ b/stdlib/bytes.mli
@@ -332,9 +332,9 @@ val ends_with :
     This section describes unsafe, low-level conversion functions
     between [bytes] and [string]. They do not copy the internal data;
     used improperly, they can break the immutability invariant on
-    strings provided by the [-safe-string] option. They are available for
-    expert library authors, but for most purposes you should use the
-    always-correct {!to_string} and {!of_string} instead.
+    strings. They are available for expert library authors, but for
+    most purposes you should use the always-correct {!to_string} and
+    {!of_string} instead.
 *)
 
 val unsafe_to_string : bytes -> string

diff --git a/stdlib/bytesLabels.mli b/stdlib/bytesLabels.mli
index d6ab19f9938b2a453a25acda3b2b48ce79075765..adb204bc3578942848530ef4ea34f06b4d56c276 100644 (file)
--- a/stdlib/bytesLabels.mli
+++ b/stdlib/bytesLabels.mli
@@ -332,9 +332,9 @@ val ends_with :
     This section describes unsafe, low-level conversion functions
     between [bytes] and [string]. They do not copy the internal data;
     used improperly, they can break the immutability invariant on
-    strings provided by the [-safe-string] option. They are available for
-    expert library authors, but for most purposes you should use the
-    always-correct {!to_string} and {!of_string} instead.
+    strings. They are available for expert library authors, but for
+    most purposes you should use the always-correct {!to_string} and
+    {!of_string} instead.
 *)
 
 val unsafe_to_string : bytes -> string

diff --git a/stdlib/camlinternalMod.ml b/stdlib/camlinternalMod.ml
index dda44de36767eaa5c488220be17973b630a790f7..3284a53c7d400a377a21825df329c805dfc1d866 100644 (file)
--- a/stdlib/camlinternalMod.ml
+++ b/stdlib/camlinternalMod.ml
@@ -69,9 +69,9 @@ let rec update_mod_field modu i shape n =
   | Value _ ->
      () (* the value is already there *)
   | Class ->
-     assert (Obj.tag n = 0 && Obj.size n = 4);
+     assert (Obj.tag n = 0 && Obj.size n = 3);
      let cl = Obj.field modu i in
-     for j = 0 to 3 do
+     for j = 0 to 2 do
        Obj.set_field cl j (Obj.field n j)
      done
   | Module comps ->

diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index 09cb6fb1a251dde150ca2408db7d93c988a5bc3a..978897677e989d320985dc546e6c8b2b95b25689 100644 (file)
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -313,7 +313,7 @@ let init_class table =
   table.initializers <- List.rev table.initializers;
   resize table (3 + Obj.magic table.methods.(1) * 16 / Sys.word_size)
 
-let inherits cla vals virt_meths concr_meths (_, super, _, env) top =
+let inherits cla vals virt_meths concr_meths (_, super, env) top =
   narrow cla vals virt_meths concr_meths;
   let init =
     if top then super cla env else Obj.repr (super cla) in
@@ -329,7 +329,7 @@ let make_class pub_meths class_init =
   let table = create_table pub_meths in
   let env_init = class_init table in
   init_class table;
-  (env_init (Obj.repr 0), class_init, env_init, Obj.repr 0)
+  (env_init (Obj.repr 0), class_init, Obj.repr 0)
 
 type init_table = { mutable env_init: t; mutable class_init: table -> t }
 [@@warning "-unused-field"]
@@ -343,7 +343,7 @@ let make_class_store pub_meths class_init init_table =
 
 let dummy_class loc =
   let undef = fun _ -> raise (Undefined_recursive_module loc) in
-  (Obj.magic undef, undef, undef, Obj.repr 0)
+  (Obj.magic undef, undef, Obj.repr 0)
 
 (**** Objects ****)
 

diff --git a/stdlib/camlinternalOO.mli b/stdlib/camlinternalOO.mli
index b6ffc70d7fcd2f32830c0f9a205b91cb9ddf24be..778e957b163d53ceda52d2e3ae0c845ff3f921f4 100644 (file)
--- a/stdlib/camlinternalOO.mli
+++ b/stdlib/camlinternalOO.mli
@@ -46,16 +46,16 @@ val create_table : string array -> table
 val init_class : table -> unit
 val inherits :
     table -> string array -> string array -> string array ->
-    (t * (table -> obj -> Obj.t) * t * obj) -> bool -> Obj.t array
+    (t * (table -> obj -> Obj.t) * obj) -> bool -> Obj.t array
 val make_class :
     string array -> (table -> Obj.t -> t) ->
-    (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t)
+    (t * (table -> Obj.t -> t) * Obj.t)
 type init_table
 val make_class_store :
     string array -> (table -> t) -> init_table -> unit
 val dummy_class :
     string * int * int ->
-    (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t)
+    (t * (table -> Obj.t -> t) * Obj.t)
 
 (** {1 Objects} *)
 

diff --git a/stdlib/digest.ml b/stdlib/digest.ml
index f816bf5e12a9c9dac21420100156cdc59e4f3c3f..1a118be6eda3e3f351960d1924337976d18df0ef 100644 (file)
--- a/stdlib/digest.ml
+++ b/stdlib/digest.ml
@@ -74,10 +74,12 @@ module BLAKE2 (X: sig val hash_length : int end) : S = struct
   type state
 
   external create_gen: int -> string -> state = "caml_blake2_create"
-  external update: state -> string -> int -> int -> unit = "caml_blake2_update"
+  external update: state -> bytes -> int -> int -> unit = "caml_blake2_update"
   external final: state -> int -> t = "caml_blake2_final"
   external unsafe_string: int -> string -> string -> int -> int -> t
                         = "caml_blake2_string"
+  external unsafe_bytes: int -> string -> bytes -> int -> int -> t
+                        = "caml_blake2_bytes"
 
   let create () = create_gen hash_length ""
 
@@ -85,7 +87,7 @@ module BLAKE2 (X: sig val hash_length : int end) : S = struct
     unsafe_string hash_length "" str 0 (String.length str)
 
   let bytes b =
-    string (Bytes.unsafe_to_string b)
+    unsafe_bytes hash_length "" b 0 (Bytes.length b)
 
   let substring str ofs len =
     if ofs < 0 || len < 0 || ofs > String.length str - len
@@ -93,7 +95,9 @@ module BLAKE2 (X: sig val hash_length : int end) : S = struct
     unsafe_string hash_length "" str ofs len
 
   let subbytes b ofs len =
-    substring (Bytes.unsafe_to_string b) ofs len
+    if ofs < 0 || len < 0 || ofs > Bytes.length b - len
+    then invalid_arg "Digest.subbytes";
+    unsafe_bytes hash_length "" b ofs len
 
   let channel ic toread =
     let buf_size = 4096 in
@@ -104,7 +108,7 @@ module BLAKE2 (X: sig val hash_length : int end) : S = struct
         let n = In_channel.input ic buf 0 buf_size in
         if n = 0
         then final ctx hash_length
-        else (update ctx (Bytes.unsafe_to_string buf) 0 n; do_read ())
+        else (update ctx buf 0 n; do_read ())
       in do_read ()
     end else begin
       let rec do_read toread =
@@ -113,7 +117,7 @@ module BLAKE2 (X: sig val hash_length : int end) : S = struct
           if n = 0
           then raise End_of_file
           else begin
-            update ctx (Bytes.unsafe_to_string buf) 0 n;
+            update ctx buf 0 n;
             do_read (toread - n)
           end
         end
@@ -153,19 +157,24 @@ module MD5 = struct
   let equal = String.equal
 
   external unsafe_string: string -> int -> int -> t = "caml_md5_string"
+  external unsafe_bytes: bytes -> int -> int -> t = "caml_md5_bytes"
   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 bytes b =
+    unsafe_bytes b 0 (Bytes.length 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 subbytes b ofs len =
+    if ofs < 0 || len < 0 || ofs > Bytes.length b - len
+    then invalid_arg "Digest.subbytes"
+    else unsafe_bytes b ofs len
 
   let file filename =
     In_channel.with_open_bin filename (fun ic -> channel ic (-1))

diff --git a/stdlib/domain.ml b/stdlib/domain.ml
index 1e95c9b69c6423bf60a81f43b662e414c5154710..d0d8c29b2ecdb4959298abba91bd3537bb047bf5 100644 (file)
--- a/stdlib/domain.ml
+++ b/stdlib/domain.ml
@@ -204,6 +204,9 @@ let self () = Raw.self ()
 
 let is_main_domain () = (self () :> int) = 0
 
+external self_index : unit -> int
+  = "caml_ml_domain_index" [@@noalloc]
+
 (******** Callbacks **********)
 
 (* first spawn, domain startup and at exit functionality *)

diff --git a/stdlib/domain.mli b/stdlib/domain.mli
index 0cc047ec385babec5490d8f9f8894c322560352a..f7654877405ffda697a190718285d56bb1d419c5 100644 (file)
--- a/stdlib/domain.mli
+++ b/stdlib/domain.mli
@@ -91,6 +91,18 @@ val recommended_domain_count : unit -> int
 
     The value returned is at least [1]. *)
 
+val self_index : unit -> int
+(** The index of the current domain. It is an integer unique among
+    currently-running domains, in the interval [0; N-1] where N is the
+    peak number of domains running simultaneously so far.
+
+    The index of a terminated domain may be reused for a new
+    domain. Use [(Domain.self () :> int)] instead for an identifier
+    unique among all domains ever created by the program.
+
+    @since 5.3
+*)
+
 module DLS : sig
 (** Domain-local Storage *)
 
@@ -99,7 +111,7 @@ module DLS : sig
 
     val new_key : ?split_from_parent:('a -> 'a) -> (unit -> 'a) -> 'a key
     (** [new_key f] returns a new key bound to initialiser [f] for accessing
-,        domain-local variables.
+        domain-local variables.
 
         If [split_from_parent] is not provided, the value for a new
         domain will be computed on-demand by the new domain: the first

diff --git a/stdlib/dynarray.ml b/stdlib/dynarray.ml
index a178d40c5104aad8dc968b629b41b7e09a66743b..a3d05c55413faa7cc8d3581ba07ec574ff0f914b 100644 (file)
--- a/stdlib/dynarray.ml
+++ b/stdlib/dynarray.ml
@@ -13,10 +13,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-type 'a t = {
-  mutable length : int;
-  mutable arr : 'a slot array;
-}
 (* {2 The type ['a t]}
 
    A dynamic array is represented using a backing array [arr] and
@@ -33,7 +29,7 @@ type 'a t = {
    - empty space: the portion of the backing array
      from [length] to the end of the backing array.
 
-   {2 The type ['a slot]}
+   {2 Dummies}
 
    We should not keep a user-provided value in the empty space, as
    this could extend its lifetime and may result in memory leaks of
@@ -41,58 +37,13 @@ type 'a t = {
    array, such as [pop_last] or [truncate], must really erase the
    element from the backing array.
 
-   This constraint makes it difficult to represent an dynamic array of
-   elements of type ['a] with a backing array of type ['a array]: what
-   valid value of type ['a] would we use in the empty space? Typical
-   choices include:
-   - accepting scenarios where we actually leak user-provided values
-     (but this can blowup memory usage in some cases, and is hard to debug)
-   - requiring a "dummy" value at creation of the dynamic array
-     or in the parts of the API that grow the empty space
-     (but users find this very inconvenient)
-   - using arcane Obj.magic tricks
-     (but experts don't agree on which tricks are safe to use and/or
-      should be used here)
-   - using a backing array of ['a option] values, using [None]
-     in the empty space
-     (but this gives a noticeably less efficient memory representation)
-
-   In the present implementation, we use the ['a option] approach,
-   with a twist. With ['a option], calling [set a i x] must reallocate
-   a new [Some x] block:
-{[
-   let set a i x =
-     if i < 0 || i >= a.length then error "out of bounds";
-     a.arr.(i) <- Some x
-]}
-   Instead we use the type ['a slot] below,
-   which behaves as an option whose [Some] constructor
-   (called [Elem] here) has a _mutable_ argument.
-*)
-and 'a slot =
-| Empty
-| Elem of { mutable v: 'a }
-(*
-   This gives an allocation-free implementation of [set] that calls
-   [Array.get] (instead of [Array.set]) on the backing array and then
-   mutates the [v] parameter. In pseudo-code:
-{[
-   let set a i x =
-     if i < 0 || i >= a.length then error "out of bounds";
-     match a.arr.(i) with
-     | Empty -> error "invalid state: missing element"
-     | Elem s -> s.v <- x
-]}
-   With this approach, accessing an element still pays the cost of an
-   extra indirection (compared to approaches that do not box elements
-   in the backing array), but only operations that add new elements at
-   the end of the array pay extra allocations.
-
-   There are some situations where ['a option] is better: it makes
-   [pop_last_opt] more efficient as the underlying option can be
-   returned directly, and it also lets us use [Array.blit] to
-   implement [append]. We believe that optimizing [get] and [set] is
-   more important for dynamic arrays.
+   To do so, we use an unsafe/magical [dummy] in the empty array. This
+   dummy is *not* type-safe, it is not a valid value of type ['a], so
+   we must be very careful never to return it to the user. After
+   accessing any element of the array, we must check that it is not
+   the dummy. In particular, this dummy must be distinct from any
+   other value the user could provide -- we ensure this by using
+   a dynamically-allocated mutable reference as our dummy.
 
    {2 Invariants and valid states}
 
@@ -102,17 +53,298 @@ and 'a slot =
    The following conditions define what we call a "valid" dynarray:
    - valid length: [length <= Array.length arr]
    - no missing element in the live space:
-     forall i, [0 <= i < length] implies [arr.(i) <> Empty]
+     forall i, [0 <= i < length] implies [arr.(i) != dummy]
    - no element in the empty space:
-     forall i, [length <= i < Array.length arr] implies [arr.(i) = Empty]
+     forall i, [length <= i < Array.length arr] implies [arr.(i) == dummy]
 
    Unfortunately, we cannot easily enforce validity as an invariant in
    presence of concurrent updates. We can thus observe dynarrays in
    "invalid states". Our implementation may raise exceptions or return
    incorrect results on observing invalid states, but of course it
    must preserve memory safety.
+
+   {3 Dummies and flat float arrays}
+
+   OCaml performs a dynamic optimization of the representation of
+   float arrays, which is incompatible with our use of a dummy
+   value: if we initialize an array with user-provided elements,
+   it may get an optimized into a "flat float array", and
+   writing our non-float dummy into it would crash.
+
+   To avoid interactions between unsafe dummies and flat float arrays,
+   we ensure that the arrays that we use are never initialized with
+   floating point values. In that case we will always get a non-flat
+   array, and storing float values inside those is safe
+   (if less efficient). We call this the 'no-flat-float' invariant.
+
+   {3 Marshalling dummies}
+
+   There is a risk of interaction between dummies and
+   marshalling. If we use a global dynamically-allocated dummy
+   for the whole module, we are not robust to a user marshalling
+   a dynarray and unmarshalling it inside another program with
+   a different global dummy.
+
+   The trick is to store the dummy that we use in the dynarray
+   metadata record. Marshalling the dynarray will then preserve the
+   physical equality between this dummy field and dummy elements in
+   the array, as expected.
+
+   This reasoning assumes that marshalling does not use the
+   [No_sharing] flag. To ensure that users do not marshal dummies
+   with [No_sharing], we use a recursive/cyclic dummy that would make
+   such marshalling loop forever. (This is not nice, but better than
+   segfaulting later for obscure reasons.)
 *)
 
+(** The [Dummy] module encapsulates the low-level magic we use
+    for dummies, providing a strongly-typed API that:
+    - makes it explicit where dummies are used
+    - makes it hard to mistakenly mix data using distinct dummies,
+      which would be unsound *)
+module Dummy : sig
+
+  (** {4 Dummies} *)
+
+  type 'stamp dummy
+  (** The type of dummies is parametrized by a ['stamp] variable,
+      so that two dummies with different stamps cannot be confused
+      together. *)
+
+  type fresh_dummy = Fresh : 'stamp dummy -> fresh_dummy
+  val fresh : unit -> fresh_dummy
+  (** The type of [fresh] enforces a fresh/unknown/opaque stamp for
+      the returned dummy, distinct from all previous stamps. *)
+
+
+  (** {4 Values or dummies} *)
+
+  type ('a, 'stamp) with_dummy
+  (** a value of type [('a, 'stamp) with_dummy] is either a proper
+      value of type ['a] or a dummy with stamp ['stamp]. *)
+
+  val of_val : 'a -> ('a, 'stamp) with_dummy
+  val of_dummy : 'stamp dummy -> ('a, 'stamp) with_dummy
+
+  val is_dummy : ('a, 'stamp) with_dummy -> 'stamp dummy -> bool
+  val unsafe_get : ('a, 'stamp) with_dummy -> 'a
+  (** [unsafe_get v] can only be called safely if [is_dummy v dummy]
+      is [false].
+
+      We could instead provide
+      [val find : ('a, 'stamp) with_dummy -> ('a, 'stamp dummy) result]
+      but this would involve intermediary allocations.
+
+      {[match find x with
+        | None -> ...
+        | Some v -> ...]}
+      can instead be written
+      {[if Dummy.is_dummy x
+        then ...
+         else let v = Dummy.unsafe_get x in ...]}
+  *)
+
+  (** {4 Arrays of values or dummies} *)
+  module Array : sig
+    val make :
+      int -> 'a -> dummy:'stamp dummy ->
+      ('a, 'stamp) with_dummy array
+
+    val init :
+      int -> (int -> 'a) -> dummy:'stamp dummy ->
+      ('a, 'stamp) with_dummy array
+
+    val copy : 'a array -> dummy:'stamp dummy -> ('a, 'stamp) with_dummy array
+
+    val unsafe_nocopy :
+      'a array -> dummy:'stamp dummy ->
+      ('a, 'stamp) with_dummy array
+    (** [unsafe_nocopy] assumes that the input array was created
+        locally and will not be used anymore (in the spirit of
+        [Bytes.unsafe_to_string]), and avoids a copy of the input
+        array when possible. *)
+
+    val blit_array :
+      'a array -> int ->
+      ('a, 'stamp) with_dummy array -> int ->
+      len:int ->
+      unit
+
+    val blit :
+      ('a, 'stamp1) with_dummy array -> 'stamp1 dummy -> int ->
+      ('a, 'stamp2) with_dummy array -> 'stamp2 dummy -> int ->
+      len:int ->
+      unit
+
+    val prefix :
+      ('a, 'stamp) with_dummy array ->
+      int ->
+      ('a, 'stamp) with_dummy array
+
+    val extend :
+      ('a, 'stamp) with_dummy array ->
+      length:int ->
+      dummy:'stamp dummy ->
+      new_capacity:int ->
+      ('a, 'stamp) with_dummy array
+  end
+end = struct
+  (* We want to use a cyclic value so that No_sharing marshalling
+     fails loudly, but we want also comparison of dynarrays to work
+     as expected, and not loop forever.
+
+     Our approach is to use an object value that contains a cycle.
+     Objects are compared by their unique id, so comparison is not
+     structural and will not loop on the cycle, but marshalled
+     by content, so marshalling without sharing will fail on the cycle.
+
+     (It is a bit tricky to build an object that does not contain
+     functional values where marshalling fails, see [fresh ()] below
+     for how we do it.) *)
+  type 'stamp dummy = < >
+  type fresh_dummy = Fresh : 'stamp dummy -> fresh_dummy
+
+  let fresh () =
+    (* dummies and marshalling: we intentionally
+       use a cyclic value here. *)
+    let r = ref None in
+    ignore
+      (* hack: this primitive is required by the object expression below,
+         ensure that 'make depend' notices it. *)
+      CamlinternalOO.create_object_opt;
+    let dummy = object
+      val x = r
+    end in
+    r := Some dummy;
+    Fresh dummy
+
+  type ('a, 'stamp) with_dummy = 'a
+
+  let of_val v = v
+
+  let of_dummy (type a stamp) (dummy : stamp dummy) =
+    (Obj.magic dummy : (a, stamp) with_dummy)
+
+  let is_dummy v dummy =
+    v == of_dummy dummy
+
+  let unsafe_get v =
+    v
+
+  module Array = struct
+    let make n x ~dummy =
+      if Obj.(tag (repr x) <> double_tag) then
+        Array.make n (of_val x)
+      else begin
+        let arr = Array.make n (of_dummy dummy) in
+        Array.fill arr 0 n (of_val x);
+        arr
+      end
+
+    let copy a ~dummy =
+      if Obj.(tag (repr a) <> double_array_tag) then
+        Array.copy a
+      else begin
+        let n = Array.length a in
+        let arr = Array.make n (of_dummy dummy) in
+        for i = 0 to n - 1 do
+          Array.unsafe_set arr i
+            (of_val (Array.unsafe_get a i));
+        done;
+        arr
+      end
+
+    let unsafe_nocopy a ~dummy =
+      if Obj.(tag (repr a) <> double_array_tag) then
+        a
+      else copy a ~dummy
+
+    let init n f ~dummy =
+      let arr = Array.make n (of_dummy dummy) in
+      for i = 0 to n - 1 do
+        Array.unsafe_set arr i (of_val (f i))
+      done;
+      arr
+
+    let blit_array src src_pos dst dst_pos ~len =
+      if Obj.(tag (repr src) <> double_array_tag) then
+        Array.blit src src_pos dst dst_pos len
+      else begin
+        for i = 0 to len - 1 do
+          dst.(dst_pos + i) <- of_val src.(src_pos + i)
+        done;
+      end
+
+    let blit src src_dummy src_pos dst dst_dummy dst_pos ~len =
+      if src_dummy == dst_dummy then
+        Array.blit src src_pos dst dst_pos len
+      else begin
+        if len < 0
+           || src_pos < 0
+           || src_pos + len < 0 (* overflow check *)
+           || src_pos + len > Array.length src
+           || dst_pos < 0
+           || dst_pos + len < 0 (* overflow check *)
+           || dst_pos + len > Array.length dst
+        then begin
+          (* We assume that the caller has already checked this and
+             will raise a proper error. The check here is only for
+             memory safety, it should not be reached and it is okay if
+             the error is uninformative. *)
+          assert false;
+        end;
+        (* We failed the check [src_dummy == dst_dummy] above, so we
+           know that in fact [src != dst] -- two dynarrays with
+           distinct dummies cannot share the same backing arrays. *)
+        assert (src != dst);
+        (* In particular, the source and destination arrays cannot
+           overlap, so we can always copy in ascending order without
+           risking overwriting an element needed later. *)
+        for i = 0 to len - 1 do
+          Array.unsafe_set dst (dst_pos + i)
+            (Array.unsafe_get src (src_pos + i));
+        done
+      end
+
+    let prefix arr n =
+      (* Note: the safety of the [Array.sub] call below, with respect to
+         our 'no-flat-float' invariant, relies on the fact that
+         [Array.sub] checks the tag of the input array, not whether the
+         elements themselves are float.
+
+         To avoid relying on this undocumented property we could use
+         [Array.make length dummy] and then set values in a loop, but this
+         would result in [caml_modify] rather than [caml_initialize]. *)
+      Array.sub arr 0 n
+
+    let extend arr ~length ~dummy ~new_capacity =
+      (* 'no-flat-float' invariant: we initialise the array with our
+         non-float dummy to get a non-flat array. *)
+      let new_arr = Array.make new_capacity (of_dummy dummy) in
+      Array.blit arr 0 new_arr 0 length;
+      new_arr
+  end
+end
+
+type 'a t = Pack : ('a, 'stamp) t_ -> 'a t [@@unboxed]
+and ('a, 'stamp) t_ = {
+  mutable length : int;
+  mutable arr : ('a, 'stamp) Dummy.with_dummy array;
+  dummy : 'stamp Dummy.dummy;
+}
+
+let global_dummy = Dummy.fresh ()
+(* We need to ensure that dummies are never exposed to the user as
+   values of type ['a]. Including the dummy in the dynarray metadata
+   is necessary for marshalling to behave correctly, but there is no
+   obligation to create a fresh dummy for each new dynarray, we can
+   use a global dummy.
+
+   On the other hand, unmarshalling may precisely return a dynarray
+   with another dummy: we cannot assume that all dynarrays use this
+   global dummy. The existential hiding of the dummy ['stamp]
+   parameter helps us to avoid this assumption. *)
+
 module Error = struct
   let[@inline never] index_out_of_bounds f ~i ~length =
     if length = 0 then
@@ -183,7 +415,7 @@ end
 
    See {!iter} below for a detailed usage example.
 *)
-let check_same_length f a ~length =
+let check_same_length f (Pack a) ~length =
   let length_a = a.length in
   if length <> length_a then
     Error.length_change_during_iteration f
@@ -202,121 +434,119 @@ let[@inline always] check_valid_length length arr =
 
    This precondition is typically guaranteed by knowing
    [0 <= i < length] and calling [check_valid_length length arr].*)
-let[@inline always] unsafe_get arr ~i ~length =
-  match Array.unsafe_get arr i with
-  | Empty -> Error.missing_element ~i ~length
-  | Elem {v} -> v
-
+let[@inline always] unsafe_get arr ~dummy ~i ~length =
+  let v = Array.unsafe_get arr i in
+  if Dummy.is_dummy v dummy
+  then Error.missing_element ~i ~length
+  else Dummy.unsafe_get v
 
 (** {1:dynarrays Dynamic arrays} *)
 
-let create () = {
-  length = 0;
-  arr = [| |];
-}
+let create () =
+  let Dummy.Fresh dummy = global_dummy in
+  Pack {
+    length = 0;
+    arr = [| |];
+    dummy = dummy;
+  }
 
 let make n x =
   if n < 0 then Error.negative_length_requested "make" n;
-  {
+  let Dummy.Fresh dummy = global_dummy in
+  let arr = Dummy.Array.make n x ~dummy in
+  Pack {
     length = n;
-    arr = Array.init n (fun _ -> Elem {v = x});
+    arr;
+    dummy;
   }
 
-let init n f =
+let init (type a) n (f : int -> a) : a t =
   if n < 0 then Error.negative_length_requested "init" n;
-  {
+  let Dummy.Fresh dummy = global_dummy in
+  let arr = Dummy.Array.init ~dummy n f in
+  Pack {
     length = n;
-    arr = Array.init n (fun i -> Elem {v = f i});
+    arr;
+    dummy;
   }
 
-let get a i =
+let get (type a) (Pack a : a t) i =
   (* This implementation will propagate an [Invalid_argument] exception
      from array lookup if the index is out of the backing array,
      instead of using our own [Error.index_out_of_bounds]. This is
      allowed by our specification, and more efficient -- no need to
      check that [length a <= capacity a] in the fast path. *)
-  match a.arr.(i) with
-  | Elem s -> s.v
-  | Empty ->
-      Error.unexpected_empty_element "get" ~i ~length:a.length
+  let v = a.arr.(i) in
+  if Dummy.is_dummy v a.dummy
+  then Error.unexpected_empty_element "get" ~i ~length:a.length
+  else Dummy.unsafe_get v
 
-let set a i x =
-  (* See {!get} comment on the use of checked array
-     access without our own bound checking. *)
-  match a.arr.(i) with
-  | Elem s -> s.v <- x
-  | Empty ->
-      Error.unexpected_empty_element "set" ~i ~length:a.length
+let set (Pack a) i x =
+  let {arr; length; _} = a in
+  if i >= length then Error.index_out_of_bounds "set" ~i ~length
+  else arr.(i) <- Dummy.of_val x
 
-let length a = a.length
+let length (Pack a) = a.length
 
-let is_empty a = (a.length = 0)
+let is_empty (Pack a) = (a.length = 0)
 
-let copy {length; arr} =
+let copy (type a) (Pack {length; arr; dummy} : a t) : a t =
   check_valid_length length arr;
   (* use [length] as the new capacity to make
      this an O(length) operation. *)
-  {
-    length;
-    arr = Array.init length (fun i ->
-      let v = unsafe_get arr ~i ~length in
-      Elem {v}
-    );
-  }
+  let arr = Dummy.Array.prefix arr length in
+  Pack { length; arr; dummy }
 
-let get_last a =
-  let {arr; length} = a in
+let get_last (Pack a) =
+  let {arr; length; dummy} = a in
   check_valid_length length arr;
   (* We know [length <= capacity a]. *)
   if length = 0 then Error.empty_dynarray "get_last";
   (* We know [length > 0]. *)
-  unsafe_get arr ~i:(length - 1) ~length
+  unsafe_get arr ~dummy ~i:(length - 1) ~length
 
-let find_last a =
-  let {arr; length} = a in
+let find_last (Pack a) =
+  let {arr; length; dummy} = a in
   check_valid_length length arr;
   (* We know [length <= capacity a]. *)
   if length = 0 then None
   else
     (* We know [length > 0]. *)
-    Some (unsafe_get arr ~i:(length - 1) ~length)
+    Some (unsafe_get arr ~dummy ~i:(length - 1) ~length)
 
 (** {1:removing Removing elements} *)
 
-let pop_last a =
-  let {arr; length} = a in
+let pop_last (Pack a) =
+  let {arr; length; dummy} = a in
   check_valid_length length arr;
   (* We know [length <= capacity a]. *)
   if length = 0 then raise Not_found;
   let last = length - 1 in
   (* We know [length > 0] so [last >= 0]. *)
-  match Array.unsafe_get arr last with
-  | Empty ->
-      Error.missing_element ~i:last ~length
-  | Elem s ->
-      Array.unsafe_set arr last Empty;
-      a.length <- last;
-      s.v
+  let v = unsafe_get arr ~dummy ~i:last ~length in
+  Array.unsafe_set arr last (Dummy.of_dummy dummy);
+  a.length <- last;
+  v
 
 let pop_last_opt a =
   match pop_last a with
   | exception Not_found -> None
   | x -> Some x
 
-let remove_last a =
-  let last = length a - 1 in
+let remove_last (Pack a) =
+  let last = a.length - 1 in
   if last >= 0 then begin
     a.length <- last;
-    a.arr.(last) <- Empty;
+    a.arr.(last) <- Dummy.of_dummy a.dummy;
   end
 
-let truncate a n =
+let truncate (Pack a) n =
   if n < 0 then Error.negative_length_requested "truncate" n;
-  let {arr; length} = a in
+  let {arr; length; dummy} = a in
   if length <= n then ()
   else begin
     a.length <- n;
-    Array.fill arr n (length - n) Empty;
+    Array.fill arr n (length - n) (Dummy.of_dummy dummy)
   end
 
 let clear a = truncate a 0
@@ -324,7 +554,7 @@ let clear a = truncate a 0
 
 (** {1:capacity Backing array and capacity} *)
 
-let capacity a = Array.length a.arr
+let capacity (Pack a) = Array.length a.arr
 
 let next_capacity n =
   let n' =
@@ -344,7 +574,7 @@ let next_capacity n =
   (* jump directly from 0 to 8 *)
   min (max 8 n') Sys.max_array_length
 
-let ensure_capacity a capacity_request =
+let ensure_capacity (Pack a) capacity_request =
   let arr = a.arr in
   let cur_capacity = Array.length arr in
   if capacity_request < 0 then
@@ -373,8 +603,9 @@ let ensure_capacity a capacity_request =
          will have amortized-linear rather than quadratic complexity.
       *)
       max (next_capacity cur_capacity) capacity_request in
-    let new_arr = Array.make new_capacity Empty in
-    Array.blit arr 0 new_arr 0 a.length;
+    assert (new_capacity > 0);
+    let new_arr =
+      Dummy.Array.extend arr ~length:a.length ~dummy:a.dummy ~new_capacity in
     a.arr <- new_arr;
     (* postcondition: *)
     assert (0 <= capacity_request);
@@ -384,27 +615,26 @@ let ensure_capacity a capacity_request =
 let ensure_extra_capacity a extra_capacity_request =
   ensure_capacity a (length a + extra_capacity_request)
 
-let fit_capacity a =
-  if capacity a = a.length
+let fit_capacity (Pack a) =
+  if Array.length a.arr = a.length
   then ()
-  else a.arr <- Array.sub a.arr 0 a.length
+  else a.arr <- Dummy.Array.prefix a.arr a.length
 
-let set_capacity a n =
+let set_capacity (Pack a) n =
   if n < 0 then
     Error.negative_capacity_requested "set_capacity" n;
   let arr = a.arr in
   let cur_capacity = Array.length arr in
   if n < cur_capacity then begin
     a.length <- min a.length n;
-    a.arr <- Array.sub arr 0 n;
+    a.arr <- Dummy.Array.prefix arr n;
   end
   else if n > cur_capacity then begin
-    let new_arr = Array.make n Empty in
-    Array.blit arr 0 new_arr 0 a.length;
-    a.arr <- new_arr;
+    a.arr <-
+      Dummy.Array.extend arr ~length:a.length ~dummy:a.dummy ~new_capacity:n;
   end
 
-let reset a =
+let reset (Pack a) =
   a.length <- 0;
   a.arr <- [||]
 
@@ -421,29 +651,28 @@ let reset a =
    against.)
 *)
 
-(* [add_last_if_room a elem] only writes the slot if there is room, and
+(* [add_last_if_room a v] only writes the value if there is room, and
    returns [false] otherwise. *)
-let[@inline] add_last_if_room a elem =
-  let {arr; length} = a in
+let[@inline] add_last_if_room (Pack a) v =
+  let {arr; length; _} = a in
   (* we know [0 <= length] *)
   if length >= Array.length arr then false
   else begin
     (* we know [0 <= length < Array.length arr] *)
     a.length <- length + 1;
-    Array.unsafe_set arr length elem;
+    Array.unsafe_set arr length (Dummy.of_val v);
     true
   end
 
 let add_last a x =
-  let elem = Elem {v = x} in
-  if add_last_if_room a elem then ()
+  if add_last_if_room a x then ()
   else begin
     (* slow path *)
-    let rec grow_and_add a elem =
+    let rec grow_and_add a x =
       ensure_extra_capacity a 1;
-      if not (add_last_if_room a elem)
-      then grow_and_add a elem
-    in grow_and_add a elem
+      if not (add_last_if_room a x)
+      then grow_and_add a x
+    in grow_and_add a x
   end
 
 let rec append_list a li =
@@ -457,19 +686,66 @@ let append_iter a iter b =
 let append_seq a seq =
   Seq.iter (fun x -> add_last a x) seq
 
+(* blitting *)
+
+let blit_assume_room
+    (Pack src) src_pos src_length
+    (Pack dst) dst_pos dst_length
+    blit_length
+=
+  (* The caller of [blit_assume_room] typically calls
+     [ensure_capacity] right before. This could run asynchronous
+     code. We want to fail reliably on any asynchronous length change,
+     as it may invalidate the source and target ranges provided by the
+     user. So we double-check that the lengths have not changed.  *)
+  let src_arr = src.arr in
+  let dst_arr = dst.arr in
+  check_same_length "blit" (Pack src) ~length:src_length;
+  check_same_length "blit" (Pack dst) ~length:dst_length;
+  if dst_pos + blit_length > dst_length then begin
+    dst.length <- dst_pos + blit_length;
+  end;
+  (* note: [src] and [dst] may be equal when self-blitting, so
+     [src.length] may have been mutated here. *)
+  Dummy.Array.blit
+    src_arr src.dummy src_pos
+    dst_arr dst.dummy dst_pos
+    ~len:blit_length
+
+let blit ~src ~src_pos ~dst ~dst_pos ~len =
+  let src_length = length src in
+  let dst_length = length dst in
+  if len < 0 then
+    Printf.ksprintf invalid_arg
+      "Dynarray.blit: invalid blit length (%d)"
+      len;
+  if src_pos < 0 || src_pos + len > src_length then
+    Printf.ksprintf invalid_arg
+      "Dynarray.blit: invalid source region (%d..%d) \
+       in source dynarray of length %d"
+      src_pos (src_pos + len) src_length;
+  if dst_pos < 0 || dst_pos > dst_length then
+    Printf.ksprintf invalid_arg
+      "Dynarray.blit: invalid target region (%d..%d) \
+       in target dynarray of length %d"
+      dst_pos (dst_pos + len) dst_length;
+  ensure_capacity dst (dst_pos + len);
+  blit_assume_room
+    src src_pos src_length
+    dst dst_pos dst_length
+    len
+
 (* append_array: same [..._if_room] and loop logic as [add_last]. *)
 
-let append_array_if_room a b =
-  let {arr; length = length_a} = a in
+let append_array_if_room (Pack a) b =
+  let {arr; length = length_a; _} = a in
   let length_b = Array.length b in
   if length_a + length_b > Array.length arr then false
   else begin
-    a.length <- length_a + length_b;
     (* Note: we intentionally update the length *before* filling the
        elements. This "reserve before fill" approach provides better
        behavior than "fill then notify" in presence of reentrant
-       modifications (which may occur below, on a poll point in the loop or
-       the [Elem] allocation):
+       modifications (which may occur on [blit] below):
 
        - If some code asynchronously adds new elements after this
          length update, they will go after the space we just reserved,
@@ -483,7 +759,7 @@ let append_array_if_room a b =
          reserved-but-not-yet-filled space, it will get a clean "missing
          element" error. This is worse than with the fill-then-notify
          approach where the new elements would only become visible
-         (to iterators, for removal, etc.) alltogether at the end of
+         (to iterators, for removal, etc.) altogether at the end of
          loop.
 
        To summarise, "reserve before fill" is better on add-add races,
@@ -492,10 +768,8 @@ let append_array_if_room a b =
        reserve-before fails on add-remove or add-iterate races with
        a clean error, while notify-after fails on add-add races with
        silently disappearing data. *)
-    for i = 0 to length_b - 1 do
-      let x = Array.unsafe_get b i in
-      Array.unsafe_set arr (length_a + i) (Elem {v = x})
-    done;
+    a.length <- length_a + length_b;
+    Dummy.Array.blit_array b 0 arr length_a ~len:length_b;
     true
   end
 
@@ -509,25 +783,23 @@ let append_array a b =
       then grow_and_append a b
     in grow_and_append a b  end
 
-(* append: same [..._if_room] and loop logic as [add_last],
-   same reserve-before-fill logic as [append_array]. *)
+(* append: same [..._if_room] and loop logic as [add_last]. *)
 
 (* It is a programming error to mutate the length of [b] during a call
    to [append a b]. To detect this mistake we keep track of the length
    of [b] throughout the computation and check it that does not
    change.
 *)
-let append_if_room a b ~length_b =
-  let {arr = arr_a; length = length_a} = a in
+let append_if_room (Pack a) b ~length_b =
+  let {arr = arr_a; length = length_a; _} = a in
   if length_a + length_b > Array.length arr_a then false
   else begin
-    a.length <- length_a + length_b;
-    let arr_b = b.arr in
-    check_valid_length length_b arr_b;
-    for i = 0 to length_b - 1 do
-      let x = unsafe_get arr_b ~i ~length:length_b in
-      Array.unsafe_set arr_a (length_a + i) (Elem {v = x})
-    done;
+    (* blit [0..length_b-1]
+       into [length_a..length_a+length_b-1]. *)
+    blit_assume_room
+      b 0 length_b
+      (Pack a) length_a length_a
+      length_b;
     check_same_length "append" b ~length:length_b;
     true
   end
@@ -569,7 +841,7 @@ let append a b =
 *)
 
 let iter_ f k a =
-  let {arr; length} = a in
+  let Pack {arr; length; dummy} = a in
   (* [check_valid_length length arr] is used for memory safety, it
      guarantees that the backing array has capacity at least [length],
      allowing unsafe array access.
@@ -595,7 +867,7 @@ let iter_ f k a =
   *)
   check_valid_length length arr;
   for i = 0 to length - 1 do
-    k (unsafe_get arr ~i ~length);
+    k (unsafe_get arr ~dummy ~i ~length);
   done;
   check_same_length f a ~length
 
@@ -603,81 +875,90 @@ let iter k a =
   iter_ "iter" k a
 
 let iteri k a =
-  let {arr; length} = a in
+  let Pack {arr; length; dummy} = a in
   check_valid_length length arr;
   for i = 0 to length - 1 do
-    k i (unsafe_get arr ~i ~length);
+    k i (unsafe_get arr ~i ~dummy ~length);
   done;
   check_same_length "iteri" a ~length
 
 let map f a =
-  let {arr; length} = a in
-  check_valid_length length arr;
-  let res = {
+  let Pack {arr = arr_in; length; dummy} = a in
+  check_valid_length length arr_in;
+  let arr_out = Array.make length (Dummy.of_dummy dummy) in
+  for i = 0 to length - 1 do
+    Array.unsafe_set arr_out i
+      (Dummy.of_val (f (unsafe_get arr_in ~dummy ~i ~length)))
+  done;
+  let res = Pack {
     length;
-    arr = Array.init length (fun i ->
-      Elem {v = f (unsafe_get arr ~i ~length)});
+    arr = arr_out;
+    dummy;
   } in
   check_same_length "map" a ~length;
   res
 
-
 let mapi f a =
-  let {arr; length} = a in
-  check_valid_length length arr;
-  let res = {
+  let Pack {arr = arr_in; length; dummy} = a in
+  check_valid_length length arr_in;
+  let arr_out = Array.make length (Dummy.of_dummy dummy) in
+  for i = 0 to length - 1 do
+    Array.unsafe_set arr_out i
+      (Dummy.of_val (f i (unsafe_get arr_in ~dummy ~i ~length)))
+  done;
+  let res = Pack {
     length;
-    arr = Array.init length (fun i ->
-      Elem {v = f i (unsafe_get arr ~i ~length)});
+    arr = arr_out;
+    dummy;
   } in
   check_same_length "mapi" a ~length;
   res
 
 let fold_left f acc a =
-  let {arr; length} = a in
+  let Pack {arr; length; dummy} = a in
   check_valid_length length arr;
   let r = ref acc in
   for i = 0 to length - 1 do
-    let v = unsafe_get arr ~i ~length in
+    let v = unsafe_get arr ~dummy ~i ~length in
     r := f !r v;
   done;
   check_same_length "fold_left" a ~length;
   !r
 
 let fold_right f a acc =
-  let {arr; length} = a in
+  let Pack {arr; length; dummy} = a in
   check_valid_length length arr;
   let r = ref acc in
   for i = length - 1 downto 0 do
-    let v = unsafe_get arr ~i ~length in
+    let v = unsafe_get arr ~dummy ~i ~length in
     r := f v !r;
   done;
   check_same_length "fold_right" a ~length;
   !r
 
 let exists p a =
-  let {arr; length} = a in
+  let Pack {arr; length; dummy} = a in
   check_valid_length length arr;
-  let rec loop p arr i length =
+  let rec loop p arr dummy i length =
     if i = length then false
     else
-      p (unsafe_get arr ~i ~length)
-      || loop p arr (i + 1) length
+      p (unsafe_get arr ~dummy ~i ~length)
+      || loop p arr dummy (i + 1) length
   in
-  let res = loop p arr 0 length in
+  let res = loop p arr dummy 0 length in
   check_same_length "exists" a ~length;
   res
 
 let for_all p a =
-  let {arr; length} = a in
+  let Pack {arr; length; dummy} = a in
   check_valid_length length arr;
-  let rec loop p arr i length =
+  let rec loop p arr dummy i length =
     if i = length then true
     else
-      p (unsafe_get arr ~i ~length)
-      && loop p arr (i + 1) length
+      p (unsafe_get arr ~dummy ~i ~length)
+      && loop p arr dummy (i + 1) length
   in
-  let res = loop p arr 0 length in
+  let res = loop p arr dummy 0 length in
   check_same_length "for_all" a ~length;
   res
 
@@ -695,6 +976,132 @@ let filter_map f a =
   ) a;
   b
 
+let mem x a =
+  let Pack {arr; length; dummy} = a in
+  check_valid_length length arr;
+  let rec loop i =
+    if i = length then false
+    else if Stdlib.compare (unsafe_get arr ~dummy ~i ~length) x = 0 then
+      true
+    else loop (succ i)
+  in
+  let res = loop 0 in
+  check_same_length "mem" a ~length;
+  res
+
+let memq x a =
+  let Pack {arr; length; dummy} = a in
+  check_valid_length length arr;
+  let rec loop i =
+    if i = length then false
+    else if (unsafe_get arr ~dummy ~i ~length) == x then
+      true
+    else loop (succ i)
+  in
+  let res = loop 0 in
+  check_same_length "memq" a ~length;
+  res
+
+let find_opt p a =
+  let Pack {arr; length; dummy} = a in
+  check_valid_length length arr;
+  let rec loop i =
+    if i = length then None
+    else
+      let x = unsafe_get arr ~dummy ~i ~length in
+      if p x then Some x
+      else loop (succ i)
+  in
+  let res = loop 0 in
+  check_same_length "find_opt" a ~length;
+  res
+
+let find_index p a =
+  let Pack {arr; length; dummy} = a in
+  check_valid_length length arr;
+  let rec loop i =
+    if i = length then None
+    else
+      let x = unsafe_get arr ~dummy ~i ~length in
+      if p x then Some i
+      else loop (succ i)
+  in
+  let res = loop 0 in
+  check_same_length "find_index" a ~length;
+  res
+
+let find_map p a =
+  let Pack {arr; length; dummy} = a in
+  check_valid_length length arr;
+  let rec loop i =
+    if i = length then None
+    else
+      match p (unsafe_get arr ~dummy ~i ~length) with
+      | None -> loop (succ i)
+      | Some _ as r -> r
+  in
+  let res = loop 0 in
+  check_same_length "find_map" a ~length;
+  res
+
+let find_mapi p a =
+  let Pack {arr; length; dummy} = a in
+  check_valid_length length arr;
+  let rec loop i =
+    if i = length then None
+    else
+      match p i (unsafe_get arr ~dummy ~i ~length) with
+      | None -> loop (succ i)
+      | Some _ as r -> r
+  in
+  let res = loop 0 in
+  check_same_length "find_mapi" a ~length;
+  res
+
+let equal eq a1 a2 =
+  let Pack {arr = arr1; length = length; dummy = dum1} = a1 in
+  let Pack {arr = arr2; length = len2; dummy = dum2} = a2 in
+  if length <> len2 then false
+  else begin
+    check_valid_length length arr1;
+    check_valid_length length arr2;
+    let rec loop i =
+      if i = length then true
+      else
+        eq
+          (unsafe_get arr1 ~dummy:dum1 ~i ~length)
+          (unsafe_get arr2 ~dummy:dum2 ~i ~length)
+        && loop (i + 1)
+    in
+    let r = loop 0 in
+    check_same_length "equal" a1 ~length;
+    check_same_length "equal" a2 ~length;
+    r
+  end
+
+let compare cmp a1 a2 =
+  let Pack {arr = arr1; length = length; dummy = dum1} = a1 in
+  let Pack {arr = arr2; length = len2; dummy = dum2} = a2 in
+  if length <> len2 then length - len2
+  else begin
+    check_valid_length length arr1;
+    check_valid_length length arr2;
+    let rec loop i =
+      if i = length then 0
+      else
+        let c =
+          cmp
+            (unsafe_get arr1 ~dummy:dum1 ~i ~length)
+            (unsafe_get arr2 ~dummy:dum2 ~i ~length)
+        in
+        if c <> 0 then c
+        else loop (i + 1)
+    in
+    let r = loop 0 in
+    check_same_length "compare" a1 ~length;
+    check_same_length "compare" a2 ~length;
+    r
+  end
 
 (** {1:conversions Conversions to other data structures} *)
 
@@ -705,31 +1112,40 @@ let filter_map f a =
 
 let of_array a =
   let length = Array.length a in
-  {
+  let Dummy.Fresh dummy = global_dummy in
+  let arr = Dummy.Array.copy a ~dummy in
+  Pack {
     length;
-    arr = Array.init length (fun i -> Elem {v = Array.unsafe_get a i});
+    arr;
+    dummy;
   }
 
 let to_array a =
-  let {arr; length} = a in
+  let Pack {arr; length; dummy} = a in
   check_valid_length length arr;
   let res = Array.init length (fun i ->
-    unsafe_get arr ~i ~length)
-  in
+    unsafe_get arr ~dummy ~i ~length
+  ) in
   check_same_length "to_array" a ~length;
   res
 
 let of_list li =
-  let a = create () in
-  List.iter (fun x -> add_last a x) li;
-  a
+  let a = Array.of_list li in
+  let length = Array.length a in
+  let Dummy.Fresh dummy = global_dummy in
+  let arr = Dummy.Array.unsafe_nocopy a ~dummy in
+  Pack {
+    length;
+    arr;
+    dummy;
+  }
 
 let to_list a =
-  let {arr; length} = a in
+  let Pack {arr; length; dummy} = a in
   check_valid_length length arr;
   let l = ref [] in
   for i = length - 1 downto 0 do
-    l := unsafe_get arr ~i ~length :: !l
+    l := unsafe_get arr ~dummy ~i ~length :: !l
   done;
   check_same_length "to_list" a ~length;
   !l
@@ -740,13 +1156,13 @@ let of_seq seq =
   init
 
 let to_seq a =
-  let {arr; length} = a in
+  let Pack {arr; length; dummy} = a in
   check_valid_length length arr;
   let rec aux i = fun () ->
     check_same_length "to_seq" a ~length;
     if i >= length then Seq.Nil
     else begin
-      let v = unsafe_get arr ~i ~length in
+      let v = unsafe_get arr ~dummy ~i ~length in
       Seq.Cons (v, aux (i + 1))
     end
   in
@@ -763,13 +1179,13 @@ let to_seq_reentrant a =
   aux 0
 
 let to_seq_rev a =
-  let {arr; length} = a in
+  let Pack {arr; length; dummy} = a in
   check_valid_length length arr;
   let rec aux i = fun () ->
     check_same_length "to_seq_rev" a ~length;
     if i < 0 then Seq.Nil
     else begin
-      let v = unsafe_get arr ~i ~length in
+      let v = unsafe_get arr ~dummy ~i ~length in
       Seq.Cons (v, aux (i - 1))
     end
   in

diff --git a/stdlib/dynarray.mli b/stdlib/dynarray.mli
index 80281b50b8e0221979c12caa1f84ad5f6084d105..c638ddb5bb03a5d3f778ec8775ba9d5f412ec657 100644 (file)
--- a/stdlib/dynarray.mli
+++ b/stdlib/dynarray.mli
@@ -23,7 +23,7 @@
 
     This is typically used to accumulate elements whose number is not
     known in advance or changes during computation, while also
-    providing fast access to elements at arbitrary positions.
+    providing fast access to elements at arbitrary indices.
 
 {[
     let dynarray_of_list li =
@@ -39,10 +39,6 @@
     The {!Stack} module provides a last-in first-out data structure
     that can be easily implemented on top of dynamic arrays.
 
-    {b Warning.} In their current implementation, the memory layout
-    of dynamic arrays differs from the one of {!Array}s. See the
-    {{!section:memory_layout} Memory Layout} section for more information.
-
     @since 5.2
 *)
 
@@ -185,6 +181,23 @@ val append_iter :
     [1], [2], and then [3] at the end of [a].
     [append_iter a Queue.iter q] adds elements from the queue [q]. *)
 
+val blit : src:'a t -> src_pos:int -> dst:'a t -> dst_pos:int -> len:int -> unit
+(** [blit ~src ~src_pos ~dst ~dst_pos ~len] copies [len] elements from
+    a source dynarray [src], starting at index [src_pos], to
+    a destination dynarray [dst], starting at index [dst_pos]. It
+    works correctly even if [src] and [dst] are the same array, and
+    the source and destination chunks overlap.
+
+    Unlike {!Array.blit}, {!Dynarray.blit} can extend the destination
+    array with new elements: it is valid to call [blit] even when
+    [dst_pos + len] is larger than [length dst]. The only requirement
+    is that [dst_pos] must be at most [length dst] (included), so that
+    there is no gap between the current elements and the blit
+    region.
+
+    @raise Invalid_argument if [src_pos] and [len] do not designate
+    a valid subarray of [src], or if [dst_pos] is strictly below [0]
+    or strictly above [length dst]. *)
 
 (** {1:removing Removing elements} *)
 
@@ -274,21 +287,6 @@ val fold_right : ('a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc
     where [x0], [x1], ..., [xn] are the elements of [a].
 *)
 
-val exists : ('a -> bool) -> 'a t -> bool
-(** [exists f a] is [true] if some element of [a] satisfies [f].
-
-    For example, if the elements of [a] are [x0], [x1], [x2], then
-    [exists f a] is [f x0 || f x1 || f x2].
-*)
-
-val for_all : ('a -> bool) -> 'a t -> bool
-(** [for_all f a] is [true] if all elements of [a] satisfy [f].
-    This includes the case where [a] is empty.
-
-    For example, if the elements of [a] are [x0], [x1], then
-    [exists f a] is [f x0 && f x1 && f x2].
-*)
-
 val filter : ('a -> bool) -> 'a t -> 'a t
 (** [filter f a] is a new array of all the elements of [a] that satisfy [f].
     In other words, it is an array [b] such that, for each element [x]
@@ -312,6 +310,97 @@ val filter_map : ('a -> 'b option) -> 'a t -> 'b t
     ignoring strings that cannot be converted to integers.
 *)
 
+(** {1:dynarray_scanning Dynarray scanning } *)
+
+val exists : ('a -> bool) -> 'a t -> bool
+(** [exists f a] is [true] if some element of [a] satisfies [f].
+
+    For example, if the elements of [a] are [x0], [x1], [x2], then
+    [exists f a] is [f x0 || f x1 || f x2].
+*)
+
+val for_all : ('a -> bool) -> 'a t -> bool
+(** [for_all f a] is [true] if all elements of [a] satisfy [f].
+    This includes the case where [a] is empty.
+
+    For example, if the elements of [a] are [x0], [x1], then
+    [exists f a] is [f x0 && f x1 && f x2].
+*)
+
+val mem : 'a -> 'a t -> bool
+(** [mem a set] is true if and only if [a] is structurally equal
+    to an element of [set] (i.e. there is an [x] in [set] such that
+    [compare a x = 0]).
+
+    @since 5.3
+*)
+
+val memq : 'a -> 'a t -> bool
+(** Same as {!mem}, but uses physical equality
+    instead of structural equality to compare array elements.
+
+    @since 5.3
+ *)
+
+val find_opt : ('a -> bool) -> 'a t -> 'a option
+(** [find_opt f a] returns the first element of the array [a] that satisfies
+    the predicate [f], or [None] if there is no value that satisfies [f] in the
+    array [a].
+
+    @since 5.3
+*)
+
+val find_index : ('a -> bool) -> 'a t -> int option
+(** [find_index f a] returns [Some i], where [i] is the index of the first
+    element of the array [a] that satisfies [f x], if there is such an
+    element.
+
+    It returns [None] if there is no such element.
+
+    @since 5.3
+*)
+
+val find_map : ('a -> 'b option) -> 'a t -> 'b option
+(** [find_map f a] applies [f] to the elements of [a] in order, and returns the
+    first result of the form [Some v], or [None] if none exist.
+
+    @since 5.3
+*)
+
+val find_mapi : (int -> 'a -> 'b option) -> 'a t -> 'b option
+(** Same as [find_map], but the predicate is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.
+
+   @since 5.3
+ *)
+
+(** {1:comparison Comparison functions}
+
+    Comparison functions iterate over their arguments; it is
+    a programming error to change their length during the iteration,
+    see the {{!section:iteration} Iteration} section above.
+ *)
+
+val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+(** [equal eq a b] holds when [a] and [b] have the same length,
+    and for all indices [i] we have [eq (get a i) (get b i)].
+
+    @since 5.3
+*)
+
+val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
+(** Provided the function [cmp] defines a preorder on elements,
+    [compare cmp a b] compares first [a] and [b] by their length,
+    and then, if equal, by their elements according to
+    the lexicographic preorder.
+
+    For more details on comparison functions, see {!Array.sort}.
+
+    @since 5.3
+*)
+
+
 (** {1:conversions Conversions to other data structures}
 
     Note: the [of_*] functions raise [Invalid_argument] if the
@@ -489,40 +578,12 @@ val reset : 'a t -> unit
 (** {2:noleaks No leaks: preservation of memory liveness}
 
     The user-provided values reachable from a dynamic array [a] are
-    exactly the elements in the positions [0] to [length a - 1]. In
+    exactly the elements in the indices [0] to [length a - 1]. In
     particular, no user-provided values are "leaked" by being present
-    in the backing array in position [length a] or later.
-*)
-
-(** {2:memory_layout Memory layout of dynarrays}
-
-    In the current implementation, the backing array of an
-    ['a Dynarray.t] is not an ['a array], but something with the same
-    representation as an ['a option array] or ['a ref array].
-    Each element is in a "box", allocated when the element is first
-    added to the array -- see the implementation for more details.
-
-    Using an ['a array] would be delicate, as there is no obvious
-    type-correct way to represent the empty space at the end of the
-    backing array -- using user-provided values would either
-    complicate the API or violate the {{!section:noleaks}no leaks}
-    guarantee. The constraint of remaining memory-safe under
-    unsynchronized concurrent usage makes it even more
-    difficult. Various unsafe ways to do this have been discussed,
-    with no consensus on a standard implementation so far.
-
-    On a realistic automated-theorem-proving program that relies
-    heavily on dynamic arrays, we measured the overhead of this extra
-    "boxing" as at most 25%. We believe that the overhead for most
-    uses of dynarray is much smaller, negligible in many cases, but
-    you may still prefer to use your own specialized implementation
-    for performance. (If you know that you do not need the
-    {{:noleaks}no leaks} guarantee, you can also speed up deleting
-    elements.)
+    in the backing array at index [length a] or later.
 *)
 
 
-
 (** {1:examples Code examples}
 
 {2:example_min_heap Min-heaps for mutable priority queues}
@@ -606,7 +667,7 @@ end = struct
       let last = Dynarray.length h - 1 in
       swap h 0 last;
       (* At this point [pop_last] returns the 'best' value,
-         and leaves a heap with one misplaced element at position 0. *)
+         and leaves a heap with one misplaced element at index [0]. *)
       let best = Dynarray.pop_last h in
       (* Restore the heap ordering -- does nothing if the heap is empty. *)
       heap_down h ~len:last 0;

diff --git a/stdlib/effect.ml b/stdlib/effect.ml
index 611dfb6fdf14a372008fc9c786b9213b990349f3..5241a65a4cbfbfc73009d0a947332d07fdc2ddbf 100644 (file)
--- a/stdlib/effect.ml
+++ b/stdlib/effect.ml
@@ -12,7 +12,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-type 'a t = ..
+type 'a t = 'a eff = ..
 external perform : 'a t -> 'a = "%perform"
 
 type exn += Unhandled: 'a t -> exn
@@ -45,7 +45,7 @@ external runstack : ('a, 'b) stack -> ('c -> 'a) -> 'c -> 'b = "%runstack"
 
 module Deep = struct
 
-  type ('a,'b) continuation
+  type nonrec ('a,'b) continuation = ('a,'b) continuation
 
   external take_cont_noexc : ('a, 'b) continuation -> ('a, 'b) stack =
     "caml_continuation_use_noexc" [@@noalloc]
@@ -55,8 +55,6 @@ module Deep = struct
     ('c t -> ('c, 'b) continuation -> last_fiber -> 'b) ->
     ('a, 'b) stack = "caml_alloc_stack"
   external cont_last_fiber : ('a, 'b) continuation -> last_fiber = "%field1"
-  external cont_set_last_fiber :
-    ('a, 'b) continuation -> last_fiber -> unit = "%setfield1"
 
   let continue k v =
     resume (take_cont_noexc k) (fun x -> x) v (cont_last_fiber k)
@@ -79,9 +77,7 @@ module Deep = struct
   let match_with comp arg handler =
     let effc eff k last_fiber =
       match handler.effc eff with
-      | Some f ->
-          cont_set_last_fiber k last_fiber;
-          f k
+      | Some f -> f k
       | None -> reperform eff k last_fiber
     in
     let s = alloc_stack handler.retc handler.exnc effc in
@@ -93,9 +89,7 @@ module Deep = struct
   let try_with comp arg handler =
     let effc' eff k last_fiber =
       match handler.effc eff with
-      | Some f ->
-          cont_set_last_fiber k last_fiber;
-          f k
+      | Some f -> f k
       | None -> reperform eff k last_fiber
     in
     let s = alloc_stack (fun x -> x) (fun e -> raise e) effc' in
@@ -117,19 +111,15 @@ module Shallow = struct
     ('a, 'b) stack = "caml_alloc_stack"
 
   external cont_last_fiber : ('a, 'b) continuation -> last_fiber = "%field1"
-  external cont_set_last_fiber :
-    ('a, 'b) continuation -> last_fiber -> unit = "%setfield1"
 
   let fiber : type a b. (a -> b) -> (a, b) continuation = fun f ->
     let module M = struct type _ t += Initial_setup__ : a t end in
     let exception E of (a,b) continuation in
     let f' () = f (perform M.Initial_setup__) in
     let error _ = failwith "impossible" in
-    let effc eff k last_fiber =
+    let effc eff k _last_fiber =
       match eff with
-      | M.Initial_setup__ ->
-          cont_set_last_fiber k last_fiber;
-          raise_notrace (E k)
+      | M.Initial_setup__ -> raise_notrace (E k)
       | _ -> error ()
     in
     let s = alloc_stack error error effc in
@@ -155,9 +145,7 @@ module Shallow = struct
   let continue_gen k resume_fun v handler =
     let effc eff k last_fiber =
       match handler.effc eff with
-      | Some f ->
-          cont_set_last_fiber k last_fiber;
-          f k
+      | Some f -> f k
       | None -> reperform eff k last_fiber
     in
     let last_fiber = cont_last_fiber k in

diff --git a/stdlib/effect.mli b/stdlib/effect.mli
index 10a347481cc26c322941369b3d13364ba63d4b2a..c9b3198eae7e6f41a73cc22f3689c1c9b2a541b3 100644 (file)
--- a/stdlib/effect.mli
+++ b/stdlib/effect.mli
@@ -22,7 +22,7 @@
 
     @since 5.0 *)
 
-type _ t = ..
+type 'a t = 'a eff = ..
 (** The type of effects. *)
 
 exception Unhandled : 'a t -> exn
@@ -41,7 +41,7 @@ external perform : 'a t -> 'a = "%perform"
 module Deep : sig
   (** Deep handlers *)
 
-  type ('a,'b) continuation
+  type nonrec ('a,'b) continuation = ('a,'b) continuation
   (** [('a,'b) continuation] is a delimited continuation that expects a ['a]
       value and returns a ['b] value. *)
 

diff --git a/stdlib/filename.ml b/stdlib/filename.ml
index a2fafafc9d2ba23ea5c620ae1d8c6c6999ed1d39..bd061a77dab0d552b79569bec9c977259b05c2da 100644 (file)
--- a/stdlib/filename.ml
+++ b/stdlib/filename.ml
@@ -219,6 +219,13 @@ Quoting commands for execution by cmd.exe is difficult.
       s;
     Buffer.contents b
   let quote_cmd_filename f =
+    (* In cmd.exe, forward slashes in the program path (argument 0) are
+       interpreted as introducing a flag. *)
+    let f =
+      if String.contains f '/' then
+        String.map (function '/' -> '\\' | c -> c) f
+      else f
+    in
     if String.exists (function '\"' | '%' -> true | _ -> false) f then
       failwith ("Filename.quote_command: bad file name " ^ f)
     else if String.contains f ' ' then

diff --git a/stdlib/float.ml b/stdlib/float.ml
index 9d40f0c214d7ecbba270fcfa3e99dd9ebc1a1b9d..41b4d3760711bc660a127a7099c0ecb13fe1d694 100644 (file)
--- a/stdlib/float.ml
+++ b/stdlib/float.ml
@@ -180,20 +180,24 @@ module Array = struct
   external unsafe_get : t -> int -> float = "%floatarray_unsafe_get"
   external unsafe_set : t -> int -> float -> unit = "%floatarray_unsafe_set"
 
-  let unsafe_fill a ofs len v =
-    for i = ofs to ofs + len - 1 do unsafe_set a i v done
+  external make : (int[@untagged]) -> (float[@unboxed]) -> t =
+    "caml_floatarray_make" "caml_floatarray_make_unboxed"
+
+  external unsafe_fill
+    : t -> (int[@untagged]) -> (int[@untagged]) -> (float[@unboxed]) -> unit
+    = "caml_floatarray_fill" "caml_floatarray_fill_unboxed"
 
   external unsafe_blit: t -> int -> t -> int -> int -> unit =
     "caml_floatarray_blit" [@@noalloc]
 
+  external unsafe_sub : t -> int -> int -> t = "caml_floatarray_sub"
+  external append_prim : t -> t -> t = "caml_floatarray_append"
+
   let check a ofs len msg =
     if ofs < 0 || len < 0 || ofs + len < 0 || ofs + len > length a then
       invalid_arg msg
 
-  let make n v =
-    let result = create n in
-    unsafe_fill result 0 n v;
-    result
+  let empty = create 0
 
   let init l f =
     if l < 0 then invalid_arg "Float.Array.init"
@@ -230,14 +234,6 @@ module Array = struct
     end;
     res
 
-  let append a1 a2 =
-    let l1 = length a1 in
-    let l2 = length a2 in
-    let result = create (l1 + l2) in
-    unsafe_blit a1 0 result 0 l1;
-    unsafe_blit a2 0 result l1 l2;
-    result
-
   (* next 3 functions: modified copy of code from string.ml *)
   let ensure_ge (x:int) y =
     if x >= y then x else invalid_arg "Float.Array.concat"
@@ -262,15 +258,18 @@ module Array = struct
 
   let sub a ofs len =
     check a ofs len "Float.Array.sub";
-    let result = create len in
-    unsafe_blit a ofs result 0 len;
-    result
+    unsafe_sub a ofs len
 
   let copy a =
     let l = length a in
-    let result = create l in
-    unsafe_blit a 0 result 0 l;
-    result
+    if l = 0 then empty
+    else unsafe_sub a 0 l
+
+  let append a1 a2 =
+    let l1 = length a1 in
+    if l1 = 0 then copy a2
+    else if length a2 = 0 then unsafe_sub a1 0 l1
+    else append_prim a1 a2
 
   let fill a ofs len v =
     check a ofs len "Float.Array.fill";

diff --git a/stdlib/float.mli b/stdlib/float.mli
index 239f1bd982ec07fec4b6b62996470ed92337d8fe..9aba8ce5ceb1311ed6f76cecb12c4318ad282e83 100644 (file)
--- a/stdlib/float.mli
+++ b/stdlib/float.mli
@@ -351,7 +351,7 @@ external erfc : float -> float = "caml_erfc_float" "caml_erfc"
   [@@unboxed] [@@noalloc]
 (** Complementary error function ([erfc x = 1 - erf x]).
     The argument ranges over the entire real line.
-    The result is always within [[-1.0, 1.0]].
+    The result is always within [[0.0, 2.0]].
 
     @since 4.13
 *)
@@ -727,7 +727,7 @@ module Array : sig
 
       When [sort] returns, [a] contains the same elements as before,
       reordered in such a way that for all i and j valid indices of [a] :
-  -      [cmp a.(i) a.(j)] >= 0 if and only if i >= j
+  -      [cmp a.(i) a.(j)] >= 0 if i >= j
   *)
 
   val stable_sort : (float -> float -> int) -> t -> unit
@@ -1094,7 +1094,7 @@ module ArrayLabels : sig
 
       When [sort] returns, [a] contains the same elements as before,
       reordered in such a way that for all i and j valid indices of [a] :
-  -      [cmp a.(i) a.(j)] >= 0 if and only if i >= j
+  -      [cmp a.(i) a.(j)] >= 0 if i >= j
   *)
 
   val stable_sort : cmp:(float -> float -> int) -> t -> unit

diff --git a/stdlib/format.ml b/stdlib/format.ml
index ee099610de29638f812a227da014b16a07c3dbc1..fbf417576ca41aab8fcd32b6cc4139464065a0fb 100644 (file)
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -67,6 +67,7 @@ type box_type = CamlinternalFormatBasics.block_type =
    elements that drive indentation and line splitting. *)
 type pp_token =
   | Pp_text of string          (* normal text *)
+  | Pp_substring of { source:string; pos:int; len:int} (* slice of text *)
   | Pp_break of {              (* complete break *)
       fits: string * int * string;   (* line is not split *)
       breaks: string * int * string; (* line is split *)
@@ -249,6 +250,8 @@ let pp_infinity = 1000000010
 
 (* Output functions for the formatter. *)
 let pp_output_string state s = state.pp_out_string s 0 (String.length s)
+and pp_output_substring state ~pos ~len s =
+  state.pp_out_string s pos len
 and pp_output_newline state = state.pp_out_newline ()
 and pp_output_spaces state n = state.pp_out_spaces n
 and pp_output_indent state n = state.pp_out_indent n
@@ -259,6 +262,12 @@ let format_pp_text state size text =
   pp_output_string state text;
   state.pp_is_new_line <- false
 
+(* Format a slice *)
+let format_pp_substring state size ~pos ~len source =
+  state.pp_space_left <- state.pp_space_left - size;
+  pp_output_substring state ~pos ~len source;
+  state.pp_is_new_line <- false
+
 (* Format a string by its length, if not empty *)
 let format_string state s =
   if s <> "" then format_pp_text state (String.length s) s
@@ -318,10 +327,10 @@ let pp_skip_token state =
 
 (* Formatting a token with a given size. *)
 let format_pp_token state size = function
-
   | Pp_text s ->
     format_pp_text state size s
-
+  | Pp_substring {source;pos;len} ->
+    format_pp_substring state size ~pos ~len source
   | Pp_begin (off, ty) ->
     let insertion_point = state.pp_margin - state.pp_space_left in
     if insertion_point > state.pp_max_indent then
@@ -449,6 +458,10 @@ let enqueue_advance state tok = pp_enqueue state tok; advance_left state
 let enqueue_string_as state size s =
   enqueue_advance state { size; token = Pp_text s; length = Size.to_int size }
 
+(* To enqueue substrings. *)
+let enqueue_substring_as ~pos ~len state size source =
+  let token = Pp_substring {source;pos;len} in
+  enqueue_advance state { size; token; length = Size.to_int size }
 
 let enqueue_string state s =
   enqueue_string_as state (Size.of_int (String.length s)) s
@@ -492,7 +505,7 @@ let set_size state ty =
           queue_elem.size <- Size.of_int (state.pp_right_total + size);
           Stack.pop_opt state.pp_scan_stack |> ignore
         end
-      | Pp_text _ | Pp_stab | Pp_tbegin _ | Pp_tend | Pp_end
+      | Pp_text _ | Pp_substring _ | Pp_stab | Pp_tbegin _ | Pp_tend | Pp_end
       | Pp_newline | Pp_if_newline | Pp_open_tag _ | Pp_close_tag ->
         () (* scan_push is only used for breaks and boxes. *)
 
@@ -633,6 +646,13 @@ let pp_print_as state isize s =
 let pp_print_string state s =
   pp_print_as state (String.length s) s
 
+let pp_print_substring_as ~pos ~len state size s =
+  if state.pp_curr_depth < state.pp_max_boxes
+  then enqueue_substring_as ~pos ~len state (Size.of_int size) s
+
+let pp_print_substring ~pos ~len state s =
+  pp_print_substring_as ~pos ~len state len s
+
 let pp_print_bytes state s =
   pp_print_as state (Bytes.length s) (Bytes.to_string s)
 
@@ -1183,6 +1203,10 @@ and open_stag v = pp_open_stag (DLS.get std_formatter_key) v
 and close_stag v = pp_close_stag (DLS.get std_formatter_key) v
 and print_as v w = pp_print_as (DLS.get std_formatter_key) v w
 and print_string v = pp_print_string (DLS.get std_formatter_key) v
+and print_substring ~pos ~len v =
+  pp_print_substring  ~pos ~len (DLS.get std_formatter_key) v
+and print_substring_as ~pos ~len as_len v =
+  pp_print_substring_as ~pos ~len (DLS.get std_formatter_key) as_len v
 and print_bytes v = pp_print_bytes (DLS.get std_formatter_key) v
 and print_int v = pp_print_int (DLS.get std_formatter_key) v
 and print_float v = pp_print_float (DLS.get std_formatter_key) v
@@ -1280,7 +1304,7 @@ let pp_print_text ppf s =
   let left = ref 0 in
   let right = ref 0 in
   let flush () =
-    pp_print_string ppf (String.sub s !left (!right - !left));
+    pp_print_substring ppf s ~pos:!left ~len:(!right - !left);
     incr right; left := !right;
   in
   while (!right <> len) do

diff --git a/stdlib/format.mli b/stdlib/format.mli
index 698669407dc20cda7d44ddd2b05a019d9a54e3d5..d3ca564f001e54dc973baf03a02fc6b8f19e581d 100644 (file)
--- a/stdlib/format.mli
+++ b/stdlib/format.mli
@@ -235,6 +235,14 @@ val pp_print_string : formatter -> string -> unit
 val print_string : string -> unit
 (** [pp_print_string ppf s] prints [s] in the current pretty-printing box. *)
 
+val pp_print_substring : pos:int -> len:int -> formatter -> string -> unit
+val print_substring : pos:int -> len:int -> string -> unit
+(** [pp_print_substring ~pos ~len ppf s] prints the substring of [s] that starts
+    at position [pos] and stops at position [pos+len] in the current
+    pretty-printing box.
+  @since 5.3
+*)
+
 val pp_print_bytes : formatter -> bytes -> unit
 val print_bytes : bytes -> unit
 (** [pp_print_bytes ppf b] prints [b] in the current pretty-printing box.
@@ -247,6 +255,15 @@ val print_as : int -> string -> unit
   The pretty-printer formats [s] as if it were of length [len].
 *)
 
+val pp_print_substring_as :
+  pos:int -> len:int -> formatter -> int -> string -> unit
+val print_substring_as : pos:int -> len:int -> int -> string -> unit
+(** [pp_print_substring_as ~first ~len ppf len_as s] prints the substring of [s]
+  that starts at position [pos] and stop at position [pos+len] in the current
+  pretty-printing box as if it were of length [len_as].
+  @since 5.1
+*)
+
 val pp_print_int : formatter -> int -> unit
 val print_int : int -> unit
 (** Print an integer in the current pretty-printing box. *)

diff --git a/stdlib/gc.mli b/stdlib/gc.mli
index e95433e388f4e4e7a0a162c11ea3049d1e963bda..706e9608f32b3898a37ba430d987dedb8a82d9cc 100644 (file)
--- a/stdlib/gc.mli
+++ b/stdlib/gc.mli
@@ -42,7 +42,7 @@ type stat =
 
     heap_chunks : int;
     (** Number of contiguous pieces of memory that make up the major heap.
-        This metrics is currently not available in OCaml 5: the field value is
+        This metric is currently not available in OCaml 5: the field value is
         always [0]. *)
 
     live_words : int;
@@ -71,12 +71,12 @@ type stat =
 
     free_blocks : int;
     (** Number of blocks in the free list.
-        This metrics is currently not available in OCaml 5: the field value is
+        This metric is currently not available in OCaml 5: the field value is
         always [0]. *)
 
     largest_free : int;
     (** Size (in words) of the largest block in the free list.
-        This metrics is currently not available in OCaml 5: the field value
+        This metric is currently not available in OCaml 5: the field value
         is always [0]. *)
 
     fragments : int;
@@ -92,7 +92,7 @@ type stat =
 
     stack_size: int;
     (** Current size of the stack, in words.
-        This metrics is currently not available in OCaml 5: the field value is
+        This metric is currently not available in OCaml 5: the field value is
         always [0].
         @since 3.12 *)
 
@@ -122,7 +122,10 @@ type control =
         number is less than or equal to 1000, it is a percentage of
         the current heap size (i.e. setting it to 100 will double the heap
         size at each increase). If it is more than 1000, it is a fixed
-        number of words that will be added to the heap. Default: 15. *)
+        number of words that will be added to the heap.
+
+        This field is currently not available in OCaml 5: the field value is
+        always [0]. *)
 
     space_overhead : int;
     (** The major GC speed is computed from this parameter.
@@ -157,16 +160,19 @@ type control =
        compaction is triggered at the end of each major GC cycle
        (this setting is intended for testing purposes only).
        If [max_overhead >= 1000000], compaction is never triggered.
-       Default: 500. *)
+
+       This field is currently not available in OCaml 5: the field value is
+       always [0]. *)
 
     stack_limit : int;
     (** The maximum size of the fiber stacks (in words).
-       Default: 1024k. *)
+       Default: 128M. *)
 
     allocation_policy : int;
     (** The policy used for allocating in the major heap.
 
-        This option is ignored in OCaml 5.x.
+        This field is currently not available in OCaml 5: the field value is
+        always [0].
 
         Prior to OCaml 5.0, possible values were 0, 1 and 2.
 
@@ -182,8 +188,10 @@ type control =
     (** The size of the window used by the major GC for smoothing
         out variations in its workload. This is an integer between
         1 and 50.
-        Default: 1.
-        @since 4.03 *)
+        @since 4.03
+
+        This field is currently not available in OCaml 5: the field value is
+        always [0]. *)
 
     custom_major_ratio : int;
     (** Target ratio of floating garbage to major heap size for
@@ -224,16 +232,19 @@ type control =
 
 external stat : unit -> stat = "caml_gc_stat"
 (** Return the current values of the memory management counters in a
-   [stat] record that represent the program's total memory stats.
-   This function causes a full major collection. *)
+    [stat] record that represents the program's total memory stats.
+    The [heap_chunks], [free_blocks], [largest_free], and [stack_size] metrics
+    are currently not available in OCaml 5: their returned field values are
+    therefore [0].
+    This function causes a full major collection. *)
 
 external quick_stat : unit -> stat = "caml_gc_quick_stat"
-(** Same as [stat] except that [live_words], [live_blocks], [free_words],
-    [free_blocks], [largest_free], and [fragments] are set to 0. Due to
-    per-domain buffers it may only represent the state of the program's
-    total memory usage since the last minor collection or major cycle.
-    This function is much faster than [stat] because it does not need to
-    trigger a full major collection. *)
+(** Returns a record with the current values of the memory management counters
+    like [stat]. Unlike [stat], [quick_stat] does not perform a full major
+    collection, and hence, is much faster. However, [quick_stat] reports the
+    counters sampled at the last minor collection or at the end of the last
+    major collection cycle (whichever is the latest). Hence, the memory stats
+    returned by [quick_stat] are not instantaneously accurate. *)
 
 external counters : unit -> float * float * float = "caml_gc_counters"
 (** Return [(minor_words, promoted_words, major_words)] for the current
@@ -254,14 +265,22 @@ external get : unit -> control = "caml_gc_get"
 [@@alert unsynchronized_access
     "GC parameters are a mutable global state."
 ]
-(** Return the current values of the GC parameters in a [control] record. *)
+(** Return the current values of the GC parameters in a [control] record.
+
+    The [major_heap_increment], [max_overhead], [allocation_policy], and
+    [window_size] fields are currently not available in OCaml 5: their returned
+    field values are therefore [0]. *)
 
 external set : control -> unit = "caml_gc_set"
 [@@alert unsynchronized_access
     "GC parameters are a mutable global state."
 ]
- (** [set r] changes the GC parameters according to the [control] record [r].
-   The normal usage is: [Gc.set { (Gc.get()) with Gc.verbose = 0x00d }] *)
+(** [set r] changes the GC parameters according to the [control] record [r].
+    The normal usage is: [Gc.set { (Gc.get()) with Gc.verbose = 0x00d }]
+
+    The [major_heap_increment], [max_overhead], [allocation_policy], and
+    [window_size] fields are currently not available in OCaml 5: setting them
+    therefore has no effect. *)
 
 external minor : unit -> unit = "caml_gc_minor"
 (** Trigger a minor collection. *)
@@ -462,8 +481,7 @@ module Memprof :
         (** The size of the block, in words, excluding the header. *)
 
         source : allocation_source;
-        (** The cause of the allocation; [Marshal] cannot be produced
-          since OCaml 5. *)
+        (** The cause of the allocation. *)
 
         callstack : Printexc.raw_backtrace
         (** The callstack for the allocation. *)
@@ -507,7 +525,7 @@ module Memprof :
        the sampling rate in samples per word (including headers).
        Usually, with cheap callbacks, a rate of 1e-4 has no visible
        effect on performance, and 1e-3 causes the program to run a few
-       percent slower.
+       percent slower. 0.0 <= sampling_rate <= 1.0.
 
        The parameter [callstack_size] is the length of the callstack
        recorded at every sample. Its default is [max_int].
@@ -515,12 +533,12 @@ module Memprof :
        The parameter [tracker] determines how to track sampled blocks
        over their lifetime in the minor and major heap.
 
-       Sampling is temporarily disabled on the current thread when
-       calling a callback, so callbacks do not need to be re-entrant
-       if the program is single-threaded and single-domain. However,
-       if threads or multiple domains are used, it is possible that
-       several callbacks will run in parallel. In this case, callback
-       functions must be re-entrant.
+       Sampling and running callbacks are temporarily disabled on the
+       current thread when calling a callback, so callbacks do not
+       need to be re-entrant if the program is single-threaded and
+       single-domain. However, if threads or multiple domains are
+       used, it is possible that several callbacks will run in
+       parallel. In this case, callback functions must be re-entrant.
 
        Note that a callback may be postponed slightly after the actual
        event. The callstack passed to an allocation callback always
@@ -528,30 +546,32 @@ module Memprof :
        have evolved between the allocation and the call to the
        callback.
 
-       If a new thread or domain is created when profiling is active,
-       the child thread or domain joins that profile (using the same
-       [sampling_rate], [callstack_size], and [tracker] callbacks).
+       If a new thread or domain is created when the current domain is
+       sampling for a profile, the child thread or domain joins that
+       profile (using the same [sampling_rate], [callstack_size], and
+       [tracker] callbacks).
 
-       An allocation callback is generally run by the thread which
+       An allocation callback is always run by the thread which
        allocated the block. If the thread exits or the profile is
-       stopped before the callback is called, the callback may be run
-       by a different thread.
+       stopped before the callback is called, the allocation callback
+       is not called and the block is not tracked.
 
-       Each callback is generally run by the domain which allocated
-       the block. If the domain terminates or the profile is stopped
-       before the callback is called, the callback may be run by a
-       different domain.
+       Each subsequent callback is generally run by the domain which
+       allocated the block. If the domain terminates or the profile is
+       stopped before the callback is called, the callback may be run
+       by a different domain.
 
-       Different domains may run different profiles simultaneously.
-       *)
+       Different domains may sample for different profiles
+       simultaneously.  *)
 
     val stop : unit -> unit
     (** Stop sampling for the current profile. Fails if no profile is
        sampling in the current domain. Stops sampling in all threads
        and domains sharing the profile.
 
-       Callbacks from a profile may run after [stop] is called, until
-       [discard] is applied to the profile.
+       Promotion and deallocation callbacks from a profile may run
+       after [stop] is called, until [discard] is applied to the
+       profile.
 
        A profile is implicitly stopped (but not discarded) if all
        domains and threads sampling for it are terminated.

diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli
index c771ef86b00f130fda1101a8e4f7687169f7eec2..2dcf8ad1641e41115e6e86f97db6fd07b9378ff3 100644 (file)
--- a/stdlib/hashtbl.mli
+++ b/stdlib/hashtbl.mli
@@ -64,11 +64,12 @@ type (!'a, !'b) t
 
 val create : ?random: (* thwart tools/sync_stdlib_docs *) bool ->
              int -> ('a, 'b) t
-(** [Hashtbl.create n] creates a new, empty hash table, with
-   initial size [n].  For best results, [n] should be on the
-   order of the expected number of elements that will be in
-   the table.  The table grows as needed, so [n] is just an
-   initial guess.
+(** [Hashtbl.create n] creates a new, empty hash table, with initial
+   size greater or equal to the suggested size [n].  For best results,
+   [n] should be on the order of the expected number of elements that
+   will be in the table.  The table grows as needed, so [n] is just an
+   initial guess.  If [n] is very small or negative then it is
+   disregarded and a small default size is used.
 
    The optional [~random] parameter (a boolean) controls whether
    the internal organization of the hash table is randomized at each

diff --git a/stdlib/header.c b/stdlib/header.c
index e2572a024aa4731779f23bbbccc1d06340e89234..164bf9de2f561afc576dee2ddd124e1d30d35a43 100644 (file)
--- a/stdlib/header.c
+++ b/stdlib/header.c
@@ -50,21 +50,20 @@ static char * searchpath(char * name)
 {
   static char fullname[MAXPATHLEN + 1];
   char * path;
-  char * p;
-  char * q;
   struct stat st;
 
-  for (p = name; *p != 0; p++) {
+  for (char *p = name; *p != 0; p++) {
     if (*p == '/') return name;
   }
   path = getenv("PATH");
   if (path == NULL) return name;
   while(1) {
+    char * p;
     for (p = fullname; *path != 0 && *path != ':'; p++, path++)
       if (p < fullname + MAXPATHLEN) *p = *path;
     if (p != fullname && p < fullname + MAXPATHLEN)
       *p++ = '/';
-    for (q = name; *q != 0; p++, q++)
+    for (char *q = name; *q != 0; p++, q++)
       if (p < fullname + MAXPATHLEN) *p = *q;
     *p = 0;
     if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) break;
@@ -90,14 +89,14 @@ static int file_ok(char * name)
 
 static char * searchpath(char * name)
 {
-  char * path, * fullname, * p;
+  char * path, * fullname;
 
   path = getenv("PATH");
   fullname = malloc(strlen(name) + (path == NULL ? 0 : strlen(path)) + 6);
   /* 6 = "/" plus ".exe" plus final "\0" */
   if (fullname == NULL) return name;
   /* Check for absolute path name */
-  for (p = name; *p != 0; p++) {
+  for (char *p = name; *p != 0; p++) {
     if (*p == '/' || *p == '\\') {
       if (file_ok(name)) return name;
       strcpy(fullname, name);
@@ -109,6 +108,7 @@ static char * searchpath(char * name)
   /* Search in path */
   if (path == NULL) return name;
   while(1) {
+    char * p;
     for (p = fullname; *path != 0 && *path != ':'; p++, path++) *p = *path;
     if (p != fullname) *p++ = '/';
     strcpy(p, name);
@@ -134,7 +134,7 @@ static char * read_runtime_path(int fd)
 {
   char buffer[TRAILER_SIZE];
   static char runtime_path[MAXPATHLEN];
-  int num_sections, i;
+  int num_sections;
   uint32_t path_size;
   long ofs;
 
@@ -144,7 +144,7 @@ static char * read_runtime_path(int fd)
   ofs = TRAILER_SIZE + num_sections * 8;
   lseek(fd, -ofs, SEEK_END);
   path_size = 0;
-  for (i = 0; i < num_sections; i++) {
+  for (int i = 0; i < num_sections; i++) {
     if (read(fd, buffer, 8) < 8) return NULL;
     if (buffer[0] == 'R' && buffer[1] == 'N' &&
         buffer[2] == 'T' && buffer[3] == 'M') {

diff --git a/stdlib/headernt.c b/stdlib/headernt.c
index c9713179a33b57a16418eea0a338517d03287f91..9815f0415b51d6a7804a1283935384b5455316ba 100644 (file)
--- a/stdlib/headernt.c
+++ b/stdlib/headernt.c
@@ -31,25 +31,19 @@
 #endif
 #endif
 
-static
-#ifdef _MSC_VER
-__forceinline
-#else
-__inline
-#endif
-unsigned long read_size(const char * const ptr)
+Caml_inline unsigned long read_size(const char * const ptr)
 {
   const unsigned char * const p = (const unsigned char * const) ptr;
   return ((unsigned long) p[0] << 24) | ((unsigned long) p[1] << 16) |
          ((unsigned long) p[2] << 8) | p[3];
 }
 
-static __inline char * read_runtime_path(HANDLE h)
+Caml_inline char * read_runtime_path(HANDLE h)
 {
   char buffer[TRAILER_SIZE];
   static char runtime_path[MAX_PATH];
   DWORD nread;
-  int num_sections, path_size, i;
+  int num_sections, path_size;
   long ofs;
 
   if (SetFilePointer(h, -TRAILER_SIZE, NULL, FILE_END) == -1) return NULL;
@@ -59,7 +53,7 @@ static __inline char * read_runtime_path(HANDLE h)
   ofs = TRAILER_SIZE + num_sections * 8;
   if (SetFilePointer(h, - ofs, NULL, FILE_END) == -1) return NULL;
   path_size = 0;
-  for (i = 0; i < num_sections; i++) {
+  for (int i = 0; i < num_sections; i++) {
     if (! ReadFile(h, buffer, 8, &nread, NULL) || nread != 8) return NULL;
     if (buffer[0] == 'R' && buffer[1] == 'N' &&
         buffer[2] == 'T' && buffer[3] == 'M') {
@@ -106,7 +100,7 @@ static void write_console(HANDLE hOut, WCHAR *wstr)
   }
 }
 
-static __inline void __declspec(noreturn) run_runtime(wchar_t * runtime,
+CAMLnoret Caml_inline void run_runtime(wchar_t * runtime,
          wchar_t * const cmdline)
 {
   wchar_t path[MAX_PATH];
@@ -121,9 +115,6 @@ static __inline void __declspec(noreturn) run_runtime(wchar_t * runtime,
     write_console(errh, runtime);
     write_console(errh, L"\r\n");
     ExitProcess(2);
-#ifdef _MSC_VER
-    __assume(0); /* Not reached */
-#endif
   }
   /* Need to ignore ctrl-C and ctrl-break, otherwise we'll die and take
      the underlying OCaml program with us! */
@@ -144,18 +135,12 @@ static __inline void __declspec(noreturn) run_runtime(wchar_t * runtime,
     write_console(errh, runtime);
     write_console(errh, L"\r\n");
     ExitProcess(2);
-#ifdef _MSC_VER
-    __assume(0); /* Not reached */
-#endif
   }
   CloseHandle(procinfo.hThread);
   WaitForSingleObject(procinfo.hProcess , INFINITE);
   GetExitCodeProcess(procinfo.hProcess , &retcode);
   CloseHandle(procinfo.hProcess);
   ExitProcess(retcode);
-#ifdef _MSC_VER
-    __assume(0); /* Not reached */
-#endif
 }
 
 int wmain(void)
@@ -176,18 +161,9 @@ int wmain(void)
     write_console(errh, truename);
     write_console(errh, L" not found or is not a bytecode executable file\r\n");
     ExitProcess(2);
-#ifdef _MSC_VER
-    __assume(0); /* Not reached */
-#endif
   }
   CloseHandle(h);
   MultiByteToWideChar(CP, 0, runtime_path, -1, wruntime_path,
                       sizeof(wruntime_path)/sizeof(wchar_t));
   run_runtime(wruntime_path , cmdline);
-#ifdef _MSC_VER
-    __assume(0); /* Not reached */
-#endif
-#ifdef __MINGW32__
-    return 0;
-#endif
 }

diff --git a/stdlib/lazy.ml b/stdlib/lazy.ml
index ab29d404c93d6eb837598fcf9236818c38b16639..553c0caff28892d8ec87475afca22cf85c773359 100644 (file)
--- a/stdlib/lazy.ml
+++ b/stdlib/lazy.ml
@@ -39,7 +39,7 @@
    If OCaml was configured with the -flat-float-array option (which is
    currently the default), the following is also true:
    We cannot use representation (3) for a [float Lazy.t] because
-   [caml_make_array] assumes that only a [float] value can have tag
+   [caml_array_make] assumes that only a [float] value can have tag
    [Double_tag].
 
    We have to use the built-in type constructor [lazy_t] to

diff --git a/stdlib/lexing.ml b/stdlib/lexing.ml
index c93446715e42709d30e934b59ffa1dd45d3bc887..5068e79e4b4d6f100301a8dcaee463be149cbe5c 100644 (file)
--- a/stdlib/lexing.ml
+++ b/stdlib/lexing.ml
@@ -163,10 +163,13 @@ let from_channel ?with_positions ic =
   from_function ?with_positions (fun buf n -> input ic buf 0 n)
 
 let from_string ?(with_positions = true) s =
+  (* We can't use [Bytes.unsafe_of_string] here,
+     [lex_buffer] is exported in the mli, one can mutate
+     it outside this module. *)
+  let lex_buffer = Bytes.of_string s in
   { refill_buff = (fun lexbuf -> lexbuf.lex_eof_reached <- true);
-    lex_buffer = Bytes.of_string s; (* have to make a copy for compatibility
-                                       with unsafe-string mode *)
-    lex_buffer_len = String.length s;
+    lex_buffer;
+    lex_buffer_len = Bytes.length lex_buffer;
     lex_abs_pos = 0;
     lex_start_pos = 0;
     lex_curr_pos = 0;

diff --git a/stdlib/list.ml b/stdlib/list.ml
index 0e83bb42e478b0496de4023d6163948dbfc2cd6a..3b77b9a4079b816805cdfefe64ad9fb1466ac532 100644 (file)
--- a/stdlib/list.ml
+++ b/stdlib/list.ml
@@ -289,6 +289,34 @@ and[@tail_mod_cons] prepend_concat_map ys f xs =
   | [] -> concat_map f xs
   | y :: ys -> y :: prepend_concat_map ys f xs
 
+let take n l =
+  let[@tail_mod_cons] rec aux n l =
+    match n, l with
+    | 0, _ | _, [] -> []
+    | n, x::l -> x::aux (n - 1) l
+  in
+  if n < 0 then invalid_arg "List.take";
+  aux n l
+
+let drop n l =
+  let rec aux i = function
+    | _x::l when i < n -> aux (i + 1) l
+    | rest -> rest
+  in
+  if n < 0 then invalid_arg "List.drop";
+  aux 0 l
+
+let take_while p l =
+  let[@tail_mod_cons] rec aux = function
+    | x::l when p x -> x::aux l
+    | _rest -> []
+  in
+  aux l
+
+let rec drop_while p = function
+  | x::l when p x -> drop_while p l
+  | rest -> rest
+
 let fold_left_map f accu l =
   let rec aux accu l_accu = function
     | [] -> accu, rev l_accu

diff --git a/stdlib/list.mli b/stdlib/list.mli
index e3a6c3b38cbe52c33d8df02461577e1d50ca2646..662df29cd4ff9329c827bdbad7226dc17659628b 100644 (file)
--- a/stdlib/list.mli
+++ b/stdlib/list.mli
@@ -359,6 +359,44 @@ val filteri : (int -> 'a -> bool) -> 'a list -> 'a list
    @since 4.11
 *)
 
+
+(** {1 List manipulation} *)
+
+
+val take : int -> 'a list -> 'a list
+(** [take n l] returns the prefix of [l] of length [n],
+    or a copy of [l] if [n > length l].
+
+    [n] must be nonnegative.
+
+    @raise Invalid_argument if [n] is negative.
+    @since 5.3
+*)
+
+val drop : int -> 'a list -> 'a list
+(** [drop n l] returns the suffix of [l] after [n] elements,
+    or [[]] if [n > length l].
+
+    [n] must be nonnegative.
+
+    @raise Invalid_argument if [n] is negative.
+    @since 5.3
+*)
+
+val take_while : ('a -> bool) -> 'a list -> 'a list
+(** [take_while p l] is the longest (possibly empty) prefix of [l]
+    containing only elements that satisfy [p].
+
+    @since 5.3
+*)
+
+val drop_while : ('a -> bool) -> 'a list -> 'a list
+(** [drop_while p l] is the longest (possibly empty) suffix of [l]
+    starting at the first element that does not satisfy [p].
+
+    @since 5.3
+*)
+
 val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
 (** [partition f l] returns a pair of lists [(l1, l2)], where
    [l1] is the list of all the elements of [l] that

diff --git a/stdlib/listLabels.mli b/stdlib/listLabels.mli
index 7cab84c4987fd42528383dc2bdbd4cbd03f5ca8e..7ab524d8eaadc504faa87da45be94250fec7a69b 100644 (file)
--- a/stdlib/listLabels.mli
+++ b/stdlib/listLabels.mli
@@ -359,6 +359,44 @@ val filteri : f:(int -> 'a -> bool) -> 'a list -> 'a list
    @since 4.11
 *)
 
+
+(** {1 List manipulation} *)
+
+
+val take : int -> 'a list -> 'a list
+(** [take n l] returns the prefix of [l] of length [n],
+    or a copy of [l] if [n > length l].
+
+    [n] must be nonnegative.
+
+    @raise Invalid_argument if [n] is negative.
+    @since 5.3
+*)
+
+val drop : int -> 'a list -> 'a list
+(** [drop n l] returns the suffix of [l] after [n] elements,
+    or [[]] if [n > length l].
+
+    [n] must be nonnegative.
+
+    @raise Invalid_argument if [n] is negative.
+    @since 5.3
+*)
+
+val take_while : f:('a -> bool) -> 'a list -> 'a list
+(** [take_while p l] is the longest (possibly empty) prefix of [l]
+    containing only elements that satisfy [p].
+
+    @since 5.3
+*)
+
+val drop_while : f:('a -> bool) -> 'a list -> 'a list
+(** [drop_while p l] is the longest (possibly empty) suffix of [l]
+    starting at the first element that does not satisfy [p].
+
+    @since 5.3
+*)
+
 val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list
 (** [partition ~f l] returns a pair of lists [(l1, l2)], where
    [l1] is the list of all the elements of [l] that

diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli
index bd2e858cd77228962631bfd0d9ac611684eddf3b..e46c80d4b48f011c5b3ed39ce32b414c5b1c2666 100644 (file)
--- a/stdlib/marshal.mli
+++ b/stdlib/marshal.mli
@@ -191,6 +191,6 @@ val total_size : bytes -> int -> int
     Care must be taken when marshaling a mutable value that may be modified by
     a different domain. Mutating a value that is being marshaled (i.e., turned
     into a sequence of bytes) is a programming error and might result in
-    suprising values (when unmarshaling) due to tearing, since marshaling
+    surprising values (when unmarshaling) due to tearing, since marshaling
     involves byte-per-byte copy.
 *)

diff --git a/stdlib/moreLabels.mli b/stdlib/moreLabels.mli
index 4199815cffd3fa47d663d57db684db4eb93cc2f0..26993ff71c625f95a16ef5a89c611f2aeca89bd5 100644 (file)
--- a/stdlib/moreLabels.mli
+++ b/stdlib/moreLabels.mli
@@ -81,11 +81,12 @@ module Hashtbl : sig
 
   val create : ?random: (* thwart tools/sync_stdlib_docs *) bool ->
                int -> ('a, 'b) t
-  (** [Hashtbl.create n] creates a new, empty hash table, with
-     initial size [n].  For best results, [n] should be on the
-     order of the expected number of elements that will be in
-     the table.  The table grows as needed, so [n] is just an
-     initial guess.
+  (** [Hashtbl.create n] creates a new, empty hash table, with initial
+     size greater or equal to the suggested size [n].  For best results,
+     [n] should be on the order of the expected number of elements that
+     will be in the table.  The table grows as needed, so [n] is just an
+     initial guess.  If [n] is very small or negative then it is
+     disregarded and a small default size is used.
 
      The optional [~random] parameter (a boolean) controls whether
      the internal organization of the hash table is randomized at each

diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli
index 54c5a5774eced8e57416bde6e3992cc1639d2c30..e3b2ab1fca2166da3afba20215070ab3113184d5 100644 (file)
--- a/stdlib/printexc.mli
+++ b/stdlib/printexc.mli
@@ -104,7 +104,7 @@ val register_printer: (exn -> string option) -> unit
 
 val use_printers: exn -> string option
 (** [Printexc.use_printers e] returns [None] if there are no registered
-    printers and [Some s] with else as the resulting string otherwise.
+    printers and [Some s] with [s] the resulting string otherwise.
     @since 4.09
 *)
 

diff --git a/stdlib/queue.ml b/stdlib/queue.ml
index f8d8b25181bac41bd591b329dff48de7c9bad450..8b3a820717950d0fd52b4ddcb9db5f5c7e8bde97 100644 (file)
--- a/stdlib/queue.ml
+++ b/stdlib/queue.ml
@@ -93,6 +93,15 @@ let take_opt q =
 let pop =
   take
 
+let drop q =
+  match q.first with
+  | Nil -> raise Empty
+  | Cons { content = _; next = Nil } ->
+    clear q
+  | Cons { content = _; next } ->
+    q.length <- q.length - 1;
+    q.first <- next
+
 let copy =
   let rec copy q_res prev cell =
     match cell with

diff --git a/stdlib/queue.mli b/stdlib/queue.mli
index 83dd83a9c7ae67c975f44b82b82e89e4b48c0146..00f6694ce2c86bb5b3420092b3ce7ae46114fa6b 100644 (file)
--- a/stdlib/queue.mli
+++ b/stdlib/queue.mli
@@ -72,6 +72,11 @@ val peek_opt : 'a t -> 'a option
 val top : 'a t -> 'a
 (** [top] is a synonym for [peek]. *)
 
+val drop : 'a t -> unit
+(** [drop q] removes the first element in queue [q], or raises {!Empty}
+   if the queue is empty.
+   @since 5.3 *)
+
 val clear : 'a t -> unit
 (** Discard all elements from a queue. *)
 

diff --git a/stdlib/random.ml b/stdlib/random.ml
index 70b0a01890297690bec138fa1b3df26cb8e6ecb4..2db640d94193e96d94a3c283a4d88c1b366b622f 100644 (file)
--- a/stdlib/random.ml
+++ b/stdlib/random.ml
@@ -143,7 +143,7 @@ module State = struct
      * we use rejection sampling on the greatest interval [ [0, k*n-1] ]
      * that fits in [ [0, mask] ].  That is, we reject the
      * sample if it falls outside of this interval, and draw again.
-     * This is what the test below does, while carefuly avoiding
+     * This is what the test below does, while carefully avoiding
      * overflows and sparing a division [mask / n]. *)
     if r - v > mask - n + 1 then int_aux s n mask else v
 

diff --git a/stdlib/seq.mli b/stdlib/seq.mli
index 026471c4d5e198220b1cd65bc0a4f8ab901dd24a..485d1105cd6afad88d097b1346259da5194d4d89 100644 (file)
--- a/stdlib/seq.mli
+++ b/stdlib/seq.mli
@@ -504,8 +504,7 @@ val drop : int -> 'a t -> 'a t
 
     [drop] is lazy: the first [n+1] elements of the sequence [xs]
     are demanded only when the first element of [drop n xs] is
-    demanded. For this reason, [drop 1 xs] is {i not} equivalent
-    to [tail xs], which queries [xs] immediately.
+    demanded.
 
     @raise Invalid_argument if [n] is negative.
 

diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml
index 636a90420e9a23599fc6a806ae079f6fcabb776b..79a9fb64cd6698c4bb7c20040679ca4bdace2f43 100644 (file)
--- a/stdlib/stdlib.ml
+++ b/stdlib/stdlib.ml
@@ -268,7 +268,7 @@ let string_of_int n =
 external int_of_string : string -> int = "caml_int_of_string"
 
 let int_of_string_opt s =
-  (* TODO: provide this directly as a non-raising primitive. *)
+  (* Trashes current backtrace *)
   try Some (int_of_string s)
   with Failure _ -> None
 
@@ -289,7 +289,7 @@ let string_of_float f = valid_float_lexem (format_float "%.12g" f)
 external float_of_string : string -> float = "caml_float_of_string"
 
 let float_of_string_opt s =
-  (* TODO: provide this directly as a non-raising primitive. *)
+  (* Trashes current backtrace *)
   try Some (float_of_string s)
   with Failure _ -> None
 

diff --git a/stdlib/string.ml b/stdlib/string.ml
index c130fc438fd964d0d95c1e0c118fff00ad6cfdbc..7365cef2b8590f11b75a79a531971696f9eaff32 100644 (file)
--- a/stdlib/string.ml
+++ b/stdlib/string.ml
@@ -108,7 +108,11 @@ let escaped s =
   let b = bos s in
   (* We satisfy [unsafe_escape]'s precondition by passing an
      immutable byte sequence [b]. *)
-  bts (B.unsafe_escape b)
+  let b' = B.unsafe_escape b in
+  (* With js_of_ocaml, [bos] and [bts] are not the identity.
+     We can avoid a [bts] conversion if [unsafe_escape] returned
+     its argument. *)
+  if b == b' then s else bts b'
 
 (* duplicated in bytes.ml *)
 let rec index_rec s lim i c =

diff --git a/stdlib/string.mli b/stdlib/string.mli
index e61638380f67f824953c8a7b000fb0f384592839..186c1bc58bd27b3441b6a390a2e3cf03ba5a0da9 100644 (file)
--- a/stdlib/string.mli
+++ b/stdlib/string.mli
@@ -347,8 +347,7 @@ val rindex_opt : string -> char -> int option
 
 val to_seq : t -> char Seq.t
 (** [to_seq s] is a sequence made of the string's characters in
-    increasing order. In ["unsafe-string"] mode, modifications of the string
-    during iteration will be reflected in the sequence.
+    increasing order.
 
     @since 4.07 *)
 

diff --git a/stdlib/stringLabels.mli b/stdlib/stringLabels.mli
index 14868cbc95768704e8ee673e44c6f24a651552f6..c6771eaa7f27629e191c9e5e9851d1f91db71983 100644 (file)
--- a/stdlib/stringLabels.mli
+++ b/stdlib/stringLabels.mli
@@ -347,8 +347,7 @@ val rindex_opt : string -> char -> int option
 
 val to_seq : t -> char Seq.t
 (** [to_seq s] is a sequence made of the string's characters in
-    increasing order. In ["unsafe-string"] mode, modifications of the string
-    during iteration will be reflected in the sequence.
+    increasing order.
 
     @since 4.07 *)
 

diff --git a/stdlib/sys.ml.in b/stdlib/sys.ml.in
index 23ecf32ff002b43f6e66e58703b62221a2e05a54..842ea845005f3b9050143106ba10312a7c1fa9f6 100644 (file)
--- a/stdlib/sys.ml.in
+++ b/stdlib/sys.ml.in
@@ -47,6 +47,7 @@ let max_floatarray_length = max_array_length / (64 / word_size)
 let max_string_length = word_size / 8 * max_array_length - 1
 external runtime_variant : unit -> string = "caml_runtime_variant"
 external runtime_parameters : unit -> string = "caml_runtime_parameters"
+external poll_actions : unit -> unit = "%poll"
 
 external file_exists: string -> bool = "caml_sys_file_exists"
 external is_directory : string -> bool = "caml_sys_is_directory"

diff --git a/stdlib/sys.mli b/stdlib/sys.mli
index 5fdd8c5c418150373054f39440dc9849f8534ad7..b34120fecb8b83f7450037583fa667fb6bf30af3 100644 (file)
--- a/stdlib/sys.mli
+++ b/stdlib/sys.mli
@@ -208,6 +208,11 @@ external runtime_parameters : unit -> string = "caml_runtime_parameters"
     as the contents of the [OCAMLRUNPARAM] environment variable.
     @since 4.03 *)
 
+external poll_actions : unit -> unit = "%poll"
+(** Run any pending runtime actions, such as minor collections, major
+    GC slices, signal handlers, finalizers, or memprof callbacks.
+    @since 5.3 *)
+
 
 (** {1 Signal handling} *)
 
@@ -407,7 +412,9 @@ external opaque_identity : 'a -> 'a = "%opaque"
 (** For the purposes of optimization, [opaque_identity] behaves like an
     unknown (and thus possibly side-effecting) function.
 
-    At runtime, [opaque_identity] disappears altogether.
+    At runtime, [opaque_identity] disappears altogether.  However, it does
+    prevent the argument from being garbage collected until the location
+    where the call would have occurred.
 
     A typical use of this function is to prevent pure computations from being
     optimized away in benchmarking loops.  For example:

diff --git a/stdlib/templates/float.template.mli b/stdlib/templates/float.template.mli
index a3061b295045a6ad0e6092c8e676b6fa2ade9eb4..1c75b0491d3bcb02d4127a2af295469c17b38a34 100644 (file)
--- a/stdlib/templates/float.template.mli
+++ b/stdlib/templates/float.template.mli
@@ -351,7 +351,7 @@ external erfc : float -> float = "caml_erfc_float" "caml_erfc"
   [@@unboxed] [@@noalloc]
 (** Complementary error function ([erfc x = 1 - erf x]).
     The argument ranges over the entire real line.
-    The result is always within [[-1.0, 1.0]].
+    The result is always within [[0.0, 2.0]].
 
     @since 4.13
 *)

diff --git a/stdlib/templates/floatarraylabeled.template.mli b/stdlib/templates/floatarraylabeled.template.mli
index a691538367fe63557ff050f3635a09f83af4f68e..b4898f1ece26d68bad371dbf4e72f64f9ae6321f 100644 (file)
--- a/stdlib/templates/floatarraylabeled.template.mli
+++ b/stdlib/templates/floatarraylabeled.template.mli
@@ -243,7 +243,7 @@ val sort : cmp:(float -> float -> int) -> t -> unit
 
     When [sort] returns, [a] contains the same elements as before,
     reordered in such a way that for all i and j valid indices of [a] :
--      [cmp a.(i) a.(j)] >= 0 if and only if i >= j
+-      [cmp a.(i) a.(j)] >= 0 if i >= j
 *)
 
 val stable_sort : cmp:(float -> float -> int) -> t -> unit

diff --git a/stdlib/templates/hashtbl.template.mli b/stdlib/templates/hashtbl.template.mli
index 2782c87dde5bdeea8248eba5f39d07770ed9becb..f6822ce25713c885e43dd05750a593aa7778ecba 100644 (file)
--- a/stdlib/templates/hashtbl.template.mli
+++ b/stdlib/templates/hashtbl.template.mli
@@ -64,11 +64,12 @@ type (!'a, !'b) t
 
 val create : ?random: (* thwart tools/sync_stdlib_docs *) bool ->
              int -> ('a, 'b) t
-(** [Hashtbl.create n] creates a new, empty hash table, with
-   initial size [n].  For best results, [n] should be on the
-   order of the expected number of elements that will be in
-   the table.  The table grows as needed, so [n] is just an
-   initial guess.
+(** [Hashtbl.create n] creates a new, empty hash table, with initial
+   size greater or equal to the suggested size [n].  For best results,
+   [n] should be on the order of the expected number of elements that
+   will be in the table.  The table grows as needed, so [n] is just an
+   initial guess.  If [n] is very small or negative then it is
+   disregarded and a small default size is used.
 
    The optional [~random] parameter (a boolean) controls whether
    the internal organization of the hash table is randomized at each

diff --git a/stdlib/uchar.ml b/stdlib/uchar.ml
index 696763b8286e56fb716ecfcfb1203ad59f3f7475..89e72e078f1a9c28ea27ac022d8e60a1a65bbf31 100644 (file)
--- a/stdlib/uchar.ml
+++ b/stdlib/uchar.ml
@@ -17,7 +17,7 @@ external format_int : string -> int -> string = "caml_format_int"
 
 let err_no_pred = "U+0000 has no predecessor"
 let err_no_succ = "U+10FFFF has no successor"
-let err_not_sv i = format_int "%X" i ^ " is not an Unicode scalar value"
+let err_not_sv i = format_int "%X" i ^ " is not a Unicode scalar value"
 let err_not_latin1 u = "U+" ^ format_int "%04X" u ^ " is not a latin1 character"
 
 type t = int
@@ -55,7 +55,11 @@ let unsafe_to_char = Char.unsafe_chr
 
 let equal : int -> int -> bool = ( = )
 let compare : int -> int -> int = Stdlib.compare
-let hash = to_int
+
+external seeded_hash_param :
+  int -> int -> int -> 'a -> int = "caml_hash" [@@noalloc]
+let seeded_hash seed x = seeded_hash_param 10 100 seed x
+let hash x = seeded_hash_param 10 100 0 x
 
 (* UTF codecs tools *)
 

diff --git a/stdlib/uchar.mli b/stdlib/uchar.mli
index c2b7abc53cd02e4e161f84a03aee7c7de1ad2b10..b399e6216f0308c539762f9b19ada6b83df61c37 100644 (file)
--- a/stdlib/uchar.mli
+++ b/stdlib/uchar.mli
@@ -95,8 +95,19 @@ val equal : t -> t -> bool
 val compare : t -> t -> int
 (** [compare u u'] is [Stdlib.compare u u']. *)
 
+val seeded_hash : int -> t -> int
+(** [seeded_hash seed u] A seeded hash function with the same output value as
+    {!Hashtbl.seeded_hash}. This function allows this module to be passed as an
+    argument to the functor {!Hashtbl.MakeSeeded}.
+
+    @since 5.3 *)
+
 val hash : t -> int
-(** [hash u] associates a non-negative integer to [u]. *)
+(** An unseeded hash function with the same output value as {!Hashtbl.hash}.
+    This function allows this module to be passed as an argument to the functor
+    {!Hashtbl.Make}.
+
+    @since 5.3 *)
 
 (** {1:utf UTF codecs tools}
 

diff --git a/testsuite/Makefile b/testsuite/Makefile
index 55f55ec79de0a19590935e2552b52ede5de91630..4cad7738954a7bafd786e9e2acef91c8699b3522 100644 (file)
--- a/testsuite/Makefile
+++ b/testsuite/Makefile
@@ -87,7 +87,16 @@ endif
 # KEEP_TEST_DIR_ON_SUCCESS should be set by the user (to a non-empty value)
 # if they want to pass the -keep-test-dir-on-success option to ocamltest,
 # to preserve test data of successful tests.
+
+# KEEP is provided as a rather easier to remmber alias of
+# KEEP_TEST_DIR_ON_SUCCESS, but to prevent the risk of naming conflict it's only
+# recognised when used as make -C testsuite KEEP=1 ...
+ifeq "$(origin KEEP)" "command line"
+KEEP_TEST_DIR_ON_SUCCESS ?= $(KEEP)
+else
 KEEP_TEST_DIR_ON_SUCCESS ?=
+endif
+
 ifeq "$(KEEP_TEST_DIR_ON_SUCCESS)" ""
   OCAMLTEST_KEEP_TEST_DIR_ON_SUCCESS_FLAG =
 else
@@ -144,9 +153,9 @@ default:
        @echo "  clean                      delete generated files"
        @echo "  report                     print the report for the last execution"
        @echo
-       @echo "all*, parallel* and list can automatically re-run failed test"
-       @echo "directories if MAX_TESTSUITE_DIR_RETRIES permits"
-       @echo "(default value = $(MAX_TESTSUITE_DIR_RETRIES))"
+       @echo "By default, artefacts from tests which pass are not kept, but this can"
+       @echo "be changed by adding KEEP=1 to the make command line or by setting the"
+       @echo "KEEP_TEST_DIR_ON_SUCCESS environment variable to a non-empty value."
        @echo
        @echo "Set the environment variable USE_RUNTIME to \"d\" or \"i\" to run"
        @echo "the tests with the debug or the instrumented runtime."

diff --git a/testsuite/summarize.awk b/testsuite/summarize.awk
index 92566c00b0d6a2d0b0b74e644017cdc8b428c41d..38638fc0c17fbc1c9cb57eb2e782d5b514280ba5 100644 (file)
--- a/testsuite/summarize.awk
+++ b/testsuite/summarize.awk
@@ -99,34 +99,25 @@ function record_unexp() {
     errored = 1;
 }
 
+/^ ... testing '[^']*' with / {
+    if (in_test) record_unexp();
+    next;
+}
+
 /^ ... testing '[^']*'/ {
     if (in_test) record_unexp();
     match($0, /... testing '[^']*'/);
     curfile = substr($0, RSTART+13, RLENGTH-14);
-    if (match($0, /... testing '[^']*' with [^:=]*/)){
-        curfile = substr($0, RSTART+12, RLENGTH-12);
+    if (match($0, /\(wall clock: .*s\)/)){
+        duration = substr($0, RSTART+13, RLENGTH-15);
+        if (duration + 0.0 > 10.0)
+          slow[slowcount++] = sprintf("%s: %s", curfile, duration);
     }
     key = sprintf ("%s/%s", curdir, curfile);
     DIRS[key] = curdir;
     in_test = 1;
 }
 
-/^ ... testing (with|[^'])/ {
-    if (in_test) record_unexp();
-    key = curdir;
-    DIRS[key] = curdir;
-    in_test = 1;
-}
-
-/^Wall clock:/ {
-  match($0, /: .* took /);
-  curfile = substr($0, RSTART+2, RLENGTH-8);
-  match($0, / took .*s/);
-  duration = substr($0, RSTART+6, RLENGTH-7);
-  if (duration + 0.0 > 10.0)
-    slow[slowcount++] = sprintf("%s: %s", curfile, duration);
-}
-
 /=> passed/ {
     record_pass();
 }

diff --git a/testsuite/tests/asmcomp/func_sections.ml b/testsuite/tests/asmcomp/func_sections.ml
index bdfcaf4529fee1f21bfe5e014e94cc5c03782995..eae0681bc15ee3241dbbd377d702f2e189c31e27 100644 (file)
--- a/testsuite/tests/asmcomp/func_sections.ml
+++ b/testsuite/tests/asmcomp/func_sections.ml
@@ -17,11 +17,23 @@
    arch_i386;
    reference = "${test_source_directory}/func_sections.reference";
    native;
+ }{
+   arch_power;
+   reference = "${test_source_directory}/func_sections.arm.reference";
+   native;
+ }{
+   arch_riscv64;
+   reference = "${test_source_directory}/func_sections.reference";
+   native;
+ }{
+   arch_s390x;
+   reference = "${test_source_directory}/func_sections.reference";
+   native;
  }
 *)
 
-(* We have a separate reference output for ARM because
-   it doesn't emit .text after jump tables. *)
+(* We have a separate reference output for ARM and POWER because
+   they don't emit .text after jump tables. *)
 
 (* Test for anonymous functions which result in a mangled symbol *)
 let f4 list =

diff --git a/testsuite/tests/asmgen/main.c b/testsuite/tests/asmgen/main.c
index b0fe2efe9d1389115c8df5cd698ccd01c70546a7..45d24418e37b0c72c831c565d8c1291384df4b7d 100644 (file)
--- a/testsuite/tests/asmgen/main.c
+++ b/testsuite/tests/asmgen/main.c
@@ -106,23 +106,22 @@ int main(int argc, char **argv)
     extern void call_gen_code(void (*)(long, long, long *), long, long, long *);
     long n;
     long * a, * b;
-    long i;
 
     srand(argc >= 3 ? atoi(argv[2]) : time((time_t *) 0));
     n = atoi(argv[1]);
     a = (long *) malloc(n * sizeof(long));
-    for (i = 0 ; i < n; i++) a[i] = rand() & 0xFFF;
+    for (long i = 0 ; i < n; i++) a[i] = rand() & 0xFFF;
 #ifdef DEBUG
-    for (i = 0; i < n; i++) printf("%ld ", a[i]); printf("\n");
+    for (long i = 0; i < n; i++) printf("%ld ", a[i]); printf("\n");
 #endif
     b = (long *) malloc(n * sizeof(long));
-    for (i = 0; i < n; i++) b[i] = a[i];
+    for (long i = 0; i < n; i++) b[i] = a[i];
     call_gen_code(FUN, 0, n-1, a);
 #ifdef DEBUG
-    for (i = 0; i < n; i++) printf("%ld ", a[i]); printf("\n");
+    for (long i = 0; i < n; i++) printf("%ld ", a[i]); printf("\n");
 #endif
     qsort(b, n, sizeof(long), cmpint);
-    for (i = 0; i < n; i++) {
+    for (long i = 0; i < n; i++) {
       if (a[i] != b[i]) { printf("Bug!\n"); return 2; }
     }
     printf("OK\n");

diff --git a/testsuite/tests/asmgen/mainarith.c b/testsuite/tests/asmgen/mainarith.c
index fce523767a4ae5276d8b6fd43cd13382e818ecf3..297dd83aec1a14907e9260f83f65a8b803c64508 100644 (file)
--- a/testsuite/tests/asmgen/mainarith.c
+++ b/testsuite/tests/asmgen/mainarith.c
@@ -309,7 +309,6 @@ static intnat rnd(void)
 
 int main(int argc, char **argv)
 {
-  int i;
   double weird[4];
 
   if (argc >= 5) {
@@ -339,7 +338,7 @@ int main(int argc, char **argv)
     }
   }
   printf("Testing %d random values\n", NUM_RANDOM_ITERATIONS);
-  for (i = 0; i < NUM_RANDOM_ITERATIONS; i++) {
+  for (int i = 0; i < NUM_RANDOM_ITERATIONS; i++) {
     X = rnd();
     Y = rnd();
     F = X / 1e3;

diff --git a/testsuite/tests/asmgen/mainimmed.c b/testsuite/tests/asmgen/mainimmed.c
index 6e1204245917e3fcebf4eac23df504dda0328ca0..a959dc3668de980b0343120582cc8f5ecf1e3103 100644 (file)
--- a/testsuite/tests/asmgen/mainimmed.c
+++ b/testsuite/tests/asmgen/mainimmed.c
@@ -72,7 +72,6 @@ static intnat rnd(void)
 
 int main(int argc, char **argv)
 {
-  int i;
-  for (i = 0; i < NUM_RANDOM_ITERATIONS; i++) do_test(rnd());
+  for (int i = 0; i < NUM_RANDOM_ITERATIONS; i++) do_test(rnd());
   return 0;
 }

diff --git a/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference b/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference
index 4984752d22ac606e1376e95bf5a909bb0c7d5e3a..e2241810b5cf8c171de6794bcc296693c5f6baae 100644 (file)
--- a/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference
+++ b/testsuite/tests/backtrace/backtrace_dynlink.flambda.reference
@@ -1,25 +1,25 @@
 Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38
-Called from Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 83, characters 12-29
+Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15
-Called from Dynlink.Native.run in file "native/dynlink.ml", lines 82-88, characters 4-47
-Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54
+Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", lines 84-90, characters 4-47
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml" (inlined), lines 354-363, characters 6-13
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml" (inlined), lines 352-361, characters 6-13
 Called from Stdlib__Fun.protect in file "fun.ml" (inlined), line 34, characters 8-15
-Called from Dynlink_common.Make.load in file "dynlink_common.ml", lines 347-364, characters 4-7
-Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 366, characters 26-45
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", lines 345-362, characters 4-7
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 364, characters 26-45
 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52
 execution of module initializers in the shared library failed: Failure("SUCCESS")
-Raised by primitive operation at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 83, characters 12-29
-Re-raised at Dynlink.Native.run.(fun) in file "native/dynlink.ml", lines 85-87, characters 10-43
+Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
+Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", lines 87-89, characters 10-43
 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15
-Called from Dynlink.Native.run in file "native/dynlink.ml", lines 82-88, characters 4-47
-Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54
+Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", lines 84-90, characters 4-47
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
 Called from Stdlib__List.iter in file "list.ml" (inlined), line 112, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml" (inlined), lines 354-363, characters 6-13
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml" (inlined), lines 352-361, characters 6-13
 Called from Stdlib__Fun.protect in file "fun.ml" (inlined), line 34, characters 8-15
-Called from Dynlink_common.Make.load in file "dynlink_common.ml", lines 347-364, characters 4-7
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", lines 345-362, characters 4-7
 Re-raised at Stdlib__Fun.protect in file "fun.ml" (inlined), line 39, characters 6-52
-Called from Dynlink_common.Make.load in file "dynlink_common.ml", lines 347-364, characters 4-7
-Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 366, characters 26-45
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", lines 345-362, characters 4-7
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 364, characters 26-45
 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52

diff --git a/testsuite/tests/backtrace/backtrace_dynlink.ml b/testsuite/tests/backtrace/backtrace_dynlink.ml
index 7caf291801f9197b4dda6595d1074b53c1cb6aff..223017d142c0d3140d4d2013ae6cc0fb56a7247e 100644 (file)
--- a/testsuite/tests/backtrace/backtrace_dynlink.ml
+++ b/testsuite/tests/backtrace/backtrace_dynlink.ml
@@ -52,29 +52,31 @@ let ()  =
  shared-libraries;
  native-dynlink;
  setup-ocamlopt.byte-build-env;
+
+ module = "backtrace_dynlink.ml";
+ flags = "-g";
+ ocamlopt.byte;
+
+ unset module;
+ program = "backtrace_dynlink_plugin.cmxs";
+ flags = "-shared -g";
+ all_modules = "backtrace_dynlink_plugin.ml";
+ ocamlopt.byte;
+
+ program = "${test_build_directory}/main.exe";
+ unset flags;
+ libraries = "dynlink";
+ all_modules = "backtrace_dynlink.cmx";
+ ocamlopt.byte;
+
+ ocamlrunparam += ",b=1";
+ run;
  {
-   module = "backtrace_dynlink.ml";
-   flags = "-g";
-   ocamlopt.byte;
- }{
-   program = "backtrace_dynlink_plugin.cmxs";
-   flags = "-shared -g";
-   all_modules = "backtrace_dynlink_plugin.ml";
-   ocamlopt.byte;
+   no-flambda;
+   check-program-output;
  }{
-   program = "${test_build_directory}/main.exe";
-   libraries = "dynlink";
-   all_modules = "backtrace_dynlink.cmx";
-   ocamlopt.byte;
-   ocamlrunparam += ",b=1";
-   run;
-   {
-     no-flambda;
-     check-program-output;
-   }{
-     reference = "${test_source_directory}/backtrace_dynlink.flambda.reference";
-     flambda;
-     check-program-output;
-   }
+   reference = "${test_source_directory}/backtrace_dynlink.flambda.reference";
+   flambda;
+   check-program-output;
  }
 *)

diff --git a/testsuite/tests/backtrace/backtrace_dynlink.reference b/testsuite/tests/backtrace/backtrace_dynlink.reference
index e2f64c5c2c67148ca82b1a01517ce35785dc4675..158a7c84015a634353223b76723e1af76e5e7134 100644 (file)
--- a/testsuite/tests/backtrace/backtrace_dynlink.reference
+++ b/testsuite/tests/backtrace/backtrace_dynlink.reference
@@ -1,18 +1,18 @@
 Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38
-Called from Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 83, characters 12-29
+Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
 Called from Stdlib__Fun.protect in file "fun.ml", line 34, characters 8-15
-Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 366, characters 26-45
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 364, characters 26-45
 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52
 execution of module initializers in the shared library failed: Failure("SUCCESS")
-Raised by primitive operation at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 83, characters 12-29
-Re-raised at Dynlink.Native.run.(fun) in file "native/dynlink.ml", lines 85-87, characters 10-43
+Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
+Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", lines 87-89, characters 10-43
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
 Called from Stdlib__Fun.protect in file "fun.ml", line 34, characters 8-15
 Re-raised at Stdlib__Fun.protect in file "fun.ml", line 39, characters 6-52
-Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 366, characters 26-45
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 364, characters 26-45
 Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52

diff --git a/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference b/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference
index 2d5d343388f2735b61bcffc684ca88c8c26a843b..7676a79fd236c2dc00bec7d6a7f208d020452277 100644 (file)
--- a/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference
+++ b/testsuite/tests/backtrace/backtrace_effects_nested.flambda.reference
@@ -1,4 +1,4 @@
 Raised by primitive operation at Backtrace_effects_nested.blorp in file "backtrace_effects_nested.ml", line 21, characters 2-11
-Called from Stdlib__Effect.Deep.continue in file "effect.ml" (inlined), line 62, characters 4-65
+Called from Stdlib__Effect.Deep.continue in file "effect.ml" (inlined), line 60, characters 4-65
 Called from Backtrace_effects_nested.baz.(fun) in file "backtrace_effects_nested.ml", line 29, characters 16-29
 43

diff --git a/testsuite/tests/badly-ordered-deps/a.ml b/testsuite/tests/badly-ordered-deps/a.ml
new file mode 100644 (file)
index 0000000..179d429
--- /dev/null
+++ b/testsuite/tests/badly-ordered-deps/a.ml
@@ -0,0 +1 @@
+let x = 3

diff --git a/testsuite/tests/badly-ordered-deps/cocinelle.ml b/testsuite/tests/badly-ordered-deps/cocinelle.ml
new file mode 100644 (file)
index 0000000..e4ed458
--- /dev/null
+++ b/testsuite/tests/badly-ordered-deps/cocinelle.ml
@@ -0,0 +1,41 @@
+(* TEST
+ modules = "a.ml cocinelle.ml";
+ {
+   setup-ocamlc.byte-build-env;
+   flags = "-for-pack Pack";
+   module = "a.ml";
+   ocamlc.byte;
+   flags = "-for-pack Pack";
+   module = "cocinelle.ml";
+   ocamlc.byte;
+   module = "";
+   flags = "";
+   program="./cocinelle.byte";
+   all_modules = "a.cmo cocinelle.cmo";
+   module = "";
+   ocamlc.byte;
+   run;
+   check-program-output;
+ }{
+   setup-ocamlopt.byte-build-env;
+     flags = "-for-pack Pack";
+     module = "a.ml";
+     ocamlopt.byte;
+     flags = "-for-pack Pack";
+     module = "cocinelle.ml";
+     ocamlopt.byte;
+     output="cocinelle";
+     all_modules = "a.cmx cocinelle.cmx";
+     program="./cocinelle.exe";
+     module = "";
+     ocamlopt.byte;
+     run;
+     check-program-output;
+ }
+*)
+
+(* Check that it is still possible to link modules compiled with -for-pack but
+   not yet packed for the sake of backward compatibility. This is not officially
+   supported, but it is not worth breaking packages using this property. *)
+
+let () = Format.printf "A.x=%d@." A.x

diff --git a/testsuite/tests/badly-ordered-deps/cocinelle.reference b/testsuite/tests/badly-ordered-deps/cocinelle.reference
new file mode 100644 (file)
index 0000000..df3a9ff
--- /dev/null
+++ b/testsuite/tests/badly-ordered-deps/cocinelle.reference
@@ -0,0 +1 @@
+A.x=3

diff --git a/testsuite/tests/badly-ordered-deps/main.bytecode.reference b/testsuite/tests/badly-ordered-deps/main.bytecode.reference
index dc821a15df34a63b328d012a2596dd607561168d..ca66cec2e36543ceb77c4727684b069ace506b33 100644 (file)
--- a/testsuite/tests/badly-ordered-deps/main.bytecode.reference
+++ b/testsuite/tests/badly-ordered-deps/main.bytecode.reference
@@ -1,2 +1,7 @@
 File "_none_", line 1:
-Error: Wrong link order: "Lib" depends on "Main"
+Error: Wrong link order: "Lib" (lib.cmo) depends on "Main" (main.cmo)
+File "_none_", line 1:
+Error: Wrong link order: "Lib" (lib.cmo) depends on "Main" (main.cmo)
+File "_none_", line 1:
+Error: No implementation provided for the following modules:
+         "Main" referenced from "Lib" (lib.cmo)

diff --git a/testsuite/tests/badly-ordered-deps/main.ml b/testsuite/tests/badly-ordered-deps/main.ml
index ba6c6cfb97c5aeb37cd2695b94710c9e411f9dc2..ededcf90c20204f76bc457fb5a181839f588e8c9 100644 (file)
--- a/testsuite/tests/badly-ordered-deps/main.ml
+++ b/testsuite/tests/badly-ordered-deps/main.ml
@@ -1,19 +1,59 @@
 (* TEST
  modules = "lib.ml";
- setup-ocamlc.byte-build-env;
- all_modules = "main.ml";
- compile_only = "true";
- ocamlc.byte;
- all_modules = "lib.ml";
- ocamlc.byte;
- all_modules = "lib.cmo main.cmo";
- compile_only = "false";
- ocamlc_byte_exit_status = "2";
- ocamlc.byte;
- check-ocamlc.byte-output;
+ {
+   setup-ocamlc.byte-build-env;
+   all_modules = "main.ml";
+   compile_only = "true";
+   ocamlc.byte;
+   all_modules = "lib.ml";
+   ocamlc.byte;
+   {
+     all_modules = "lib.cmo main.cmo";
+     compile_only = "false";
+     ocamlc_byte_exit_status = "2";
+     ocamlc.byte;
+   }{
+     all_modules = "lib.cmo main.cmo";
+     compile_only = "false";
+     ocamlc_byte_exit_status = "2";
+     flags = "-a";
+     ocamlc.byte;
+  }{
+     all_modules = "lib.cmo";
+     compile_only = "false";
+     ocamlc_byte_exit_status = "2";
+     ocamlc.byte;
+     check-ocamlc.byte-output;
+  }
+}{
+   setup-ocamlopt.byte-build-env;
+   all_modules = "main.ml";
+   compile_only = "true";
+   ocamlopt.byte;
+   all_modules = "lib.ml";
+   ocamlopt.byte;
+   {
+     all_modules = "lib.cmx main.cmx";
+     compile_only = "false";
+     ocamlopt_byte_exit_status = "2";
+     ocamlopt.byte;
+   }{
+     all_modules = "lib.cmx main.cmx";
+     compile_only = "false";
+     ocamlopt_byte_exit_status = "2";
+     flags = "-a";
+     ocamlopt.byte;
+  }{
+     all_modules = "lib.cmx";
+     compile_only = "false";
+     ocamlopt_byte_exit_status = "2";
+     ocamlopt.byte;
+     check-ocamlopt.byte-output;
+  }
+}
 *)
 
-(* Make sure ocamlc prints badly ordered dependencies only once.
+(* Make sure ocamlc and ocamlopt print badly ordered dependencies only once.
    See issue #12074. We test with ocamlc.byte only. *)
 
 let value = ()

diff --git a/testsuite/tests/badly-ordered-deps/main.native.reference b/testsuite/tests/badly-ordered-deps/main.native.reference
new file mode 100644 (file)
index 0000000..db715c4
--- /dev/null
+++ b/testsuite/tests/badly-ordered-deps/main.native.reference
@@ -0,0 +1,7 @@
+File "_none_", line 1:
+Error: Wrong link order: "Lib" (lib.cmx) depends on "Main" (main.cmx)
+File "_none_", line 1:
+Error: Wrong link order: "Lib" (lib.cmx) depends on "Main" (main.cmx)
+File "_none_", line 1:
+Error: No implementation provided for the following modules:
+         "Main" referenced from "Lib" (lib.cmx)

diff --git a/testsuite/tests/basic-manyargs/manyargsprim.c b/testsuite/tests/basic-manyargs/manyargsprim.c
index b8b44d871a00a09838a43ecb28a5e463c6fc2e68..e5b3fec507822b8d947bb1ce74ff5526ed2a8531 100644 (file)
--- a/testsuite/tests/basic-manyargs/manyargsprim.c
+++ b/testsuite/tests/basic-manyargs/manyargsprim.c
@@ -13,8 +13,8 @@
 /*                                                                        */
 /**************************************************************************/
 
-#include "caml/mlvalues.h"
-#include "stdio.h"
+#include <caml/mlvalues.h>
+#include <stdio.h>
 
 value manyargs(value a, value b, value c, value d, value e, value f,
                value g, value h, value i, value j, value k)

diff --git a/testsuite/tests/basic/patmatch_for_multiple.ml b/testsuite/tests/basic/patmatch_for_multiple.ml
index 219afb611e6934f5e83ff342265489c1f18c3a38..8c1c8b87ce3925a7401d89763de6cbc730aec0a7 100644 (file)
--- a/testsuite/tests/basic/patmatch_for_multiple.ml
+++ b/testsuite/tests/basic/patmatch_for_multiple.ml
@@ -29,13 +29,13 @@ match (3, 2, 1) with
 (let (*match*/277 = 3 *match*/278 = 2 *match*/279 = 1)
   (catch
     (catch
-      (catch (if (!= *match*/278 3) (exit 3) (exit 1)) with (3)
-        (if (!= *match*/277 1) (exit 2) (exit 1)))
-     with (2) 0)
-   with (1) 1))
+      (catch (if (!= *match*/278 3) (exit 4) (exit 2)) with (4)
+        (if (!= *match*/277 1) (exit 3) (exit 2)))
+     with (3) 0)
+   with (2) 1))
 (let (*match*/277 = 3 *match*/278 = 2 *match*/279 = 1)
-  (catch (if (!= *match*/278 3) (if (!= *match*/277 1) 0 (exit 1)) (exit 1))
-   with (1) 1))
+  (catch (if (!= *match*/278 3) (if (!= *match*/277 1) 0 (exit 2)) (exit 2))
+   with (2) 1))
 - : bool = false
 |}];;
 
@@ -51,22 +51,22 @@ match (3, 2, 1) with
   (catch
     (catch
       (catch
-        (if (!= *match*/283 3) (exit 6)
+        (if (!= *match*/283 3) (exit 8)
           (let (x/286 =a (makeblock 0 *match*/282 *match*/283 *match*/284))
-            (exit 4 x/286)))
-       with (6)
-        (if (!= *match*/282 1) (exit 5)
+            (exit 6 x/286)))
+       with (8)
+        (if (!= *match*/282 1) (exit 7)
           (let (x/285 =a (makeblock 0 *match*/282 *match*/283 *match*/284))
-            (exit 4 x/285))))
-     with (5) 0)
-   with (4 x/280) (seq (ignore x/280) 1)))
+            (exit 6 x/285))))
+     with (7) 0)
+   with (6 x/280) (seq (ignore x/280) 1)))
 (let (*match*/282 = 3 *match*/283 = 2 *match*/284 = 1)
   (catch
     (if (!= *match*/283 3)
       (if (!= *match*/282 1) 0
-        (exit 4 (makeblock 0 *match*/282 *match*/283 *match*/284)))
-      (exit 4 (makeblock 0 *match*/282 *match*/283 *match*/284)))
-   with (4 x/280) (seq (ignore x/280) 1)))
+        (exit 6 (makeblock 0 *match*/282 *match*/283 *match*/284)))
+      (exit 6 (makeblock 0 *match*/282 *match*/283 *match*/284)))
+   with (6 x/280) (seq (ignore x/280) 1)))
 - : bool = false
 |}];;
 
@@ -164,15 +164,15 @@ let _ = fun a b -> match a, b with
   (catch
     (if a/323
       (let (x/331 =a[int] a/323 p/332 =a (makeblock 0 a/323 b/324))
-        (exit 10 x/331 p/332))
+        (exit 31 x/331 p/332))
       (let (x/329 =a b/324 p/330 =a (makeblock 0 a/323 b/324))
-        (exit 10 x/329 p/330)))
-   with (10 x/325[int] p/326) (makeblock 0 (int,*) x/325 p/326)))
+        (exit 31 x/329 p/330)))
+   with (31 x/325[int] p/326) (makeblock 0 (int,*) x/325 p/326)))
 (function a/323[int] b/324[int]
   (catch
-    (if a/323 (exit 10 a/323 (makeblock 0 a/323 b/324))
-      (exit 10 b/324 (makeblock 0 a/323 b/324)))
-   with (10 x/325[int] p/326) (makeblock 0 (int,*) x/325 p/326)))
+    (if a/323 (exit 31 a/323 (makeblock 0 a/323 b/324))
+      (exit 31 b/324 (makeblock 0 a/323 b/324)))
+   with (31 x/325[int] p/326) (makeblock 0 (int,*) x/325 p/326)))
 - : bool -> bool -> bool * (bool * bool) = <fun>
 |}]
 
@@ -225,12 +225,12 @@ let _ =fun a b -> match a, b with
 [%%expect {|
 (function a/352[int] b/353
   (catch
-    (if a/352 (if b/353 (let (p/354 =a (field_imm 0 b/353)) p/354) (exit 12))
-      (exit 12))
-   with (12) (let (p/355 =a (makeblock 0 a/352 b/353)) p/355)))
+    (if a/352 (if b/353 (let (p/354 =a (field_imm 0 b/353)) p/354) (exit 42))
+      (exit 42))
+   with (42) (let (p/355 =a (makeblock 0 a/352 b/353)) p/355)))
 (function a/352[int] b/353
-  (catch (if a/352 (if b/353 (field_imm 0 b/353) (exit 12)) (exit 12))
-   with (12) (makeblock 0 a/352 b/353)))
+  (catch (if a/352 (if b/353 (field_imm 0 b/353) (exit 42)) (exit 42))
+   with (42) (makeblock 0 a/352 b/353)))
 - : bool -> bool tuplist -> bool * bool tuplist = <fun>
 |}]
 
@@ -243,16 +243,16 @@ let _ = fun a b -> match a, b with
   (catch
     (catch
       (if a/356
-        (if b/357 (let (p/361 =a (field_imm 0 b/357)) (exit 13 p/361))
-          (exit 14))
-        (exit 14))
-     with (14) (let (p/360 =a (makeblock 0 a/356 b/357)) (exit 13 p/360)))
-   with (13 p/358) p/358))
+        (if b/357 (let (p/361 =a (field_imm 0 b/357)) (exit 46 p/361))
+          (exit 47))
+        (exit 47))
+     with (47) (let (p/360 =a (makeblock 0 a/356 b/357)) (exit 46 p/360)))
+   with (46 p/358) p/358))
 (function a/356[int] b/357
   (catch
     (catch
-      (if a/356 (if b/357 (exit 13 (field_imm 0 b/357)) (exit 14)) (exit 14))
-     with (14) (exit 13 (makeblock 0 a/356 b/357)))
-   with (13 p/358) p/358))
+      (if a/356 (if b/357 (exit 46 (field_imm 0 b/357)) (exit 47)) (exit 47))
+     with (47) (exit 46 (makeblock 0 a/356 b/357)))
+   with (46 p/358) p/358))
 - : bool -> bool tuplist -> bool * bool tuplist = <fun>
 |}]

diff --git a/testsuite/tests/basic/patmatch_split_no_or.ml b/testsuite/tests/basic/patmatch_split_no_or.ml
index 2ceb5c4036a5cf68dd3194a455bfa60f53798a57..1b8581411906d88d86ac4209256f1aa12243a8f5 100644 (file)
--- a/testsuite/tests/basic/patmatch_split_no_or.ml
+++ b/testsuite/tests/basic/patmatch_split_no_or.ml
@@ -18,9 +18,9 @@ let last_is_anys = function
   (last_is_anys/11 =
      (function param/13 : int
        (catch
-         (if (field_imm 0 param/13) (if (field_imm 1 param/13) (exit 1) 1)
-           (if (field_imm 1 param/13) (exit 1) 2))
-        with (1) 3)))
+         (if (field_imm 0 param/13) (if (field_imm 1 param/13) (exit 2) 1)
+           (if (field_imm 1 param/13) (exit 2) 2))
+        with (2) 3)))
   (apply (field_mut 1 (global Toploop!)) "last_is_anys" last_is_anys/11))
 val last_is_anys : bool * bool -> int = <fun>
 |}]
@@ -35,9 +35,9 @@ let last_is_vars = function
   (last_is_vars/18 =
      (function param/22 : int
        (catch
-         (if (field_imm 0 param/22) (if (field_imm 1 param/22) (exit 3) 1)
-           (if (field_imm 1 param/22) (exit 3) 2))
-        with (3) 3)))
+         (if (field_imm 0 param/22) (if (field_imm 1 param/22) (exit 5) 1)
+           (if (field_imm 1 param/22) (exit 5) 2))
+        with (5) 3)))
   (apply (field_mut 1 (global Toploop!)) "last_is_vars" last_is_vars/18))
 val last_is_vars : bool * bool -> int = <fun>
 |}]
@@ -78,9 +78,9 @@ let f = function
      (function param/31 : int
        (let (*match*/32 =a (field_imm 0 param/31))
          (catch
-           (if (== *match*/32 A/26) (if (field_imm 1 param/31) 1 (exit 8))
-             (exit 8))
-          with (8)
+           (if (== *match*/32 A/26) (if (field_imm 1 param/31) 1 (exit 11))
+             (exit 11))
+          with (11)
            (if (field_imm 1 param/31)
              (if (== (field_imm 0 *match*/32) B/27) 2
                (if (== (field_imm 0 *match*/32) C/28) 3 4))

diff --git a/testsuite/tests/basic/stringmatch.ml b/testsuite/tests/basic/stringmatch.ml
index ac14c6de848cb3a0e285b25de23b13f9e0181f53..671b90dc2cca246894c6c676cf690cc51ca25513 100644 (file)
--- a/testsuite/tests/basic/stringmatch.ml
+++ b/testsuite/tests/basic/stringmatch.ml
@@ -31,7 +31,7 @@ let () =
   assert (tst02 "\000\000\000\003" = 3) ;
   ()
 
-(* Keword reckognition *)
+(* Keyword recognition *)
 
 let s00 = "get_const"
 let t00 = "set_congt"

diff --git a/testsuite/tests/c-api/aligned_alloc_stubs.c b/testsuite/tests/c-api/aligned_alloc_stubs.c
index 1b2e505886267d48f84ebefd9a0bafb4173b0cc0..1f239eb1b9cf04472d5d2e222d15560b54650a45 100644 (file)
--- a/testsuite/tests/c-api/aligned_alloc_stubs.c
+++ b/testsuite/tests/c-api/aligned_alloc_stubs.c
@@ -1,6 +1,6 @@
 #include <stdio.h>
 #include <stdlib.h>
-#include "caml/alloc.h"
+#include <caml/alloc.h>
 
 CAMLprim value caml_atomic_is_aligned(value val)
 {

diff --git a/testsuite/tests/c-api/alloc_async_stubs.c b/testsuite/tests/c-api/alloc_async_stubs.c
index 506da37601e5426489b949770ccf5431c39cc169..9c6926a80f2fbc0cd9772217b7af23f9a08d17c4 100644 (file)
--- a/testsuite/tests/c-api/alloc_async_stubs.c
+++ b/testsuite/tests/c-api/alloc_async_stubs.c
@@ -1,9 +1,9 @@
 #include <stdio.h>
 #include <stdlib.h>
-#include "caml/alloc.h"
-#include "caml/memory.h"
+#include <caml/alloc.h>
+#include <caml/memory.h>
 #define CAML_INTERNALS
-#include "caml/gc_ctrl.h"
+#include <caml/gc_ctrl.h>
 
 
 void print_status(const char *str, int n)

diff --git a/testsuite/tests/c-api/c_noreturn.ml b/testsuite/tests/c-api/c_noreturn.ml
new file mode 100644 (file)
index 0000000..1484813
--- /dev/null
+++ b/testsuite/tests/c-api/c_noreturn.ml
@@ -0,0 +1,5 @@
+(* TEST
+  modules = "c_noreturn_stubs.c";
+ *)
+
+let () = ()

diff --git a/testsuite/tests/c-api/c_noreturn_stubs.c b/testsuite/tests/c-api/c_noreturn_stubs.c
new file mode 100644 (file)
index 0000000..d5ad577
--- /dev/null
+++ b/testsuite/tests/c-api/c_noreturn_stubs.c
@@ -0,0 +1,12 @@
+#include <caml/misc.h>
+#include <stdlib.h>
+
+CAMLnoret extern void f(void);
+CAMLnoreturn_start extern void g(void) CAMLnoreturn_end;
+Noreturn extern void h(void);
+extern void i(void) Noreturn;
+
+void f(void) { abort(); }
+void g(void) { abort(); }
+void h(void) { abort(); }
+void i(void) { abort(); }

diff --git a/testsuite/tests/c-api/external.ml b/testsuite/tests/c-api/external.ml
index 5d3c9625175127d69c89a3acc4e19d46bf0cb923..7770c7f098d15e514dc0b30846aa8cdbe9fa6006 100644 (file)
--- a/testsuite/tests/c-api/external.ml
+++ b/testsuite/tests/c-api/external.ml
@@ -9,15 +9,15 @@ type data = A | B | C | D | E | F
 
 external test_int : (int [@untagged])
                     -> (char [@untagged]) -> (data [@untagged])
-                    -> (int [@untagged]) = "unavailable" "test" [@@noalloc]
+                    -> (int [@untagged]) = "unavailable" "test_" [@@noalloc]
 
 external test_char : (int [@untagged])
                     -> (char [@untagged]) -> (data [@untagged])
-                    -> (char [@untagged]) = "unavailable" "test" [@@noalloc]
+                    -> (char [@untagged]) = "unavailable" "test_" [@@noalloc]
 
 external test_data : (int [@untagged])
                     -> (char [@untagged]) -> (data [@untagged])
-                    -> (data [@untagged]) = "unavailable" "test" [@@noalloc]
+                    -> (data [@untagged]) = "unavailable" "test_" [@@noalloc]
 
 let _ = assert(test_int 1 '\001' B = 3)
 let _ = assert(test_char 1 '\001' B = '\003')

diff --git a/testsuite/tests/c-api/external_stubs.c b/testsuite/tests/c-api/external_stubs.c
index 8d89952883ec85be17fc802f2e4f4d082324c8e2..50556f3eb3c28197992e2cc3c6740d55209b7753 100644 (file)
--- a/testsuite/tests/c-api/external_stubs.c
+++ b/testsuite/tests/c-api/external_stubs.c
@@ -2,6 +2,6 @@
 #include <stdlib.h>
 #include <caml/mlvalues.h>
 
-intnat test(intnat b,intnat c,intnat d) {
+intnat test_(intnat b,intnat c,intnat d) {
   return(b+c+d);
 }

diff --git a/testsuite/tests/c-api/test_c_thread_has_lock_cstubs.c b/testsuite/tests/c-api/test_c_thread_has_lock_cstubs.c
index b598959fe4be4d3160080c98df7ac79e8bf29118..d96bcfe7bfe5b48a1a62d655d6282c0e26463cbc 100644 (file)
--- a/testsuite/tests/c-api/test_c_thread_has_lock_cstubs.c
+++ b/testsuite/tests/c-api/test_c_thread_has_lock_cstubs.c
@@ -1,6 +1,6 @@
-#include "caml/mlvalues.h"
-#include "caml/domain_state.h"
-#include "caml/signals.h"
+#include <caml/mlvalues.h>
+#include <caml/domain_state.h>
+#include <caml/signals.h>
 
 value with_lock(value unit)
 {

diff --git a/testsuite/tests/callback/callbackprim.c b/testsuite/tests/callback/callbackprim.c
index 06b354429bc56786e4011a532c4c85df33d076db..d97ae8bb6729ebc6ec350323b01fd26071277df8 100644 (file)
--- a/testsuite/tests/callback/callbackprim.c
+++ b/testsuite/tests/callback/callbackprim.c
@@ -14,9 +14,9 @@
 /**************************************************************************/
 
 #include <signal.h>
-#include "caml/mlvalues.h"
-#include "caml/memory.h"
-#include "caml/callback.h"
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/callback.h>
 
 value mycallback1(value fun, value arg)
 {

diff --git a/testsuite/tests/callback/test1_.c b/testsuite/tests/callback/test1_.c
index 04d5d96b2e2e13c1801ac2bca7bee831798ee2e6..fd6ec0f9828bf729fbcd0b162f7e968bb0d17f11 100644 (file)
--- a/testsuite/tests/callback/test1_.c
+++ b/testsuite/tests/callback/test1_.c
@@ -13,9 +13,9 @@
 /*                                                                        */
 /**************************************************************************/
 
-#include "caml/mlvalues.h"
-#include "caml/memory.h"
-#include "caml/callback.h"
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/callback.h>
 
 value mycallback1(value fun, value arg)
 {

diff --git a/testsuite/tests/callback/test_signalhandler_.c b/testsuite/tests/callback/test_signalhandler_.c
index 3f7b77240c8f4e59673e5234fcc332bfe6c6b165..2d4e90cbd3cd396776aa9c9238252794b011a5c6 100644 (file)
--- a/testsuite/tests/callback/test_signalhandler_.c
+++ b/testsuite/tests/callback/test_signalhandler_.c
@@ -17,10 +17,10 @@
 
 #define CAML_INTERNALS
 
-#include "caml/mlvalues.h"
-#include "caml/memory.h"
-#include "caml/callback.h"
-#include "caml/signals.h"
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/callback.h>
+#include <caml/signals.h>
 
 value mycallback1(value fun, value arg)
 {

diff --git a/testsuite/tests/cxx-api/all-includes.h b/testsuite/tests/cxx-api/all-includes.h
new file mode 100644 (file)
index 0000000..668619d
--- /dev/null
+++ b/testsuite/tests/cxx-api/all-includes.h
@@ -0,0 +1,71 @@
+#include <caml/reverse.h>
+#include <caml/compatibility.h>
+#include <caml/prims.h>
+#include <caml/instruct.h>
+#include <caml/dynlink.h>
+#include <caml/custom.h>
+#include <caml/finalise.h>
+#include <caml/memprof.h>
+#include <caml/version.h>
+#include <caml/s.h>
+#include <caml/hooks.h>
+#include <caml/skiplist.h>
+#include <caml/sync.h>
+#include <caml/config.h>
+#include <caml/backtrace.h>
+#include <caml/misc.h>
+#include <caml/printexc.h>
+#include <caml/mlvalues.h>
+#include <caml/md5.h>
+#include <caml/gc.h>
+#include <caml/domain.h>
+#include <caml/signals.h>
+#include <caml/gc_stats.h>
+#include <caml/startup.h>
+#include <caml/shared_heap.h>
+#include <caml/codefrag.h>
+#include <caml/asm.h>
+#include <caml/roots.h>
+#include <caml/frame_descriptors.h>
+#include <caml/intext.h>
+#include <caml/compare.h>
+#include <caml/osdeps.h>
+#include <caml/major_gc.h>
+#include <caml/addrmap.h>
+#include <caml/instrtrace.h>
+#include <caml/backtrace_prim.h>
+#include <caml/m.h>
+#include <caml/blake2.h>
+#include <caml/weak.h>
+#include <caml/globroots.h>
+#include <caml/io.h>
+#include <caml/startup_aux.h>
+#include <caml/stack.h>
+#include <caml/sizeclasses.h>
+#include <caml/sys.h>
+#include <caml/exec.h>
+#include <caml/tsan.h>
+#include <caml/memory.h>
+#include <caml/opnames.h>
+#include <caml/bigarray.h>
+#include <caml/debugger.h>
+#include <caml/address_class.h>
+#include <caml/runtime_events.h>
+#include <caml/minor_gc.h>
+#include <caml/domain_state.h>
+#include <caml/gc_ctrl.h>
+#include <caml/interp.h>
+#include <caml/callback.h>
+#include <caml/camlatomic.h>
+#include <caml/platform.h>
+#include <caml/hash.h>
+#include <caml/alloc.h>
+#include <caml/lf_skiplist.h>
+#include <caml/fail.h>
+#include <caml/fiber.h>
+#include <caml/fix_code.h>
+#include <caml/winsupport.h>
+#include <caml/runtime_events_consumer.h>
+#include <caml/threads.h>
+#include <caml/socketaddr.h>
+#include <caml/unixsupport.h>

diff --git a/testsuite/tests/cxx-api/all_includes.ml b/testsuite/tests/cxx-api/all_includes.ml
new file mode 100644 (file)
index 0000000..8181b1d
--- /dev/null
+++ b/testsuite/tests/cxx-api/all_includes.ml
@@ -0,0 +1,13 @@
+(* TEST
+ modules = "stubs.c";
+ readonly_files = "all-includes.h";
+ not-msvc;
+ flags = "-ccopt -x -ccopt c++ -ccopt -std=c++11";
+*)
+
+external test_cxx : unit -> (int * int) = "test_cxx"
+
+let () =
+  let (x, y) = test_cxx () in
+  assert (x = 42);
+  assert (y = 1337)

diff --git a/testsuite/tests/cxx-api/stubs.c b/testsuite/tests/cxx-api/stubs.c
new file mode 100644 (file)
index 0000000..5573061
--- /dev/null
+++ b/testsuite/tests/cxx-api/stubs.c
@@ -0,0 +1,27 @@
+#ifndef __cplusplus
+#error "A C++ compiler was expected!"
+#endif
+
+// Generate all-includes.h with:
+//
+//   find runtime/caml otherlibs/*/caml       \
+//     -name '*.h' -not -name 'jumptbl.h'     \
+//     -execdir echo '#include <caml/{}>' ';' \
+//   > testsuite/tests/cxx-api/all-includes.h
+//
+//   FIXME: Could the list be generated automatically?
+
+#include "all-includes.h"
+
+extern "C" {
+value test_cxx(value);
+}
+
+value test_cxx(value vunit) {
+  CAMLparam0();
+  CAMLlocal1(pair);
+  pair = caml_alloc_tuple(2);
+  Store_field(pair, 0, Val_int(42));
+  Store_field(pair, 1, Val_int(1337));
+  CAMLreturn(pair);
+}

diff --git a/testsuite/tests/effect-syntax/coroutines.ml b/testsuite/tests/effect-syntax/coroutines.ml
new file mode 100644 (file)
index 0000000..91acbaa
--- /dev/null
+++ b/testsuite/tests/effect-syntax/coroutines.ml
@@ -0,0 +1,103 @@
+(* TEST *)
+
+open Printf
+open Effect
+open Effect.Deep
+
+(** {1 Coroutines} *)
+
+type 'a channel = {
+    senders: ('a * (unit, unit) continuation) Queue.t;
+    receivers: ('a, unit) continuation Queue.t
+  }
+
+let new_channel () = { senders = Queue.create(); receivers = Queue.create() }
+
+type _ eff += Spawn : (unit -> unit) -> unit eff
+            | Yield : unit eff
+            | Send  : 'a channel * 'a -> unit eff
+            | Recv  : 'a channel -> 'a eff
+
+exception Terminate
+
+let spawn f = perform (Spawn f)
+
+let yield () = perform Yield
+
+let terminate () = raise Terminate
+
+let send ch v = perform (Send(ch, v))
+
+let recv ch = perform (Recv ch)
+
+(** The queue of runnable tasks *)
+
+let runnable : (unit -> unit) Queue.t = Queue.create()
+
+let suspend f = Queue.add f runnable
+
+let restart () =
+  match Queue.take_opt runnable with
+  | None -> ()
+  | Some f -> f ()
+
+(** The scheduler *)
+
+let rec corun (f: unit -> unit) =
+  match f () with
+  | () | exception Terminate -> restart ()
+  | effect Spawn f, k -> suspend (continue k); corun f
+  | effect Yield, k -> suspend (continue k); restart ()
+  | effect Send(ch, v), k ->
+          begin match Queue.take_opt ch.receivers with
+          | Some rc -> suspend (continue k); continue rc v
+          | None    -> Queue.add (v, k) ch.senders; restart()
+          end
+  | effect Recv ch, k ->
+          begin match Queue.take_opt ch.senders with
+          | Some(v, sn) -> suspend (continue sn); continue k v
+          | None        -> Queue.add k ch.receivers; restart()
+          end
+
+(** Example of use. *)
+
+let task name n =
+  for i = 1 to n do
+    if i >= 7 then terminate();
+    printf "%s%d " name i;
+    yield()
+  done
+
+let _ =
+  corun (fun () ->
+    spawn (fun () -> task "a" 8);
+    spawn (fun () -> task "b" 3);
+    spawn (fun () -> task "c" 4));
+  print_newline()
+
+let _ =
+  let ch = new_channel() in
+  corun (fun () ->
+    spawn (fun () -> send ch "a");
+    spawn (fun () -> send ch "b");
+    printf "%s " (recv ch);
+    printf "%s\n" (recv ch))
+
+(** Eratosthenes' sieve using a pipeline of filters. *)
+
+let rec eratosthenes input =
+  let p = recv input in
+  printf "%d " p;
+  let output = new_channel() in
+  spawn (fun () -> eratosthenes output);
+  while true do
+    let n = recv input in
+    if n mod p <> 0 then send output n
+  done
+
+let _ =
+  corun (fun () ->
+    let ints = new_channel() in
+    spawn (fun () -> eratosthenes ints);
+    for i = 2 to 1000 do send ints i done);
+  print_newline()

diff --git a/testsuite/tests/effect-syntax/coroutines.reference b/testsuite/tests/effect-syntax/coroutines.reference
new file mode 100644 (file)
index 0000000..21484b0
--- /dev/null
+++ b/testsuite/tests/effect-syntax/coroutines.reference
@@ -0,0 +1,3 @@
+a1 b1 a2 c1 b2 a3 c2 b3 a4 c3 a5 c4 a6 
+a b
+2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 

diff --git a/testsuite/tests/effect-syntax/error_messages.ml b/testsuite/tests/effect-syntax/error_messages.ml
new file mode 100644 (file)
index 0000000..fc925eb
--- /dev/null
+++ b/testsuite/tests/effect-syntax/error_messages.ml
@@ -0,0 +1,57 @@
+(* TEST
+  expect;
+*)
+
+type _ eff += A: 'a -> int eff
+[%%expect {|
+type _ eff += A : 'a -> int eff
+|}]
+
+let () = match () with
+  | () -> ()
+  | effect A k, k -> ()
+[%%expect {|
+Line 3, characters 13-14:
+3 |   | effect A k, k -> ()
+                 ^
+Error: Variable "k" is bound several times in this matching
+|}]
+
+let () = match () with
+  | () -> raise Not_found
+  | effect A _, k -> k
+[%%expect {|
+Line 3, characters 21-22:
+3 |   | effect A _, k -> k
+                         ^
+Error: The value "k" has type "(%eff, unit) continuation"
+       but an expression was expected of type "unit"
+|}, Principal{|
+Line 3, characters 21-22:
+3 |   | effect A _, k -> k
+                         ^
+Error: The value "k" has type "(int, unit) continuation"
+       but an expression was expected of type "unit"
+       This instance of "int" is ambiguous:
+       it would escape the scope of its equation
+|}]
+
+let () = match () with
+  | () -> ()
+  | effect A, [k] -> ()
+[%%expect {|
+Line 3, characters 14-17:
+3 |   | effect A, [k] -> ()
+                  ^^^
+Error: Invalid continuation pattern: only variables and _ are allowed .
+|}]
+
+let () = match [] with
+  | _ -> ()
+  | [effect A, k] -> ()
+[%%expect {|
+Line 3, characters 5-16:
+3 |   | [effect A, k] -> ()
+         ^^^^^^^^^^^
+Error: Effect patterns must be at the top level of a match case.
+|}]

diff --git a/testsuite/tests/effect-syntax/iterators.ml b/testsuite/tests/effect-syntax/iterators.ml
new file mode 100644 (file)
index 0000000..2307f7b
--- /dev/null
+++ b/testsuite/tests/effect-syntax/iterators.ml
@@ -0,0 +1,74 @@
+(* TEST *)
+
+open Printf
+open Effect
+open Effect.Deep
+
+(** {1 Iterators and generators} *)
+
+(** Naive primality test. *)
+
+let isprime n =
+  let rec try_divide i =
+    if i * i > n then true else
+    if n mod i = 0 then false else
+    try_divide (i + 2) in
+  n mod 2 <> 0 && try_divide 3
+
+(** Iterate [f] over all primes. *)
+
+let iter_primes (f: int -> unit) : unit =
+  for n = 2 to max_int do
+    if isprime n then f n
+  done
+
+(** Produce the sequence of all primes. *)
+
+let seq_primes : int Seq.t =
+  let rec gen n : int Seq.t =
+    if isprime n then (fun () -> Seq.Cons(n, gen (n + 1))) else gen (n + 1)
+  in gen 2
+
+(** Implementing [gen_primes] from [iter_prime], using control inversion. *)
+
+type _ eff += Next_prime : int -> unit eff
+
+let gen_primes : int Seq.t =
+  match iter_primes (fun n -> perform (Next_prime n)) with
+  | () -> Seq.empty
+  | effect Next_prime n, k -> fun () -> Seq.Cons(n, continue k ())
+
+let same_sequences (s1: 'a Seq.t) (s2: 'a Seq.t) =
+  Seq.for_all2 (=) s1 s2
+
+let _ =
+  assert (same_sequences (Seq.take 100 seq_primes) (Seq.take 100 gen_primes))
+
+(** More general transformation from iterator to sequence. *)
+
+let iterator_to_sequence
+       (type elt) (type collection)
+       (iter: (elt -> unit) -> collection -> unit) : collection -> elt Seq.t =
+  let module I2S = struct
+    type _ eff += Next : elt -> unit eff
+    let gen coll =
+      match iter (fun elt -> perform (Next elt)) coll with
+      | () -> Seq.empty
+      | effect Next elt, k -> fun () -> Seq.Cons(elt, continue k ())
+  end in I2S.gen
+
+(** Application: the "same fringe" problem. *)
+
+let same_fringe
+    (iter1: ('elt -> unit) -> 'coll1 -> unit)
+    (iter2: ('elt -> unit) -> 'coll2 -> unit)
+    coll1 coll2 =
+  same_sequences (iterator_to_sequence iter1 coll1)
+                 (iterator_to_sequence iter2 coll2)
+
+module IntSet = Set.Make(Int)
+
+let _ =
+  assert (same_fringe List.iter IntSet.iter
+              [1; 2; 3]
+              (IntSet.add 2 (IntSet.add 1 (IntSet.singleton 3))))

diff --git a/testsuite/tests/effect-syntax/resume_exn.ml b/testsuite/tests/effect-syntax/resume_exn.ml
new file mode 100644 (file)
index 0000000..1d91028
--- /dev/null
+++ b/testsuite/tests/effect-syntax/resume_exn.ml
@@ -0,0 +1,27 @@
+(* TEST *)
+
+open Printf
+open Effect
+open Effect.Deep
+
+(** {1 Resumable exceptions} *)
+
+type _ eff += Conversion_failure : string -> int eff
+
+let int_of_string s =
+  match int_of_string_opt s with
+  | Some n -> n
+  | None -> perform (Conversion_failure s)
+
+let sum_stringlist l =
+  l |> List.map int_of_string |> List.fold_left (+) 0
+
+let safe_sum_stringlist l =
+  match sum_stringlist l with
+  | v -> v
+  | effect Conversion_failure(s), k ->
+      printf "Bad input %s, replaced with 0\n" s;
+      continue k 0
+
+let _ =
+  printf "Sum is: %d\n" (safe_sum_stringlist ["1"; "xxx"; "2"; "yyy"; "3"])

diff --git a/testsuite/tests/effect-syntax/resume_exn.reference b/testsuite/tests/effect-syntax/resume_exn.reference
new file mode 100644 (file)
index 0000000..a8f4af7
--- /dev/null
+++ b/testsuite/tests/effect-syntax/resume_exn.reference
@@ -0,0 +1,3 @@
+Bad input xxx, replaced with 0
+Bad input yyy, replaced with 0
+Sum is: 6

diff --git a/testsuite/tests/effect-syntax/shallow2deep.ml b/testsuite/tests/effect-syntax/shallow2deep.ml
new file mode 100644 (file)
index 0000000..08e5d55
--- /dev/null
+++ b/testsuite/tests/effect-syntax/shallow2deep.ml
@@ -0,0 +1,110 @@
+(* TEST *)
+
+open Printf
+open Effect
+open Effect.Deep
+
+(* Francois Pottier's implementation of shallow handlers on top of
+   deep handlers, by reification of an effectful operation
+   as a stream of events. *)
+
+module MkReify
+  (X : sig
+     (* A type of operations ['a op]. *)
+     type 'a op
+     (* An effect name [E]. *)
+     type _ eff += E : 'a op -> 'a eff
+  end)
+= struct
+  open Effect
+  open Effect.Deep
+  open X
+
+  (* The type ['a event] represents a computation whose result type is ['a].
+     It can be thought of as a lazy sequence of events, where an event is
+     either normal termination [Ret] or an effect [Eff]. The first event of
+     the stream is immediately available for inspection; the rest of the
+     computation is suspended and represented as a continuation. *)
+
+  type 'a event =
+  | Ret : 'a -> 'a event
+  | Eff : 'a op * ('a, 'b event) continuation -> 'b event
+
+  (* [reify] transforms an effectful computation into a stream of events.
+     The effects named [E] are caught and become events in the stream. *)
+
+  let reify (type a) (m : unit -> a) : a event =
+    match m () with
+    | x -> Ret x
+    | effect E op, k -> Eff(op, k)
+
+end
+
+module PC = struct
+
+  type data = int
+
+  type _ op =
+    | Yield : data -> unit op
+    | Await : data op
+
+  type _ eff += E : 'a op -> 'a eff
+
+end
+
+open PC
+
+let yield x =
+  perform (E (Yield x))
+
+let await () =
+  perform (E Await)
+
+exception ProducerPushedTooFar (* This helps us test. *)
+
+let zero_producer () =
+  raise ProducerPushedTooFar
+
+let zero_consumer () =
+  "I need no data."
+
+let test_producer () =
+  yield 1;
+  yield 2;
+  raise ProducerPushedTooFar
+
+let test_consumer () =
+  let x = await() in
+  let y = await() in
+  Printf.sprintf "I have received %d and %d." x y
+
+open MkReify(PC)
+
+let rec run_consumer (p : unit -> unit event) (c : 'c event) : 'c =
+  match c with
+  | Ret x ->
+      x
+  | Eff (Await, k) ->
+      let c : data -> 'c event = continue k in
+      run_producer p c
+  | Eff (Yield _, _) ->
+      assert false (* consumer must not yield *)
+
+and run_producer (p : unit -> unit event) (c : data -> 'c event) : 'c =
+  match p() with
+  | Ret () ->
+      assert false (* producer must not stop early *)
+  | Eff (Yield data, k) ->
+      run_consumer (continue k) (c data)
+  | Eff (Await, _) ->
+      assert false (* producer must not await *)
+
+let pipe (type c) (p : unit -> unit) (c : unit -> c) : c =
+  run_consumer (fun () -> reify p) (reify c)
+
+let _ =
+  printf "%s\n" (pipe test_producer test_consumer);
+  printf "%s\n" (pipe zero_producer zero_consumer);
+  printf "%s\n"
+    (try pipe zero_producer test_consumer
+     with ProducerPushedTooFar -> "Producer pushed too far.")

diff --git a/testsuite/tests/effect-syntax/shallow2deep.reference b/testsuite/tests/effect-syntax/shallow2deep.reference
new file mode 100644 (file)
index 0000000..6386e46
--- /dev/null
+++ b/testsuite/tests/effect-syntax/shallow2deep.reference
@@ -0,0 +1,3 @@
+I have received 1 and 2.
+I need no data.
+Producer pushed too far.

diff --git a/testsuite/tests/effect-syntax/test1.ml b/testsuite/tests/effect-syntax/test1.ml
new file mode 100644 (file)
index 0000000..fdc8f62
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test1.ml
@@ -0,0 +1,12 @@
+(* TEST *)
+
+open Effect
+open Effect.Deep
+
+type _ eff += E : unit eff
+
+let () =
+  Printf.printf "%d\n%!" @@
+    match 10 with
+    | x -> x
+    | effect E, k -> 11

diff --git a/testsuite/tests/effect-syntax/test1.reference b/testsuite/tests/effect-syntax/test1.reference
new file mode 100644 (file)
index 0000000..f599e28
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test1.reference
@@ -0,0 +1 @@
+10

diff --git a/testsuite/tests/effect-syntax/test10.ml b/testsuite/tests/effect-syntax/test10.ml
new file mode 100644 (file)
index 0000000..2cde017
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test10.ml
@@ -0,0 +1,31 @@
+(* TEST *)
+
+open Effect
+open Effect.Deep
+
+type _ eff += Peek : int eff
+            | Poke : unit eff
+
+let rec a i = perform Peek + Random.int i
+let rec b i = a i + Random.int i
+let rec c i = b i + Random.int i
+
+let rec d i =
+  Random.int i +
+  begin match c i with
+  | v -> v
+  | effect Poke, k -> continue k ()
+  end
+
+let rec e i =
+  Random.int i +
+  begin match d i with
+  | v -> v
+  | effect Peek, k ->
+          ignore (Deep.get_callstack k 100);
+          continue k 42
+  end
+
+let _ =
+  ignore (e 1);
+  print_string "ok\n"

diff --git a/testsuite/tests/effect-syntax/test10.reference b/testsuite/tests/effect-syntax/test10.reference
new file mode 100644 (file)
index 0000000..9766475
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test10.reference
@@ -0,0 +1 @@
+ok

diff --git a/testsuite/tests/effect-syntax/test11.ml b/testsuite/tests/effect-syntax/test11.ml
new file mode 100644 (file)
index 0000000..a937554
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test11.ml
@@ -0,0 +1,19 @@
+(* TEST *)
+
+(* Tests RESUMETERM with extra_args != 0 in bytecode,
+   by calling a handler with a tail-continue that returns a function *)
+
+open Effect
+open Effect.Deep
+
+type _ eff += E : int eff
+
+let handle comp =
+  match comp () with
+  | v -> v
+  | effect E, k -> continue k 10
+
+let () =
+  handle (fun () ->
+      Printf.printf "%d\n" (perform E);
+      Printf.printf "%d\n") 42

diff --git a/testsuite/tests/effect-syntax/test11.reference b/testsuite/tests/effect-syntax/test11.reference
new file mode 100644 (file)
index 0000000..5c8f9ea
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test11.reference
@@ -0,0 +1,2 @@
+10
+42

diff --git a/testsuite/tests/effect-syntax/test2.ml b/testsuite/tests/effect-syntax/test2.ml
new file mode 100644 (file)
index 0000000..bd8f937
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test2.ml
@@ -0,0 +1,24 @@
+(* TEST *)
+
+open Printf
+open Effect
+open Effect.Deep
+
+type _ eff += E : int -> int eff
+
+let f () =
+  printf "perform effect (E 0)\n%!";
+  let v = perform (E 0) in
+  printf "perform returns %d\n%!" v;
+  v + 1
+
+let v =
+  match f () with
+  | v -> printf "done %d\n%!" v; v + 1
+  | effect (E v), k ->
+      printf "caught effect (E %d). continuing..\n%!" v;
+      let v = continue k (v + 1) in
+      printf "continue returns %d\n%!" v;
+      v + 1
+
+let () = printf "result=%d\n%!" v

diff --git a/testsuite/tests/effect-syntax/test2.reference b/testsuite/tests/effect-syntax/test2.reference
new file mode 100644 (file)
index 0000000..652e4a6
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test2.reference
@@ -0,0 +1,6 @@
+perform effect (E 0)
+caught effect (E 0). continuing..
+perform returns 1
+done 2
+continue returns 3
+result=4

diff --git a/testsuite/tests/effect-syntax/test3.ml b/testsuite/tests/effect-syntax/test3.ml
new file mode 100644 (file)
index 0000000..af62d1c
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test3.ml
@@ -0,0 +1,14 @@
+(* TEST *)
+
+open Effect
+open Effect.Deep
+
+type _ eff += E : unit eff
+exception X
+
+let () =
+  Printf.printf "%d\n%!" @@
+  match (Printf.printf "in handler. raising X\n%!"; raise X) with
+  | v -> v
+  | exception X -> 10
+  | effect E, _ -> 11

diff --git a/testsuite/tests/effect-syntax/test3.reference b/testsuite/tests/effect-syntax/test3.reference
new file mode 100644 (file)
index 0000000..78ea20d
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test3.reference
@@ -0,0 +1,2 @@
+in handler. raising X
+10

diff --git a/testsuite/tests/effect-syntax/test4.ml b/testsuite/tests/effect-syntax/test4.ml
new file mode 100644 (file)
index 0000000..b42cf2c
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test4.ml
@@ -0,0 +1,17 @@
+(* TEST *)
+
+open Effect
+open Effect.Deep
+
+type _ eff += Foo : int -> int eff
+
+let r =
+  match (perform (Foo 3)) with
+  | v -> v
+  | effect (Foo i), k ->
+      begin match continue k (i + 1) with
+      | v -> v
+      | effect (Foo i), k -> failwith "NO"
+      end
+
+let () = Printf.printf "%d\n" r

diff --git a/testsuite/tests/effect-syntax/test4.reference b/testsuite/tests/effect-syntax/test4.reference
new file mode 100644 (file)
index 0000000..b8626c4
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test4.reference
@@ -0,0 +1 @@
+4

diff --git a/testsuite/tests/effect-syntax/test5.ml b/testsuite/tests/effect-syntax/test5.ml
new file mode 100644 (file)
index 0000000..01dbbf0
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test5.ml
@@ -0,0 +1,20 @@
+(* TEST *)
+
+open Effect
+open Effect.Deep
+
+type _ eff += Foo : int -> int eff
+
+let f () = (perform (Foo 3)) (* 3 + 1 *)
+         + (perform (Foo 3)) (* 3 + 1 *)
+
+let r =
+  match f () with
+  | v -> v
+  | effect (Foo i), k ->
+      begin match continue k (i + 1) with
+      | v -> v
+      | effect (Foo i), k -> failwith "NO"
+      end
+
+let () = Printf.printf "%d\n" r

diff --git a/testsuite/tests/effect-syntax/test5.reference b/testsuite/tests/effect-syntax/test5.reference
new file mode 100644 (file)
index 0000000..45a4fb7
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test5.reference
@@ -0,0 +1 @@
+8

diff --git a/testsuite/tests/effect-syntax/test6.ml b/testsuite/tests/effect-syntax/test6.ml
new file mode 100644 (file)
index 0000000..436f973
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test6.ml
@@ -0,0 +1,27 @@
+(* TEST *)
+
+open Effect
+open Effect.Deep
+
+type _ eff += E : unit eff
+            | F : unit eff
+
+let () =
+  let ok1 = ref false
+  and ok2 = ref true
+  and ok3 = ref false in
+  let f e r =
+    try perform e with
+    | Unhandled E -> r := not !r
+  in
+  f E ok1;
+  Printf.printf "%b\n%!" !ok1;
+
+  begin try f F ok2 with Unhandled _ -> () end;
+  Printf.printf "%b\n%!" !ok2;
+
+  begin match f E ok3 with
+  | v -> v
+  | effect F, k -> assert false
+  end;
+  Printf.printf "%b\n%!" !ok3

diff --git a/testsuite/tests/effect-syntax/test6.reference b/testsuite/tests/effect-syntax/test6.reference
new file mode 100644 (file)
index 0000000..b979d62
--- /dev/null
+++ b/testsuite/tests/effect-syntax/test6.reference
@@ -0,0 +1,3 @@
+true
+true
+true

diff --git a/testsuite/tests/effect-syntax/tutorial.ml b/testsuite/tests/effect-syntax/tutorial.ml
new file mode 100644 (file)
index 0000000..971bacc
--- /dev/null
+++ b/testsuite/tests/effect-syntax/tutorial.ml
@@ -0,0 +1,78 @@
+(* TEST *)
+
+open Printf
+open Effect
+open Effect.Deep
+
+(* Some examples from Matija Pretnar's MFPS 2015 tutorial,
+   "An introduction to algebraic effects and handlers". *)
+
+type _ eff += Print : string -> unit eff
+
+let print s = perform (Print s)
+
+let abc () = print "a"; print "b"; print "c"
+
+let output f =
+  match f () with
+  | () -> print_newline()
+  | effect Print s, k ->  print_string s; continue k ()
+
+let reverse f =
+  match f () with
+  | () -> ()
+  | effect Print s, k ->  continue k (); print s
+
+let collect f =
+  match f () with
+  | () -> ""
+  | effect Print s, k -> s ^ continue k ()
+
+let _ =
+  output abc;
+  output (fun () -> reverse abc);
+  printf "%s\n" (collect abc);
+  printf "%s\n" (collect (fun () -> reverse abc))
+
+type _ eff += Get : int eff
+            | Set : int -> unit eff
+
+let get () = perform Get
+let set n  = perform (Set n)
+let incr () = set (get () + 1)
+
+let run_state (f : unit -> 'a) : int -> 'a * int =
+  match f () with
+  | v -> (fun s -> (v, s))
+  | effect Get, k -> (fun s -> continue k s s)
+  | effect Set n, k -> (fun _ -> continue k () n)
+
+let _ =
+  run_state
+    (fun () ->
+      printf "%d " (get()); incr();
+      printf "%d " (get()); incr();
+      printf "%d\n" (get()))
+    10
+
+exception Abort
+
+let transaction (f : unit -> unit) : unit =
+  begin match f () with
+  | () -> (fun s -> set s)
+  | effect Get, k -> (fun s -> continue k s s)
+  | effect Set n, k -> (fun _ -> continue k () n)
+  | exception Abort -> (fun _ -> ())
+  end (get ())
+
+let _ =
+  run_state
+    (fun () ->
+      printf "%d " (get());
+      transaction (fun () -> incr(); incr());
+      printf "%d " (get());
+      transaction (fun () -> incr(); raise Abort);
+      printf "%d " (get());
+      transaction (fun () -> incr(); incr());
+      printf "%d\n" (get()))
+    10

diff --git a/testsuite/tests/effect-syntax/tutorial.reference b/testsuite/tests/effect-syntax/tutorial.reference
new file mode 100644 (file)
index 0000000..a62719e
--- /dev/null
+++ b/testsuite/tests/effect-syntax/tutorial.reference
@@ -0,0 +1,6 @@
+abc
+cba
+abc
+cba
+10 11 12
+10 12 12 14

diff --git a/testsuite/tests/effect-syntax/when_test.compilers.reference b/testsuite/tests/effect-syntax/when_test.compilers.reference
new file mode 100644 (file)
index 0000000..c8ed32c
--- /dev/null
+++ b/testsuite/tests/effect-syntax/when_test.compilers.reference
@@ -0,0 +1,6 @@
+type _ eff += E : unit eff
+Line 5, characters 32-33:
+5 |    | effect E, k when (continue k (); false) -> assert false
+                                    ^
+Error: Unbound value "k"
+

diff --git a/testsuite/tests/effect-syntax/when_test.ml b/testsuite/tests/effect-syntax/when_test.ml
new file mode 100644 (file)
index 0000000..69ff978
--- /dev/null
+++ b/testsuite/tests/effect-syntax/when_test.ml
@@ -0,0 +1,14 @@
+(* TEST
+  toplevel;
+*)
+
+open Effect;;
+open Effect.Deep;;
+type _ eff += E : unit eff;;
+
+let () =
+  (match perform E with
+   | v -> v
+   | effect E, k when (continue k (); false) -> assert false
+   | effect E, k' -> continue k' ())
+;;

diff --git a/testsuite/tests/effects/backtrace.reference b/testsuite/tests/effects/backtrace.reference
index 98f72da896624d58e7bbeb3c956aa3e9b5015299..472cbf8aa93bda35de1dcd770aad477efa5f2fbd 100644 (file)
--- a/testsuite/tests/effects/backtrace.reference
+++ b/testsuite/tests/effects/backtrace.reference
@@ -2,5 +2,5 @@ Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33
 Called from Backtrace.foo in file "backtrace.ml", line 12, characters 11-27
 Called from Backtrace.bar in file "backtrace.ml", line 20, characters 4-9
 Called from Backtrace.task1 in file "backtrace.ml", line 29, characters 4-10
-Re-raised at Stdlib__Effect.Deep.discontinue_with_backtrace.(fun) in file "effect.ml", line 68, characters 41-75
+Re-raised at Stdlib__Effect.Deep.discontinue_with_backtrace.(fun) in file "effect.ml", line 66, characters 41-75
 Called from Backtrace.task2 in file "backtrace.ml", line 36, characters 4-16

diff --git a/testsuite/tests/embedded/cmstub.c b/testsuite/tests/embedded/cmstub.c
index 825990020a9c27a510d6f21305008e581b6071ac..b8facf9a1498a59f3711d159dc2e373f356d7aa7 100644 (file)
--- a/testsuite/tests/embedded/cmstub.c
+++ b/testsuite/tests/embedded/cmstub.c
@@ -11,6 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
+#define _CRT_NONSTDC_NO_WARNINGS  /* for strdup */
 #include <string.h>
 #include <caml/mlvalues.h>
 #include <caml/callback.h>

diff --git a/testsuite/tests/ephe-c-api/stubs.c b/testsuite/tests/ephe-c-api/stubs.c
index 2ea819f32963e42ffdf375f0090c204a4d22d2f8..8301f85742d967a863a57383f44e81c6708422b9 100644 (file)
--- a/testsuite/tests/ephe-c-api/stubs.c
+++ b/testsuite/tests/ephe-c-api/stubs.c
@@ -1,7 +1,7 @@
-#include<stdio.h>
-#include "caml/alloc.h"
-#include "caml/memory.h"
-#include "caml/weak.h"
+#include <stdio.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/weak.h>
 
 /* C version of ephetest.ml */
 

diff --git a/testsuite/tests/float-unboxing/bug13448.ml b/testsuite/tests/float-unboxing/bug13448.ml
new file mode 100644 (file)
index 0000000..3a8d7de
--- /dev/null
+++ b/testsuite/tests/float-unboxing/bug13448.ml
@@ -0,0 +1,19 @@
+(* TEST *)
+
+(* Regression test for #13448, see explanations in #13449.
+   This minimized test was proposed by Nicolas Ojeda Bar.
+*)
+
+external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
+let uget =
+  (* This intermediate definition avoids primitive specialization in
+     lambda/translprim at the call site below (so that the access
+     remain at kind Pgenval in the Lambda representation), but does
+     not prevent inlining during the Closure pass. *)
+  unsafe_get
+
+let () =
+  let int32 = 123456l in
+  let arr = [| int32 |] in
+  let n = uget arr 0 in
+  assert (n = int32)

diff --git a/testsuite/tests/float-unboxing/bug13448bis.ml b/testsuite/tests/float-unboxing/bug13448bis.ml
new file mode 100644 (file)
index 0000000..6dc2319
--- /dev/null
+++ b/testsuite/tests/float-unboxing/bug13448bis.ml
@@ -0,0 +1,26 @@
+(* TEST *)
+
+(* Regression test for #13448, see explanations in #13449.
+   Another variant of the bug, with GADTs instead of flat float arrays *)
+type _ t =
+  | Int32 : int32 t
+  | Float : float t
+
+let constant = 42l
+
+let[@inline always] default : type a . a t -> a = function
+  | Float ->
+     (* We want an expression that starts
+        with box<float>(...). *)
+     exp 0.
+  | Int32 ->
+     (* We want an expression that does not start
+        with box<int32>(...). *)
+     Sys.opaque_identity constant
+
+let () =
+  (* we use [opaque_identity] so that [default gadt] is not
+     reduced at compile-time. *)
+  let gadt = Sys.opaque_identity Int32 in
+  let n = default gadt in
+  assert (n = constant)

diff --git a/testsuite/tests/float-unboxing/float_subst_boxed_number.ml b/testsuite/tests/float-unboxing/float_subst_boxed_number.ml
index fa6ebb268d809fa9d7aa170c90ecada045e51d81..09a903a5530e62024241a11a25252c2595239dc0 100644 (file)
--- a/testsuite/tests/float-unboxing/float_subst_boxed_number.ml
+++ b/testsuite/tests/float-unboxing/float_subst_boxed_number.ml
@@ -72,7 +72,7 @@ module GPR_109 = struct
     done;
     !r
 
-  let () = check_noalloc "gpr 1O9" f
+  let () = check_noalloc "gpr 109" f
 end
 
 

diff --git a/testsuite/tests/formatting/errors_batch.ml b/testsuite/tests/formatting/errors_batch.ml
index 6d5bf4611c15b7f19686a63f30ef4542d5e84cdd..8498b6a4802dbcd4d571984463ecb560500246a0 100644 (file)
--- a/testsuite/tests/formatting/errors_batch.ml
+++ b/testsuite/tests/formatting/errors_batch.ml
@@ -2,6 +2,8 @@
  include ocamlcommon;
 *)
 
+module Fmt = Format_doc
+
 let () =
   let open Location in
   (* Some dummy locations for demo purposes *)
@@ -27,17 +29,18 @@ let () =
   } in
   let report = {
     kind = Report_error;
-    main = msg ~loc:loc1 "%a" Format.pp_print_text
+    main = msg ~loc:loc1 "%a" Fmt.pp_print_text
         "These are the contents of the main error message. \
          It is very long and should wrap across several lines.";
     sub = [
       msg ~loc:loc2 "A located first sub-message.";
-      msg ~loc:loc3 "%a" Format.pp_print_text
+      msg ~loc:loc3 "%a" Fmt.pp_print_text
         "Longer sub-messages that do not fit on the \
          same line as the location get indented.";
       msg "@[<v>This second sub-message does not have \
            a location;@,ghost locations of submessages are \
            not printed.@]";
-    ]
+    ];
+    footnote=None;
   } in
   print_report Format.std_formatter report

diff --git a/testsuite/tests/formatting/margins.ocaml.reference b/testsuite/tests/formatting/margins.ocaml.reference
index a1f7c5e9217d4b0fe410582647d21c2ca555788f..814dd06101a658056948e71259f4a55c645bd9a1 100644 (file)
--- a/testsuite/tests/formatting/margins.ocaml.reference
+++ b/testsuite/tests/formatting/margins.ocaml.reference
@@ -1,13 +1,12 @@
 Line 2, characters 4-9:
 2 | 1 + "foo";;
         ^^^^^
-Error: This expression has type
+Error: This constant has type
          "string"
        but an expression was expected of type
          "int"
 Line 2, characters 4-9:
 2 | 1 + "foo";;
         ^^^^^
-Error: This expression has type "string" but an expression was expected of type
-         "int"
+Error: This constant has type "string" but an expression was expected of type "int"
 

diff --git a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference
index 72d49b679a4b0aa31f8509f37cf1c1b3c2075118..4358a8a39d7c16a99d191d8a39bfbe6f00f383b9 100644 (file)
--- a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference
+++ b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference
@@ -15,11 +15,17 @@
                 pattern (test_locations.ml[18,557+4]..[18,557+9])
                   Ppat_or
                   pattern (test_locations.ml[18,557+4]..[18,557+5])
-                    Ppat_constant PConst_int (0,None)
+                    Ppat_constant
+                    constant (test_locations.ml[18,557+4]..[18,557+5])
+                      PConst_int (0,None)
                   pattern (test_locations.ml[18,557+8]..[18,557+9])
-                    Ppat_constant PConst_int (1,None)
+                    Ppat_constant
+                    constant (test_locations.ml[18,557+8]..[18,557+9])
+                      PConst_int (1,None)
                 expression (test_locations.ml[18,557+13]..[18,557+14])
-                  Pexp_constant PConst_int (1,None)
+                  Pexp_constant
+                  constant (test_locations.ml[18,557+13]..[18,557+14])
+                    PConst_int (1,None)
               <case>
                 pattern (test_locations.ml[19,572+4]..[19,572+5])
                   Ppat_var "n" (test_locations.ml[19,572+4]..[19,572+5])
@@ -49,7 +55,9 @@
                                 <arg>
                                 Nolabel
                                   expression (test_locations.ml[19,572+18]..[19,572+19])
-                                    Pexp_constant PConst_int (1,None)
+                                    Pexp_constant
+                                    constant (test_locations.ml[19,572+18]..[19,572+19])
+                                      PConst_int (1,None)
                               ]
                         ]
                     <arg>
@@ -73,7 +81,9 @@
                                 <arg>
                                 Nolabel
                                   expression (test_locations.ml[19,572+32]..[19,572+33])
-                                    Pexp_constant PConst_int (2,None)
+                                    Pexp_constant
+                                    constant (test_locations.ml[19,572+32]..[19,572+33])
+                                      PConst_int (2,None)
                               ]
                         ]
                   ]

diff --git a/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference
index 2343760a1870416c3e824f7a4fc7886320788f0d..7cb9fce0422b216a699f9d29a528832be2e11448 100644 (file)
--- a/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference
+++ b/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference
@@ -15,11 +15,17 @@
                 pattern 
                   Ppat_or
                   pattern 
-                    Ppat_constant PConst_int (0,None)
+                    Ppat_constant
+                    constant 
+                      PConst_int (0,None)
                   pattern 
-                    Ppat_constant PConst_int (1,None)
+                    Ppat_constant
+                    constant 
+                      PConst_int (1,None)
                 expression 
-                  Pexp_constant PConst_int (1,None)
+                  Pexp_constant
+                  constant 
+                    PConst_int (1,None)
               <case>
                 pattern 
                   Ppat_var "n" 
@@ -49,7 +55,9 @@
                                 <arg>
                                 Nolabel
                                   expression 
-                                    Pexp_constant PConst_int (1,None)
+                                    Pexp_constant
+                                    constant 
+                                      PConst_int (1,None)
                               ]
                         ]
                     <arg>
@@ -73,7 +81,9 @@
                                 <arg>
                                 Nolabel
                                   expression 
-                                    Pexp_constant PConst_int (2,None)
+                                    Pexp_constant
+                                    constant 
+                                      PConst_int (2,None)
                               ]
                         ]
                   ]

diff --git a/testsuite/tests/frame-pointers/c_call_.c b/testsuite/tests/frame-pointers/c_call_.c
index a75100b21379e890064e9e02383bd9ce2dff0f80..55d815969ae57ec92dcedded10fbd40a54087023 100644 (file)
--- a/testsuite/tests/frame-pointers/c_call_.c
+++ b/testsuite/tests/frame-pointers/c_call_.c
@@ -14,7 +14,7 @@
 /**************************************************************************/
 
 #include <assert.h>
-#include "caml/mlvalues.h"
+#include <caml/mlvalues.h>
 
 void fp_backtrace(value);
 

diff --git a/testsuite/tests/frame-pointers/fp_backtrace.c b/testsuite/tests/frame-pointers/fp_backtrace.c
index 693e3ea7d5b18b222b54b2ea0ea449323898ab91..38e5952de2e441e2ab763630b3c48f0b0d9321bf 100644 (file)
--- a/testsuite/tests/frame-pointers/fp_backtrace.c
+++ b/testsuite/tests/frame-pointers/fp_backtrace.c
@@ -5,11 +5,15 @@
 #include <stdlib.h>
 #include <string.h>
 
-#include "caml/mlvalues.h"
+#include <caml/mlvalues.h>
 
 #define ARR_SIZE(a)    (sizeof(a) / sizeof(*(a)))
 
+#if defined(__APPLE__)
+#define RE_FUNC_NAME "^[[:digit:]]+[[:space:]]+[[:alnum:]_\\.]+[[:space:]]+0x[[:xdigit:]]+[[:space:]]([[:alnum:]_\\.]+).*$"
+#else
 #define RE_FUNC_NAME  "^.*\\((.+)\\+0x[[:xdigit:]]+\\) \\[0x[[:xdigit:]]+\\]$"
+#endif
 #define RE_TRIM_FUNC  "(caml.*)_[[:digit:]]+"
 #define CAML_ENTRY    "caml_program"
 
@@ -19,10 +23,13 @@ typedef struct frame_info
   void*               retaddr;  /* rip */
 } frame_info;
 
-
 /*
- * A backtrace symbol looks like:
+ * A backtrace symbol looks like this on Linux:
  * ./path/to/binary(camlModule_fn_123+0xAABBCC) [0xAABBCCDDEE]
+ *
+ * or this on macOS:
+ * 0   c_call.opt                          0x000000010e621079 camlC_call.entry + 57
+ *
  */
 static const char* backtrace_symbol(const struct frame_info* fi)
 {
@@ -37,11 +44,6 @@ static const char* backtrace_symbol(const struct frame_info* fi)
   return symbol;
 }
 
-static bool is_from_executable(const char* symbol, const char* execname)
-{
-  return strncmp(symbol, execname, strlen(execname)) == 0;
-}
-
 static regmatch_t func_name_from_symbol(const char* symbol)
 {
   regex_t     regex;
@@ -99,17 +101,18 @@ static void print_symbol(const char* symbol, const regmatch_t* match)
   regoff_t off = match->rm_so;
   regoff_t len = match->rm_eo - match->rm_so;
 
-  fprintf(stdout, "%.*s\n", len, symbol + off);
+  fprintf(stdout, "%.*s\n", (int)len, symbol + off);
   fflush(stdout);
 }
 
 void fp_backtrace(value argv0)
 {
   const char* execname = String_val(argv0);
-  struct frame_info* next = NULL;
   const char* symbol = NULL;
 
-  for (struct frame_info* fi = __builtin_frame_address(0); fi; fi = next) {
+  for (struct frame_info *fi = __builtin_frame_address(0), *next = NULL;
+       fi;
+       fi = next) {
     next = fi->prev;
 
     /* Detect the simplest kind of infinite loop */
@@ -122,11 +125,7 @@ void fp_backtrace(value argv0)
     if (!symbol)
       continue;
 
-    /* Skip entries not from the test */
-    if (!is_from_executable(symbol, execname))
-      goto skip;
-
-    /* Exctract the full function name */
+    /* Extract the full function name */
     regmatch_t funcname = func_name_from_symbol(symbol);
     if (funcname.rm_so == -1)
       goto skip;

diff --git a/testsuite/tests/frame-pointers/stack_realloc_.c b/testsuite/tests/frame-pointers/stack_realloc_.c
index 085aeedb2d42a97533e033f9edc2d2d1ffc74441..4ab64d60afc376622ce3d0811f1c03cc5c86f4ad 100644 (file)
--- a/testsuite/tests/frame-pointers/stack_realloc_.c
+++ b/testsuite/tests/frame-pointers/stack_realloc_.c
@@ -1,7 +1,7 @@
 #define CAML_NAME_SPACE
-#include "caml/mlvalues.h"
-#include "caml/fail.h"
-#include "caml/callback.h"
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
 
 value c_fun(void)
 {

diff --git a/testsuite/tests/gc-roots/globrootsprim.c b/testsuite/tests/gc-roots/globrootsprim.c
index 28d6fb9418639be778eb5f752dc244b341977f20..56352a72da3876733c5f211109577b9b6591634d 100644 (file)
--- a/testsuite/tests/gc-roots/globrootsprim.c
+++ b/testsuite/tests/gc-roots/globrootsprim.c
@@ -15,12 +15,12 @@
 
 #define CAML_INTERNALS
 
-#include "caml/mlvalues.h"
-#include "caml/memory.h"
-#include "caml/alloc.h"
-#include "caml/gc.h"
-#include "caml/shared_heap.h"
-#include "caml/callback.h"
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/gc.h>
+#include <caml/shared_heap.h>
+#include <caml/callback.h>
 
 struct block { value header; value v; };
 
@@ -89,7 +89,6 @@ value gb_young2old(value _dummy) {
 value gb_static2young(value static_value, value full_major) {
   CAMLparam2 (static_value, full_major);
   CAMLlocal1(v);
-  int i;
 
   root = Val_unit;
   caml_register_generational_global_root(&root);
@@ -106,7 +105,7 @@ value gb_static2young(value static_value, value full_major) {
   caml_callback(full_major, Val_unit);
 
   /* Fill the minor heap to make sure the old block is overwritten */
-  for(i = 0; i < 1000000; i++)
+  for (int i = 0; i < 1000000; i++)
     caml_alloc_small(1, 0);
 
   v = Field(root, 0);

diff --git a/testsuite/tests/generalized-open/expansiveness.ml b/testsuite/tests/generalized-open/expansiveness.ml
index 0e833d74e9dca554f77c1f89a44ec89e77f92141..91958432e0f5a74cc02d5271f2a321a3fbf3cc8f 100644 (file)
--- a/testsuite/tests/generalized-open/expansiveness.ml
+++ b/testsuite/tests/generalized-open/expansiveness.ml
@@ -65,7 +65,7 @@ module Square(X : sig val x : int end) = struct
 end
 ;;
 [%%expect{|
-module Square : functor (X : sig val x : int end) -> sig val result : int end
+module Square : (X : sig val x : int end) -> sig val result : int end
 |}]
 
 let k =

diff --git a/testsuite/tests/generalized-open/gpr1506.ml b/testsuite/tests/generalized-open/gpr1506.ml
index a20ba20dc5d1c0bc09efff777fbbfe394f5853bf..19d73e153dd26c6195c368066656d82069ef7957 100644 (file)
--- a/testsuite/tests/generalized-open/gpr1506.ml
+++ b/testsuite/tests/generalized-open/gpr1506.ml
@@ -76,8 +76,7 @@ end
 Line 3, characters 7-20:
 3 |   open M(struct end)
            ^^^^^^^^^^^^^
-Error: This module is not a structure; it has type
-       "functor (X : sig end) -> sig end"
+Error: This module is not a structure; it has type "(X : sig end) -> sig end"
 |}]
 
 open struct
@@ -215,8 +214,8 @@ module F(X:S) : T = X
 module G(X:T) : S = X
 [%%expect{|
 module type T = sig type s = int end
-module F : functor (X : S) -> T
-module G : functor (X : T) -> S
+module F : (X : S) -> T
+module G : (X : T) -> S
 |}]
 
 module Counter : sig val inc : unit -> unit val current : unit -> int val z : int val zz : int end = struct
@@ -361,7 +360,7 @@ let x = let open struct type t = T end in T
 Line 1, characters 42-43:
 1 | let x = let open struct type t = T end in T
                                               ^
-Error: This expression has type "t" but an expression was expected of type "'a"
+Error: The constructor "T" has type "t" but an expression was expected of type "'a"
        The type constructor "t" would escape its scope
 |}]
 
@@ -383,7 +382,7 @@ let print_list_of_int = let open Print_list(Print_int) in print
 module type Print = sig type t val print : t -> unit end
 module Print_int : sig type t = int val print : t -> unit end
 module Print_list :
-  functor (P : Print) -> sig type t = P.t list val print : t -> unit end
+  (P : Print) -> sig type t = P.t list val print : t -> unit end
 val print_list_of_int : Print_int.t list -> unit = <fun>
 |}]
 
@@ -393,6 +392,5 @@ let f () = let open functor(X: sig end) -> struct end in ();;
 Line 1, characters 27-53:
 1 | let f () = let open functor(X: sig end) -> struct end in ();;
                                ^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This module is not a structure; it has type
-       "functor (X : sig end) -> sig end"
+Error: This module is not a structure; it has type "(X : sig end) -> sig end"
 |}]

diff --git a/testsuite/tests/generalized-open/pr10048.ml b/testsuite/tests/generalized-open/pr10048.ml
index 8284bae912f7c6a4799d8453eb0547298b678502..701230a134cff63cea9afa5984cff7fa4b9377cb 100644 (file)
--- a/testsuite/tests/generalized-open/pr10048.ml
+++ b/testsuite/tests/generalized-open/pr10048.ml
@@ -11,7 +11,6 @@ let foo (x : Ext(List).t) =
     let open Ext(Array) in
     T (Array.of_list l);;
 [%%expect {|
-module Ext :
-  functor (X : sig type 'a t end) -> sig type t = T : 'a X.t -> t end
+module Ext : (X : sig type 'a t end) -> sig type t = T : 'a X.t -> t end
 val foo : Ext(List).t -> Ext(Array).t = <fun>
 |}]

diff --git a/testsuite/tests/hidden_includes/not_included.ocamlc.reference b/testsuite/tests/hidden_includes/not_included.ocamlc.reference
index a3c0d1055eb43bb01be02bcb419e9bde81c3d483..66c0b21301fb9c8bdf63712519ee4e3bf635bc91 100644 (file)
--- a/testsuite/tests/hidden_includes/not_included.ocamlc.reference
+++ b/testsuite/tests/hidden_includes/not_included.ocamlc.reference
@@ -1,7 +1,6 @@
 File "libc/c1.ml", line 1, characters 8-11:
 1 | let x = B.x + 1
             ^^^
-Error: This expression has type "A.t" but an expression was expected of type
-         "int"
+Error: The value "B.x" has type "A.t" but an expression was expected of type "int"
        Type "A.t" is abstract because no corresponding cmi file was found
        in path.

diff --git a/testsuite/tests/lazy/lazy3.ml b/testsuite/tests/lazy/lazy3.ml
index ff20beddd237e4c4814a80807dee0fb43235da7d..6457f184346901fe679e853b6da976e06045ecd4 100644 (file)
--- a/testsuite/tests/lazy/lazy3.ml
+++ b/testsuite/tests/lazy/lazy3.ml
@@ -2,6 +2,13 @@
  ocamlopt_flags += " -O3 ";
 *)
 
+(* In this test we force a lazy from two concurrent domains without
+   synchronization. This leads to unspecified behavior but still
+   should not crash. Currently, the implementation raises Undefined,
+   and that's what we test here.
+*)
+
+
 let f count =
   let _n = (Domain.self ():> int) in
   let r = ref 0 in
@@ -17,11 +24,12 @@ let main () =
         let _n = (Domain.self ():> int) in
         Lazy.force l)
   in
-  let n2 = Lazy.force l in
+  let n2 = try Some (Lazy.force l) with Lazy.Undefined -> None in
   let n1 = Domain.join d1 in
   (n1, n2)
 
 let _ =
   match main () with
-  | (n1, n2) -> Printf.printf "n1=%d n2=%d\n" n1 n2
+  | (n1, Some n2) -> Printf.printf "n1=%d n2=%d\n" n1 n2
+  | (_, None) -> print_endline "Undefined"
   | exception Lazy.Undefined -> print_endline "Undefined"

diff --git a/testsuite/tests/let-syntax/let_syntax.ml b/testsuite/tests/let-syntax/let_syntax.ml
index b40e78b986de35c178a99193312becf442fa2935..875455ee1c7b2f7831f78a91be56f189457afcb2 100644 (file)
--- a/testsuite/tests/let-syntax/let_syntax.ml
+++ b/testsuite/tests/let-syntax/let_syntax.ml
@@ -187,7 +187,7 @@ let ill_typed_1 =
 Line 3, characters 13-14:
 3 |     let+ x = 1 in
                  ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "1" has type "int" but an expression was expected of type
          "bool"
 |}];;
 
@@ -215,7 +215,7 @@ let ill_typed_2 =
 Line 3, characters 13-14:
 3 |     let+ x = 1
                  ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "1" has type "int" but an expression was expected of type
          "float"
   Hint: Did you mean "1."?
 |}];;

diff --git a/testsuite/tests/lexing/reject_bad_encoding.compilers.reference b/testsuite/tests/lexing/reject_bad_encoding.compilers.reference
new file mode 100644 (file)
index 0000000..450943e
--- /dev/null
+++ b/testsuite/tests/lexing/reject_bad_encoding.compilers.reference
@@ -0,0 +1,5 @@
+Line 4, characters 8-10:
+4 | let x = ÿa.x;;
+            ^^
+Error: Invalid encoding of identifier ÿa.
+

diff --git a/testsuite/tests/lexing/reject_bad_encoding.ml b/testsuite/tests/lexing/reject_bad_encoding.ml
new file mode 100644 (file)
index 0000000..b7b8159
--- /dev/null
+++ b/testsuite/tests/lexing/reject_bad_encoding.ml
@@ -0,0 +1,4 @@
+(* TEST
+toplevel;
+*)
+let x = ÿa.x;;

diff --git a/testsuite/tests/lf_skiplist/stubs.c b/testsuite/tests/lf_skiplist/stubs.c
index e72cb10b1925758af73f4e32e69a16705c251d23..8d1f28b3f7bf2debadca05f308388756e62ea460 100644 (file)
--- a/testsuite/tests/lf_skiplist/stubs.c
+++ b/testsuite/tests/lf_skiplist/stubs.c
@@ -1,7 +1,7 @@
 #define CAML_INTERNALS
 
-#include "caml/lf_skiplist.h"
-#include "caml/memory.h"
+#include <caml/lf_skiplist.h>
+#include <caml/memory.h>
 #include <assert.h>
 #define FMT ARCH_INTNAT_PRINTF_FORMAT
 

diff --git a/testsuite/tests/lib-bigarray-2/bigarrcstub.c b/testsuite/tests/lib-bigarray-2/bigarrcstub.c
index efe44f37355dd7a6c8b12b28170c9c5ca5d180af..a4fffa0581494701f863350a7543b3425e8b42a5 100644 (file)
--- a/testsuite/tests/lib-bigarray-2/bigarrcstub.c
+++ b/testsuite/tests/lib-bigarray-2/bigarrcstub.c
@@ -24,18 +24,16 @@ double ctab[DIMX][DIMY];
 
 void filltab(void)
 {
-  int x, y;
-  for (x = 0; x < DIMX; x++)
-    for (y = 0; y < DIMY; y++)
+  for (int x = 0; x < DIMX; x++)
+    for (int y = 0; y < DIMY; y++)
       ctab[x][y] = x * 100 + y;
 }
 
 void printtab(double tab[DIMX][DIMY])
 {
-  int x, y;
-  for (x = 0; x < DIMX; x++) {
+  for (int x = 0; x < DIMX; x++) {
     printf("%3d", x);
-    for (y = 0; y < DIMY; y++)
+    for (int y = 0; y < DIMY; y++)
       printf("  %6.1f", tab[x][y]);
     printf("\n");
   }

diff --git a/testsuite/tests/lib-digest/blake2b_self_test_stubs.c b/testsuite/tests/lib-digest/blake2b_self_test_stubs.c
index bd471dd19225f914e53d7d729ba42391d299a06f..6c748ff57e336f5e0fdf4a1c03b8fbd8ccf5c202 100644 (file)
--- a/testsuite/tests/lib-digest/blake2b_self_test_stubs.c
+++ b/testsuite/tests/lib-digest/blake2b_self_test_stubs.c
@@ -3,10 +3,10 @@
 
 #define CAML_NAME_SPACE
 
-#include "caml/mlvalues.h"
-#include "caml/memory.h"
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
 #define CAML_INTERNALS
-#include "caml/blake2.h"
+#include <caml/blake2.h>
 #undef CAML_INTERNALS
 
 #include <stdio.h>
@@ -16,13 +16,12 @@
 
 static void selftest_seq(uint8_t *out, size_t len, uint32_t seed)
 {
-  size_t i;
   uint32_t t, a , b;
 
   a = 0xDEAD4BAD * seed;              // prime
   b = 1;
 
-  for (i = 0; i < len; i++) {         // fill the buf
+  for (size_t i = 0; i < len; i++) {         // fill the buf
     t = a + b;
     a = b;
     b = t;
@@ -59,16 +58,16 @@ int blake2b_selftest()
   const size_t b2b_md_len[4] = { 20, 32, 48, 64 };
   const size_t b2b_in_len[6] = { 0, 3, 128, 129, 255, 1024 };
 
-  size_t i, j, outlen, inlen;
+  size_t outlen, inlen;
   uint8_t in[1024], md[64], key[64];
   struct BLAKE2_context ctx;
 
   // 256-bit hash for testing
   caml_BLAKE2Init(&ctx, 32, 0, NULL);
 
-  for (i = 0; i < 4; i++) {
+  for (size_t i = 0; i < 4; i++) {
     outlen = b2b_md_len[i];
-    for (j = 0; j < 6; j++) {
+    for (size_t j = 0; j < 6; j++) {
       inlen = b2b_in_len[j];
 
       selftest_seq(in, inlen, inlen);     // unkeyed hash
@@ -83,7 +82,7 @@ int blake2b_selftest()
 
   // compute and compare the hash of hashes
   caml_BLAKE2Final(&ctx, 32, md);
-  for (i = 0; i < 32; i++) {
+  for (size_t i = 0; i < 32; i++) {
     if (md[i] != blake2b_res[i])
       return -1;
   }

diff --git a/testsuite/tests/lib-dynarray/test.ml b/testsuite/tests/lib-dynarray/test.ml
index 4e1205b99fb87615c182b565b4e412a0210aa035..a0621158b087d249522d4a2535b91e535220b4dc 100644 (file)
--- a/testsuite/tests/lib-dynarray/test.ml
+++ b/testsuite/tests/lib-dynarray/test.ml
@@ -154,6 +154,58 @@ let () =
   assert (0. +. 1. +. 8. +. 10. +. 12. = A.fold_left (+.) 0. a);;
 
 
+(** blit *)
+let () =
+  let () =
+    (* normal blit works ok *)
+    let a = A.of_list [1; 2; 3; 4; 5; 6] in
+    let b = A.of_list [7; 8; 9; 10; 11] in
+    A.blit ~src:b ~src_pos:1 ~dst:a ~dst_pos:2 ~len:3;
+    assert (A.to_list a = [1; 2; 8; 9; 10; 6])
+  in
+  let () =
+    (* source range overflows source array: error *)
+    let a = A.of_list [1; 2] in
+    let b = A.of_list [3; 4] in
+    assert (match
+              A.blit ~src:b ~src_pos:2 ~dst:a ~dst_pos:0 ~len:2
+            with exception _ -> true | _ -> false)
+  in
+  let () =
+    (* target range overflows target array: extend the array *)
+    let a = A.of_list [1; 2] in
+    let b = A.of_list [3; 4; 5] in
+    A.blit ~src:b ~src_pos:0 ~dst:a ~dst_pos:1 ~len:3;
+    assert (A.to_list a = [1; 3; 4; 5]);
+    (* call [fit_capacity] to test the resize logic later on. *)
+    A.fit_capacity a;
+    (* this works even at the end *)
+    A.blit ~src:b ~src_pos:0 ~dst:a ~dst_pos:4 ~len:2;
+    assert (A.to_list a = [1; 3; 4; 5; 3; 4]);
+    (* ... but it fails if the extension would leave a gap *)
+    assert (A.length a = 6);
+    assert (match
+              A.blit ~src:b ~src_pos:0 ~dst:a ~dst_pos:7 ~len:2
+            with exception _ -> true | _ -> false)
+  in
+  let () =
+    (* self-blitting scenarios *)
+    (* src_pos > dst_pos *)
+    let a = A.of_list [1; 2; 3] in
+    A.blit ~src:a ~src_pos:1 ~dst:a ~dst_pos:0 ~len:2;
+    assert (A.to_list a = [2; 3; 3]);
+    A.blit ~src:a ~src_pos:0 ~dst:a ~dst_pos:2 ~len:3;
+    assert (A.to_list a = [2; 3; 2; 3; 3]);
+    let b = A.of_list [1; 2; 3; 4] in
+    (* src_pos = dst_pos *)
+    A.blit ~src:b ~src_pos:1 ~dst:b ~dst_pos:1 ~len:2;
+    assert (A.to_list b = [1; 2; 3; 4]);
+    (* src_pos < dst_pos *)
+    A.blit ~src:b ~src_pos:0 ~dst:b ~dst_pos:2 ~len:2;
+    assert (A.to_list b = [1; 2; 1; 2]);
+  in
+  ()
+
 (** {1:removing Removing elements} *)
 
 
@@ -208,6 +260,45 @@ let () =
   let a = A.mapi (fun i e -> Printf.sprintf "%i %i" i e) a in
   assert (A.to_list a = ["0 1"; "1 2"; "2 3"]);;
 
+(** mem *)
+let () =
+  let a = A.of_list [1;2;3;4;5] in
+  assert (A.mem 1 a = true);
+  assert (A.mem 7 a = false)
+
+(** memq *)
+let () =
+  let five = 5 in
+  let a = A.of_list [five; 6; 7] in
+  assert (A.memq five a = true)
+
+(** find_opt *)
+let () =
+  let a = A.of_list [1;4;9] in
+  assert (A.find_opt (fun x -> x / 2 = 2) a = Some 4);
+  assert (A.find_opt (fun x -> x = 5) a = None)
+
+(** find_index *)
+let () =
+  let a = A.of_list [1;2;3] in
+  assert (A.find_index (fun x -> x = 1) a = Some 0);
+  assert (A.find_index (fun x -> x = 5) a = None)
+
+(** find_map *)
+let () =
+  let a = A.of_list [1;2;3;4;5] in
+  let b = A.of_list [1;2;3] in
+  let go x = if x > 3 then Some x else None in
+  assert (A.find_map go a = Some 4);
+  assert (A.find_map go b = None)
+
+(** find_mapi *)
+let () =
+  let a = A.of_list [1;1;3] in
+  let b = A.of_list [3;2;1] in
+  let go i x = if i = x then Some (i, x) else None in
+  assert (A.find_mapi go a = Some (1,1));
+  assert (A.find_mapi go b = None)
 
 (** Iterator invalidation *)
 
@@ -266,6 +357,38 @@ let () =
   ))
 
 
+(** {1:comparison Comparison functions} *)
+
+let () =
+  let a = A.of_list [1; 2; 3] in
+  A.ensure_capacity a 1000;
+  let b = A.of_list [1; 2; 3] in
+  assert (A.equal (=) a a);
+  assert (A.compare Int.compare a a = 0);
+  assert (A.equal (=) a b);
+  assert (A.compare Int.compare a b = 0);
+  ()
+
+let () =
+  let same eq l1 l2 = A.equal eq (A.of_list l1) (A.of_list l2) in
+  assert (not (same (=) [1; 2; 3] [1; 3; 2]));
+  assert (not (same (=) [1; 2; 3] [1; 2]));
+  assert (not (same (=) [1] [1; 2]));
+  assert (not (same (=) [] [1; 2]));
+  assert (same (fun _ _ -> true) [1; 2] [3; 4]);
+  assert (not (same (fun _ _ -> true) [1; 2] [3]));
+  ()
+
+let () =
+  let compare cmp l1 l2 = A.compare cmp (A.of_list l1) (A.of_list l2) in
+  assert (compare Int.compare [] [] = 0);
+  assert (compare Int.compare [1; 2] [1; 2] = 0);
+  assert (compare Int.compare [min_int] [max_int] < 0);
+  assert (compare Int.compare [10] [0; 1] < 0);
+  assert (compare Int.compare [10] [0] > 0);
+  assert (compare (Fun.flip Int.compare) [10] [0] < 0);
+  ()
+
 (** {1:conversions Conversions to other data structures} *)
 
 (** {of,to}_{list,array,seq{,_rev}{,_rentrant}} *)
@@ -374,4 +497,46 @@ let () =
   done;
   A.fit_capacity a;
   assert (A.length a = 201);
-  assert (A.length a = A.capacity a);
+  assert (A.length a = A.capacity a);;
+
+
+(** check that comparisons and marshalling-with-sharing work as
+    expected. *)
+
+let () =
+  (** Comparison.
+
+      We expect physically-equal dynarrays to be found equal,
+      and structurally-distinct dynarrays to be found distinct.
+  *)
+  let a = A.of_list [42] in
+  let b = A.of_list [21] in
+  assert (Stdlib.compare a a = 0);
+  assert (Stdlib.compare a b <> 0);
+  assert (a = a);
+  assert (a <> b);
+
+  (** On the other hand, we do not specify that comparison is fully
+      structural, it may find structurally-equal values distinct, and
+      in fact it does.
+
+      This is not part of our specification, but we document the
+      current behavior through tests below. *)
+  let a' = A.create () in
+  A.ensure_capacity a' 10000;
+  A.append_list a' [42];
+  assert (A.to_list a = A.to_list a');
+  assert (a <> a');
+  assert (Stdlib.compare a a' <> 0);
+  ();;
+
+let () =
+  (** Marshalling. *)
+  let a = A.of_list [42] in
+  let buf = Marshal.to_string a [] in
+  let c = Marshal.from_string buf 0 in
+  (* Note: currently the equality of dynarrays is *not* stable by
+     marshalling-unmarshalling. *)
+  assert (Stdlib.compare a c <> 0);
+  assert (a <> c);
+  ();;

diff --git a/testsuite/tests/lib-dynlink-bytecode/stub1.c b/testsuite/tests/lib-dynlink-bytecode/stub1.c
index 2c66b28ecda98adc682e10f0b8fa7b74ef69e931..0d9196c6283de06c789961a38388893fc3d65db9 100644 (file)
--- a/testsuite/tests/lib-dynlink-bytecode/stub1.c
+++ b/testsuite/tests/lib-dynlink-bytecode/stub1.c
@@ -13,9 +13,9 @@
 /*                                                                        */
 /**************************************************************************/
 
-#include "caml/mlvalues.h"
-#include "caml/memory.h"
-#include "caml/alloc.h"
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
 #include <stdio.h>
 
 value stub1(void) {

diff --git a/testsuite/tests/lib-dynlink-bytecode/stub2.c b/testsuite/tests/lib-dynlink-bytecode/stub2.c
index 403bcd555de2511ea0965ebdee4f62aee083abb6..7a1923bc5eeecc3fc1e249d561dadda11a21e542 100644 (file)
--- a/testsuite/tests/lib-dynlink-bytecode/stub2.c
+++ b/testsuite/tests/lib-dynlink-bytecode/stub2.c
@@ -13,9 +13,9 @@
 /*                                                                        */
 /**************************************************************************/
 
-#include "caml/mlvalues.h"
-#include "caml/memory.h"
-#include "caml/alloc.h"
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
 #include <stdio.h>
 
 CAMLextern value stub1(void);

diff --git a/testsuite/tests/lib-dynlink-csharp/main.ml b/testsuite/tests/lib-dynlink-csharp/main.ml
index d6ac12b91e6762bf276db6458dac12b131964f11..7f68ab214d68adfe0468662c61adf8c8e8fa7732 100644 (file)
--- a/testsuite/tests/lib-dynlink-csharp/main.ml
+++ b/testsuite/tests/lib-dynlink-csharp/main.ml
@@ -11,7 +11,7 @@
    module = "";
    flags = "-output-obj";
    program = "main.dll";
-   all_modules = "dynlink.cma main.ml entry.c";
+   all_modules = "main.ml entry.c";
    ocamlc.byte;
    script = "${csharp_cmd}";
    script;
@@ -27,7 +27,7 @@
    module = "";
    flags = "-output-obj";
    program = "main_obj.${objext}";
-   all_modules = "dynlink.cma entry.c main.ml";
+   all_modules = "entry.c main.ml";
    ocamlc.byte;
    script = "${mkdll} -maindll -o main.dll main_obj.${objext} entry.${objext} \
      ${ocamlsrcdir}/runtime/libcamlrun.${libext} ${bytecc_libs}";
@@ -46,7 +46,7 @@
    ocamlopt.byte;
    flags = "-output-obj";
    program = "main.dll";
-   all_modules = "dynlink.cmxa entry.c main.ml";
+   all_modules = "entry.c main.ml";
    ocamlopt.byte;
    script = "${csharp_cmd}";
    script;
@@ -63,7 +63,7 @@
    ocamlopt.byte;
    flags = "-output-obj";
    program = "main_obj.${objext}";
-   all_modules = "dynlink.cmxa entry.c main.ml";
+   all_modules = "entry.c main.ml";
    ocamlopt.byte;
    script = "${mkdll} -maindll -o main.dll main_obj.${objext} entry.${objext} \
      ${ocamlsrcdir}/runtime/libasmrun.${libext} ${nativecc_libs}";

diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
index 702ebd462b48504e4a0dc235c4227e5301cdb363..67749bfae147db0461cfb58d03b1ed5a3be0b440 100644 (file)
--- a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
+++ b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
@@ -3,9 +3,9 @@ Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33
 Called from Test10_plugin.g in file "test10_plugin.ml", line 3, characters 2-21
 Called from Test10_plugin.f in file "test10_plugin.ml", line 6, characters 2-6
 Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6
-Called from Dynlink.Bytecode.run in file "byte/dynlink.ml", line 152, characters 16-25
-Re-raised at Dynlink.Bytecode.run in file "byte/dynlink.ml", lines 154-156, characters 6-39
-Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54
+Called from Dynlink.Bytecode.run in file "otherlibs/dynlink/byte/dynlink.ml", line 168, characters 16-25
+Re-raised at Dynlink.Bytecode.run in file "otherlibs/dynlink/byte/dynlink.ml", lines 170-172, characters 6-39
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
 Called from Stdlib__Fun.protect in file "fun.ml", line 34, characters 8-15
 Re-raised at Stdlib__Fun.protect in file "fun.ml", line 39, characters 6-52

diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.ml b/testsuite/tests/lib-dynlink-initializers/test10_main.ml
index f227399cd1dff920aad7bb3f87f2e6ee279eba23..0727ea9e82a232e5131a1cc0be984e02fe302e13 100644 (file)
--- a/testsuite/tests/lib-dynlink-initializers/test10_main.ml
+++ b/testsuite/tests/lib-dynlink-initializers/test10_main.ml
@@ -64,41 +64,42 @@ let () =
  shared-libraries;
  {
    setup-ocamlc.byte-build-env;
-   {
-     module = "test10_main.ml";
-     ocamlc.byte;
-   }{
-     module = "test10_plugin.ml";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/test10.byte";
-     libraries = "dynlink";
-     all_modules = "test10_main.cmo";
-     ocamlc.byte;
-     run;
-     reference = "${test_source_directory}/test10_main.byte.reference";
-     check-program-output;
-   }
+
+   module = "test10_main.ml";
+   ocamlc.byte;
+
+   module = "test10_plugin.ml";
+   ocamlc.byte;
+
+   unset module;
+   program = "${test_build_directory}/test10.byte";
+   libraries = "dynlink";
+   all_modules = "test10_main.cmo";
+   ocamlc.byte;
+   run;
+   reference = "${test_source_directory}/test10_main.byte.reference";
+   check-program-output;
  }{
    no-flambda;
    native-dynlink;
    setup-ocamlopt.byte-build-env;
-   {
-     module = "test10_main.ml";
-     ocamlopt.byte;
-   }{
-     program = "test10_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test10_plugin.ml";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/test10.exe";
-     libraries = "dynlink";
-     all_modules = "test10_main.cmx";
-     ocamlopt.byte;
-     run;
-     reference = "${test_source_directory}/test10_main.native.reference";
-     check-program-output;
-   }
+
+   module = "test10_main.ml";
+   ocamlopt.byte;
+
+   unset module;
+   program = "test10_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test10_plugin.ml";
+   ocamlopt.byte;
+
+   program = "${test_build_directory}/test10.exe";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test10_main.cmx";
+   ocamlopt.byte;
+   run;
+   reference = "${test_source_directory}/test10_main.native.reference";
+   check-program-output;
  }
 *)

diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
index 4a9e82ce472ad08bfb7f9bfa14ef39c759d251a0..135efd88ceca2886e3ae13005747aeef69fb5def 100755 (executable)
--- a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
+++ b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
@@ -1,10 +1,10 @@
 Error: Failure("Plugin error")
-Raised by primitive operation at Dynlink.Native.run.(fun) in file "native/dynlink.ml", line 83, characters 12-29
-Re-raised at Dynlink.Native.run.(fun) in file "native/dynlink.ml", lines 85-87, characters 10-43
+Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
+Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", lines 87-89, characters 10-43
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "dynlink_common.ml", line 358, characters 11-54
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
 Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
 Called from Stdlib__Fun.protect in file "fun.ml", line 34, characters 8-15
 Re-raised at Stdlib__Fun.protect in file "fun.ml", line 39, characters 6-52
-Called from Dynlink_common.Make.loadfile in file "dynlink_common.ml" (inlined), line 366, characters 26-45
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 364, characters 26-45
 Called from Test10_main in file "test10_main.ml", lines 49-51, characters 30-7

diff --git a/testsuite/tests/lib-dynlink-initializers/test1_main.ml b/testsuite/tests/lib-dynlink-initializers/test1_main.ml
index 0958573147a9c297998c0e75be188f432fbbc7bf..185b25991e15754fa77c2087f273da56319d2495 100644 (file)
--- a/testsuite/tests/lib-dynlink-initializers/test1_main.ml
+++ b/testsuite/tests/lib-dynlink-initializers/test1_main.ml
@@ -5,43 +5,44 @@
  shared-libraries;
  {
    setup-ocamlc.byte-build-env;
-   {
-     module = "test1_main.ml";
-     ocamlc.byte;
-   }{
-     module = "test1_inited_second.ml";
-     ocamlc.byte;
-   }{
-     module = "test1_plugin.ml";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/test1.byte";
-     libraries = "dynlink";
-     all_modules = "test1_main.cmo test1_inited_second.cmo";
-     ocamlc.byte;
-     run;
-   }
+
+   module = "test1_main.ml";
+   ocamlc.byte;
+
+   module = "test1_inited_second.ml";
+   ocamlc.byte;
+
+   module = "test1_plugin.ml";
+   ocamlc.byte;
+
+   unset module;
+   program = "${test_build_directory}/test1.byte";
+   libraries = "dynlink";
+   all_modules = "test1_main.cmo test1_inited_second.cmo";
+   ocamlc.byte;
+   run;
  }{
    native-dynlink;
    setup-ocamlopt.byte-build-env;
-   {
-     module = "test1_main.ml";
-     ocamlopt.byte;
-   }{
-     module = "test1_inited_second.ml";
-     ocamlopt.byte;
-   }{
-     program = "test1_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test1_plugin.ml";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/test1.exe";
-     libraries = "dynlink";
-     all_modules = "test1_main.cmx test1_inited_second.cmx";
-     ocamlopt.byte;
-     run;
-   }
+
+   module = "test1_main.ml";
+   ocamlopt.byte;
+
+   module = "test1_inited_second.ml";
+   ocamlopt.byte;
+
+   unset module;
+   program = "test1_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test1_plugin.ml";
+   ocamlopt.byte;
+
+   program = "${test_build_directory}/test1.exe";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test1_main.cmx test1_inited_second.cmx";
+   ocamlopt.byte;
+   run;
  }
 *)
 

diff --git a/testsuite/tests/lib-dynlink-initializers/test2_main.ml b/testsuite/tests/lib-dynlink-initializers/test2_main.ml
index e1507e7dff66109f950c495792da12a9a865ee9f..56a88985a0ab396170fe741e7b4ff3bf617b6814 100644 (file)
--- a/testsuite/tests/lib-dynlink-initializers/test2_main.ml
+++ b/testsuite/tests/lib-dynlink-initializers/test2_main.ml
@@ -5,43 +5,44 @@
  shared-libraries;
  {
    setup-ocamlc.byte-build-env;
-   {
-     module = "test2_inited_first.ml";
-     ocamlc.byte;
-   }{
-     module = "test2_main.ml";
-     ocamlc.byte;
-   }{
-     module = "test2_plugin.ml";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/test2.byte";
-     libraries = "dynlink";
-     all_modules = "test2_inited_first.cmo test2_main.cmo";
-     ocamlc.byte;
-     run;
-   }
+
+   module = "test2_inited_first.ml";
+   ocamlc.byte;
+
+   module = "test2_main.ml";
+   ocamlc.byte;
+
+   module = "test2_plugin.ml";
+   ocamlc.byte;
+
+   unset module;
+   program = "${test_build_directory}/test2.byte";
+   libraries = "dynlink";
+   all_modules = "test2_inited_first.cmo test2_main.cmo";
+   ocamlc.byte;
+   run;
  }{
    native-dynlink;
    setup-ocamlopt.byte-build-env;
-   {
-     module = "test2_inited_first.ml";
-     ocamlopt.byte;
-   }{
-     module = "test2_main.ml";
-     ocamlopt.byte;
-   }{
-     program = "test2_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test2_plugin.ml";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/test2.exe";
-     libraries = "dynlink";
-     all_modules = "test2_inited_first.cmx test2_main.cmx";
-     ocamlopt.byte;
-     run;
-   }
+
+   module = "test2_inited_first.ml";
+   ocamlopt.byte;
+
+   module = "test2_main.ml";
+   ocamlopt.byte;
+
+   unset module;
+   program = "test2_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test2_plugin.ml";
+   ocamlopt.byte;
+
+   program = "${test_build_directory}/test2.exe";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test2_inited_first.cmx test2_main.cmx";
+   ocamlopt.byte;
+   run;
  }
 *)
 

diff --git a/testsuite/tests/lib-dynlink-initializers/test3_main.ml b/testsuite/tests/lib-dynlink-initializers/test3_main.ml
index b2f3e447435285a922278d942eb3188cf018b5cf..0be60237a6f4cb9015c5be07bd659cb8fac8db3b 100644 (file)
--- a/testsuite/tests/lib-dynlink-initializers/test3_main.ml
+++ b/testsuite/tests/lib-dynlink-initializers/test3_main.ml
@@ -5,51 +5,53 @@
  shared-libraries;
  {
    setup-ocamlc.byte-build-env;
-   {
-     module = "test3_main.ml";
-     ocamlc.byte;
-   }{
-     module = "test3_plugin_a.ml";
-     ocamlc.byte;
-   }{
-     module = "test3_plugin_b.ml";
-     ocamlc.byte;
-   }{
-     program = "test3_plugin.cma";
-     flags = "-a";
-     all_modules = "test3_plugin_a.cmo test3_plugin_b.cmo";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/test3.byte";
-     libraries = "dynlink";
-     all_modules = "test3_main.cmo";
-     ocamlc.byte;
-     run;
-   }
+
+   module = "test3_main.ml";
+   ocamlc.byte;
+
+   module = "test3_plugin_a.ml";
+   ocamlc.byte;
+
+   module = "test3_plugin_b.ml";
+   ocamlc.byte;
+
+   unset module;
+   program = "test3_plugin.cma";
+   flags = "-a";
+   all_modules = "test3_plugin_a.cmo test3_plugin_b.cmo";
+   ocamlc.byte;
+
+   program = "${test_build_directory}/test3.byte";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test3_main.cmo";
+   ocamlc.byte;
+   run;
  }{
    native-dynlink;
    setup-ocamlopt.byte-build-env;
-   {
-     module = "test3_main.ml";
-     ocamlopt.byte;
-   }{
-     module = "test3_plugin_a.ml";
-     ocamlopt.byte;
-   }{
-     module = "test3_plugin_b.ml";
-     ocamlopt.byte;
-   }{
-     program = "test3_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test3_plugin_a.cmx test3_plugin_b.cmx";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/test3.exe";
-     libraries = "dynlink";
-     all_modules = "test3_main.cmx";
-     ocamlopt.byte;
-     run;
-   }
+
+   module = "test3_main.ml";
+   ocamlopt.byte;
+
+   module = "test3_plugin_a.ml";
+   ocamlopt.byte;
+
+   module = "test3_plugin_b.ml";
+   ocamlopt.byte;
+
+   unset module;
+   program = "test3_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test3_plugin_a.cmx test3_plugin_b.cmx";
+   ocamlopt.byte;
+
+   unset flags;
+   program = "${test_build_directory}/test3.exe";
+   libraries = "dynlink";
+   all_modules = "test3_main.cmx";
+   ocamlopt.byte;
+   run;
  }
 *)
 

diff --git a/testsuite/tests/lib-dynlink-initializers/test4_main.ml b/testsuite/tests/lib-dynlink-initializers/test4_main.ml
deleted file mode 100644 (file)
index d24880e..0000000
--- a/testsuite/tests/lib-dynlink-initializers/test4_main.ml
+++ /dev/null
@@ -1,70 +0,0 @@
-(* TEST
- include dynlink;
- readonly_files = "test4_plugin_a.ml test4_plugin_b.ml";
- libraries = "";
- shared-libraries;
- {
-   setup-ocamlc.byte-build-env;
-   {
-     module = "test4_main.ml";
-     ocamlc.byte;
-   }{
-     module = "test4_plugin_b.ml";
-     ocamlc.byte;
-   }{
-     module = "test4_plugin_a.ml";
-     ocamlc.byte;
-   }{
-     program = "test4_plugin.cma";
-     flags = "-a";
-     all_modules = "test4_plugin_a.cmo test4_plugin_b.cmo";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/test4.byte";
-     libraries = "dynlink";
-     all_modules = "test4_main.cmo";
-     ocamlc.byte;
-     run;
-   }
- }{
-   native-dynlink;
-   setup-ocamlopt.byte-build-env;
-   {
-     module = "test4_main.ml";
-     ocamlopt.byte;
-   }{
-     module = "test4_plugin_b.ml";
-     ocamlopt.byte;
-   }{
-     module = "test4_plugin_a.ml";
-     ocamlopt.byte;
-   }{
-     program = "test4_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test4_plugin_a.cmx test4_plugin_b.cmx";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/test4.exe";
-     libraries = "dynlink";
-     all_modules = "test4_main.cmx";
-     ocamlopt.byte;
-     run;
-   }
- }
-*)
-
-(* Check that a module in a shared library cannot refer to another
-   module in the same shared library if it has not yet been loaded. *)
-
-let () =
-  try
-    if Dynlink.is_native then begin
-      Dynlink.loadfile "test4_plugin.cmxs"
-    end else begin
-      Dynlink.loadfile "test4_plugin.cma"
-    end;
-    assert false
-  with
-  | Dynlink.Error (
-      Dynlink.Linking_error (_,
-        Dynlink.Uninitialized_global "Test4_plugin_b")) -> ()

diff --git a/testsuite/tests/lib-dynlink-initializers/test4_plugin_a.ml b/testsuite/tests/lib-dynlink-initializers/test4_plugin_a.ml
deleted file mode 100644 (file)
index 0341c3b..0000000
--- a/testsuite/tests/lib-dynlink-initializers/test4_plugin_a.ml
+++ /dev/null
@@ -1,2 +0,0 @@
-let () =
-  print_int (Test4_plugin_b.f 42)

diff --git a/testsuite/tests/lib-dynlink-initializers/test4_plugin_b.ml b/testsuite/tests/lib-dynlink-initializers/test4_plugin_b.ml
deleted file mode 100644 (file)
index 2f1eb89..0000000
--- a/testsuite/tests/lib-dynlink-initializers/test4_plugin_b.ml
+++ /dev/null
@@ -1 +0,0 @@
-let f x = x + 3 [@@inline never]

diff --git a/testsuite/tests/lib-dynlink-initializers/test5_main.ml b/testsuite/tests/lib-dynlink-initializers/test5_main.ml
index 3c9aab13ce112397b12f017741aa6b7d85d1d661..39d55a18bdd415083caed68a4ee6dfe5cfde07d0 100644 (file)
--- a/testsuite/tests/lib-dynlink-initializers/test5_main.ml
+++ b/testsuite/tests/lib-dynlink-initializers/test5_main.ml
@@ -5,59 +5,61 @@
  shared-libraries;
  {
    setup-ocamlc.byte-build-env;
-   {
-     module = "test5_main.ml";
-     ocamlc.byte;
-   }{
-     module = "test5_plugin_a.ml";
-     ocamlc.byte;
-   }{
-     module = "test5_plugin_b.ml";
-     ocamlc.byte;
-   }{
-     module = "test5_second_plugin.ml";
-     ocamlc.byte;
-   }{
-     program = "test5_plugin.cma";
-     flags = "-a";
-     all_modules = "test5_plugin_a.cmo test5_plugin_b.cmo";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/test5.byte";
-     libraries = "dynlink";
-     all_modules = "test5_main.cmo";
-     ocamlc.byte;
-     run;
-   }
+
+   module = "test5_main.ml";
+   ocamlc.byte;
+
+   module = "test5_plugin_a.ml";
+   ocamlc.byte;
+
+   module = "test5_plugin_b.ml";
+   ocamlc.byte;
+
+   module = "test5_second_plugin.ml";
+   ocamlc.byte;
+
+   unset module;
+   program = "test5_plugin.cma";
+   flags = "-a";
+   all_modules = "test5_plugin_a.cmo test5_plugin_b.cmo";
+   ocamlc.byte;
+
+   program = "${test_build_directory}/test5.byte";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test5_main.cmo";
+   ocamlc.byte;
+   run;
  }{
    native-dynlink;
    setup-ocamlopt.byte-build-env;
-   {
-     module = "test5_main.ml";
-     ocamlopt.byte;
-   }{
-     module = "test5_plugin_a.ml";
-     ocamlopt.byte;
-   }{
-     module = "test5_plugin_b.ml";
-     ocamlopt.byte;
-   }{
-     program = "test5_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test5_plugin_a.cmx test5_plugin_b.cmx";
-     ocamlopt.byte;
-   }{
-     program = "test5_second_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test5_second_plugin.ml";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/test5.exe";
-     libraries = "dynlink";
-     all_modules = "test5_main.cmx";
-     ocamlopt.byte;
-     run;
-   }
+
+   module = "test5_main.ml";
+   ocamlopt.byte;
+
+   module = "test5_plugin_a.ml";
+   ocamlopt.byte;
+
+   module = "test5_plugin_b.ml";
+   ocamlopt.byte;
+
+   unset module;
+   program = "test5_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test5_plugin_a.cmx test5_plugin_b.cmx";
+   ocamlopt.byte;
+
+   program = "test5_second_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test5_second_plugin.ml";
+   ocamlopt.byte;
+
+   program = "${test_build_directory}/test5.exe";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test5_main.cmx";
+   ocamlopt.byte;
+   run;
  }
 *)
 

diff --git a/testsuite/tests/lib-dynlink-initializers/test6_main.ml b/testsuite/tests/lib-dynlink-initializers/test6_main.ml
index 3828bdaa4ad54cb237ef4146e4df42f463b956e7..873e92ae3f03028f4e04b4f2d8fb78d4934de386 100644 (file)
--- a/testsuite/tests/lib-dynlink-initializers/test6_main.ml
+++ b/testsuite/tests/lib-dynlink-initializers/test6_main.ml
@@ -5,45 +5,46 @@
  shared-libraries;
  {
    setup-ocamlc.byte-build-env;
-   {
-     module = "test6_main.ml";
-     ocamlc.byte;
-   }{
-     module = "test6_plugin.ml";
-     ocamlc.byte;
-   }{
-     module = "test6_second_plugin.ml";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/test6.byte";
-     libraries = "dynlink";
-     all_modules = "test6_main.cmo";
-     ocamlc.byte;
-     run;
-   }
+
+   module = "test6_main.ml";
+   ocamlc.byte;
+
+   module = "test6_plugin.ml";
+   ocamlc.byte;
+
+   module = "test6_second_plugin.ml";
+   ocamlc.byte;
+
+   unset module;
+   program = "${test_build_directory}/test6.byte";
+   libraries = "dynlink";
+   all_modules = "test6_main.cmo";
+   ocamlc.byte;
+   run;
  }{
    native-dynlink;
    setup-ocamlopt.byte-build-env;
-   {
-     module = "test6_main.ml";
-     ocamlopt.byte;
-   }{
-     program = "test6_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test6_plugin.ml";
-     ocamlopt.byte;
-   }{
-     program = "test6_second_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test6_second_plugin.ml";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/test6.exe";
-     libraries = "dynlink";
-     all_modules = "test6_main.cmx";
-     ocamlopt.byte;
-     run;
-   }
+
+   module = "test6_main.ml";
+   ocamlopt.byte;
+
+   unset module;
+   program = "test6_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test6_plugin.ml";
+   ocamlopt.byte;
+
+   program = "test6_second_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test6_second_plugin.ml";
+   ocamlopt.byte;
+
+   program = "${test_build_directory}/test6.exe";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test6_main.cmx";
+   ocamlopt.byte;
+   run;
  }
 *)
 

diff --git a/testsuite/tests/lib-dynlink-initializers/test7_main.ml b/testsuite/tests/lib-dynlink-initializers/test7_main.ml
index 6e3bbbc522ce26a5ae601d8626aa4db969be971b..f42bd758487be65dc009f79572e40365526a8e62 100644 (file)
--- a/testsuite/tests/lib-dynlink-initializers/test7_main.ml
+++ b/testsuite/tests/lib-dynlink-initializers/test7_main.ml
@@ -5,43 +5,44 @@
  shared-libraries;
  {
    setup-ocamlc.byte-build-env;
-   {
-     module = "test7_interface_only.mli";
-     ocamlc.byte;
-   }{
-     module = "test7_main.ml";
-     ocamlc.byte;
-   }{
-     module = "test7_plugin.ml";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/test7.byte";
-     libraries = "dynlink";
-     all_modules = "test7_main.cmo";
-     ocamlc.byte;
-     run;
-   }
+
+   module = "test7_interface_only.mli";
+   ocamlc.byte;
+
+   module = "test7_main.ml";
+   ocamlc.byte;
+
+   module = "test7_plugin.ml";
+   ocamlc.byte;
+
+   unset module;
+   program = "${test_build_directory}/test7.byte";
+   libraries = "dynlink";
+   all_modules = "test7_main.cmo";
+   ocamlc.byte;
+   run;
  }{
    native-dynlink;
    setup-ocamlopt.byte-build-env;
-   {
-     module = "test7_interface_only.mli";
-     ocamlopt.byte;
-   }{
-     module = "test7_main.ml";
-     ocamlopt.byte;
-   }{
-     program = "test7_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test7_plugin.ml";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/test7.exe";
-     libraries = "dynlink";
-     all_modules = "test7_main.cmx";
-     ocamlopt.byte;
-     run;
-   }
+
+   module = "test7_interface_only.mli";
+   ocamlopt.byte;
+
+   module = "test7_main.ml";
+   ocamlopt.byte;
+
+   unset module;
+   program = "test7_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test7_plugin.ml";
+   ocamlopt.byte;
+
+   program = "${test_build_directory}/test7.exe";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test7_main.cmx";
+   ocamlopt.byte;
+   run;
  }
 *)
 

diff --git a/testsuite/tests/lib-dynlink-initializers/test8_main.ml b/testsuite/tests/lib-dynlink-initializers/test8_main.ml
index 0f194afcb8ee527ac94b3add5c38a014fe8c94cf..744eabbacab18b48452ecf6d40f42e3fd24178b6 100644 (file)
--- a/testsuite/tests/lib-dynlink-initializers/test8_main.ml
+++ b/testsuite/tests/lib-dynlink-initializers/test8_main.ml
@@ -5,57 +5,59 @@
  shared-libraries;
  {
    setup-ocamlc.byte-build-env;
-   {
-     module = "test8_main.ml";
-     ocamlc.byte;
-   }{
-     module = "test8_plugin_b.mli";
-     ocamlc.byte;
-   }{
-     module = "test8_plugin_a.ml";
-     ocamlc.byte;
-   }{
-     module = "test8_plugin_b.ml";
-     ocamlc.byte;
-   }{
-     program = "test8_plugin.cma";
-     flags = "-a";
-     all_modules = "test8_plugin_a.cmo test8_plugin_b.cmo";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/test8.byte";
-     libraries = "dynlink";
-     all_modules = "test8_main.cmo";
-     ocamlc.byte;
-     run;
-   }
+
+   module = "test8_main.ml";
+   ocamlc.byte;
+
+   module = "test8_plugin_b.mli";
+   ocamlc.byte;
+
+   module = "test8_plugin_a.ml";
+   ocamlc.byte;
+
+   module = "test8_plugin_b.ml";
+   ocamlc.byte;
+
+   unset module;
+   program = "test8_plugin.cma";
+   flags = "-a";
+   all_modules = "test8_plugin_a.cmo test8_plugin_b.cmo";
+   ocamlc.byte;
+
+   program = "${test_build_directory}/test8.byte";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test8_main.cmo";
+   ocamlc.byte;
+   run;
  }{
    native-dynlink;
    setup-ocamlopt.byte-build-env;
-   {
-     module = "test8_main.ml";
-     ocamlopt.byte;
-   }{
-     module = "test8_plugin_b.mli";
-     ocamlopt.byte;
-   }{
-     module = "test8_plugin_a.ml";
-     ocamlopt.byte;
-   }{
-     module = "test8_plugin_b.ml";
-     ocamlopt.byte;
-   }{
-     program = "test8_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test8_plugin_a.cmx test8_plugin_b.cmx";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/test8.exe";
-     libraries = "dynlink";
-     all_modules = "test8_main.cmx";
-     ocamlopt.byte;
-     run;
-   }
+
+   module = "test8_main.ml";
+   ocamlopt.byte;
+
+   module = "test8_plugin_b.mli";
+   ocamlopt.byte;
+
+   module = "test8_plugin_a.ml";
+   ocamlopt.byte;
+
+   module = "test8_plugin_b.ml";
+   ocamlopt.byte;
+
+   unset module;
+   program = "test8_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test8_plugin_a.cmx test8_plugin_b.cmx";
+   ocamlopt.byte;
+
+   program = "${test_build_directory}/test8.exe";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test8_main.cmx";
+   ocamlopt.byte;
+   run;
  }
 *)
 

diff --git a/testsuite/tests/lib-dynlink-initializers/test9_main.ml b/testsuite/tests/lib-dynlink-initializers/test9_main.ml
index fcb11286330620b46fa7862268de8ee3cfee6f42..4254b76a1a97ed809d8bf8615bd982633eb03993 100644 (file)
--- a/testsuite/tests/lib-dynlink-initializers/test9_main.ml
+++ b/testsuite/tests/lib-dynlink-initializers/test9_main.ml
@@ -5,51 +5,52 @@
  shared-libraries;
  {
    setup-ocamlc.byte-build-env;
-   {
-     module = "test9_second_plugin.mli";
-     ocamlc.byte;
-   }{
-     module = "test9_main.ml";
-     ocamlc.byte;
-   }{
-     module = "test9_plugin.ml";
-     ocamlc.byte;
-   }{
-     module = "test9_second_plugin.ml";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/test9.byte";
-     libraries = "dynlink";
-     all_modules = "test9_main.cmo";
-     ocamlc.byte;
-     run;
-   }
+
+   module = "test9_second_plugin.mli";
+   ocamlc.byte;
+
+   module = "test9_main.ml";
+   ocamlc.byte;
+
+   module = "test9_plugin.ml";
+   ocamlc.byte;
+
+   module = "test9_second_plugin.ml";
+   ocamlc.byte;
+
+   unset module;
+   program = "${test_build_directory}/test9.byte";
+   libraries = "dynlink";
+   all_modules = "test9_main.cmo";
+   ocamlc.byte;
+   run;
  }{
    native-dynlink;
    setup-ocamlopt.byte-build-env;
-   {
-     module = "test9_second_plugin.mli";
-     ocamlopt.byte;
-   }{
-     module = "test9_main.ml";
-     ocamlopt.byte;
-   }{
-     program = "test9_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test9_plugin.ml";
-     ocamlopt.byte;
-   }{
-     program = "test9_second_plugin.cmxs";
-     flags = "-shared";
-     all_modules = "test9_second_plugin.ml";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/test9.exe";
-     libraries = "dynlink";
-     all_modules = "test9_main.cmx";
-     ocamlopt.byte;
-     run;
-   }
+
+   module = "test9_second_plugin.mli";
+   ocamlopt.byte;
+
+   module = "test9_main.ml";
+   ocamlopt.byte;
+
+   unset module;
+   program = "test9_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test9_plugin.ml";
+   ocamlopt.byte;
+
+   program = "test9_second_plugin.cmxs";
+   flags = "-shared";
+   all_modules = "test9_second_plugin.ml";
+   ocamlopt.byte;
+
+   program = "${test_build_directory}/test9.exe";
+   unset flags;
+   libraries = "dynlink";
+   all_modules = "test9_main.cmx";
+   ocamlopt.byte;
+   run;
  }
 *)
 

diff --git a/testsuite/tests/lib-dynlink-native/factorial.c b/testsuite/tests/lib-dynlink-native/factorial.c
index 5393c84d9f35b976fcd818379cd5558ce129d230..658f275de01fcf972337e65c234655060ccb6fb1 100644 (file)
--- a/testsuite/tests/lib-dynlink-native/factorial.c
+++ b/testsuite/tests/lib-dynlink-native/factorial.c
@@ -13,9 +13,9 @@
 /*                                                                        */
 /**************************************************************************/
 
-#include "caml/mlvalues.h"
-#include "caml/memory.h"
-#include "caml/alloc.h"
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
 #include <stdio.h>
 
 value factorial(value n){
@@ -24,9 +24,8 @@ value factorial(value n){
 
   static char buf[256];
   int x = 1;
-  int i;
   int m = Int_val(n);
-  for (i = 1; i <= m; i++) x *= i;
+  for (int i = 1; i <= m; i++) x *= i;
   sprintf(buf,"%i",x);
   s = caml_copy_string(buf);
   CAMLreturn (s);

diff --git a/testsuite/tests/lib-dynlink-packed/loader.ml b/testsuite/tests/lib-dynlink-packed/loader.ml
index 19add8903c4e23a69da76fa0fc173c431cd4ad60..b93c53450f8b1d18e722d8ffdde7cbbe31848bf8 100644 (file)
--- a/testsuite/tests/lib-dynlink-packed/loader.ml
+++ b/testsuite/tests/lib-dynlink-packed/loader.ml
@@ -5,66 +5,62 @@
  shared-libraries;
  {
    setup-ocamlc.byte-build-env;
-   {
-     flags = "-for-pack Packed";
-     module = "a.ml";
-     ocamlc.byte;
-   }{
-     flags = "-for-pack Packed";
-     module = "b.ml";
-     ocamlc.byte;
-   }{
-     program = "packed.cmo";
-     flags = "-pack";
-     all_modules = "a.cmo b.cmo";
-     ocamlc.byte;
-   }{
-     program = "${test_build_directory}/loader.byte";
-     flags = "-linkall";
-     include ocamlcommon;
-     libraries += "dynlink";
-     all_modules = "loader.ml";
-     ocamlc.byte;
-     arguments = "packed.cmo";
-     exit_status = "0";
-     run;
-     reference = "${test_source_directory}/byte.reference";
-     check-program-output;
-   }
+
+   flags = "-for-pack Packed";
+   module = "a.ml";
+   ocamlc.byte;
+   module = "b.ml";
+   ocamlc.byte;
+
+   unset module;
+   program = "packed.cmo";
+   flags = "-pack";
+   all_modules = "a.cmo b.cmo";
+   ocamlc.byte;
+
+   program = "${test_build_directory}/loader.byte";
+   flags = "-linkall";
+   include ocamlcommon;
+   libraries += "dynlink";
+   all_modules = "loader.ml";
+   ocamlc.byte;
+   arguments = "packed.cmo";
+   exit_status = "0";
+   run;
+   reference = "${test_source_directory}/byte.reference";
+   check-program-output;
  }{
    native-dynlink;
    setup-ocamlopt.byte-build-env;
-   {
-     flags = "-for-pack Packed";
-     module = "a.ml";
-     ocamlopt.byte;
-   }{
-     flags = "-for-pack Packed";
-     module = "b.ml";
-     ocamlopt.byte;
-   }{
-     program = "packed.cmx";
-     flags = "-pack";
-     all_modules = "a.cmx b.cmx";
-     ocamlopt.byte;
-   }{
-     program = "plugin.cmxs";
-     flags = "-shared";
-     all_modules = "packed.cmx";
-     ocamlopt.byte;
-   }{
-     program = "${test_build_directory}/loader.exe";
-     flags = "-linkall";
-     include ocamlcommon;
-     libraries += "dynlink";
-     all_modules = "loader.ml";
-     ocamlopt.byte;
-     arguments = "plugin.cmxs";
-     exit_status = "0";
-     run;
-     reference = "${test_source_directory}/native.reference";
-     check-program-output;
-   }
+
+   flags = "-for-pack Packed";
+   module = "a.ml";
+   ocamlopt.byte;
+   module = "b.ml";
+   ocamlopt.byte;
+
+   unset module;
+   program = "packed.cmx";
+   flags = "-pack";
+   all_modules = "a.cmx b.cmx";
+   ocamlopt.byte;
+
+   program = "plugin.cmxs";
+   flags = "-shared";
+   all_modules = "packed.cmx";
+   ocamlopt.byte;
+
+   program = "${test_build_directory}/loader.exe";
+   flags = "-linkall";
+   include ocamlcommon;
+   libraries += "dynlink";
+   all_modules = "loader.ml";
+   ocamlopt.byte;
+   arguments = "plugin.cmxs";
+   exit_status = "0";
+   run;
+   reference = "${test_source_directory}/native.reference";
+   check-program-output;
  }
 *)
 let () =

diff --git a/testsuite/tests/lib-dynlink-pr4229/main.ml b/testsuite/tests/lib-dynlink-pr4229/main.ml
index a6ac99de6b9307d125739eab98feefe03f83fa53..a1a090e6542cf647be56c47efc8afe4c966b751e 100644 (file)
--- a/testsuite/tests/lib-dynlink-pr4229/main.ml
+++ b/testsuite/tests/lib-dynlink-pr4229/main.ml
@@ -53,24 +53,24 @@
    ocamlopt.byte;
    module = "static.ml";
    ocamlopt.byte;
-   {
-     program = "client.cmxs";
-     flags = "-shared";
-     module = "";
-     all_modules = "client.ml";
-     ocamlopt.byte;
-   }{
-     module = "main.ml";
-     ocamlopt.byte;
-     program = "${test_build_directory}/main_native";
-     libraries = "dynlink";
-     module = "";
-     all_modules = "abstract.cmx static.cmx main.cmx";
-     ocamlopt.byte;
-     exit_status = "2";
-     run;
-     check-program-output;
-   }
+   program = "client.cmxs";
+   flags = "-shared";
+   module = "";
+   all_modules = "client.ml";
+   ocamlopt.byte;
+   module = "main.ml";
+   unset program;
+   unset flags;
+   unset all_modules;
+   ocamlopt.byte;
+   program = "${test_build_directory}/main_native";
+   libraries = "dynlink";
+   module = "";
+   all_modules = "abstract.cmx static.cmx main.cmx";
+   ocamlopt.byte;
+   exit_status = "2";
+   run;
+   check-program-output;
  }
 *)
 

diff --git a/testsuite/tests/lib-filename/quotecommand.ml b/testsuite/tests/lib-filename/quotecommand.ml
index 7034c369220532e4a22666ce51c2691960f2049c..a3d024bdba12ebb091580b07d5d8eebcd2cb8097 100644 (file)
--- a/testsuite/tests/lib-filename/quotecommand.ml
+++ b/testsuite/tests/lib-filename/quotecommand.ml
@@ -53,16 +53,17 @@ let cat_file f =
 let myecho =
   Filename.concat Filename.current_dir_name "my echo.exe"
 
-let run ?stdin ?stdout ?stderr args =
+let run prog ?stdin ?stdout ?stderr args =
   flush Stdlib.stdout;
   let rc =
-   Sys.command (Filename.quote_command myecho ?stdin ?stdout ?stderr args) in
+   Sys.command (Filename.quote_command prog ?stdin ?stdout ?stderr args) in
   if rc > 0 then begin
-    printf "!!! my echo failed\n";
+    printf "!!! %s failed\n" prog;
     exit 2
   end
 
 let _ =
+  let run = run myecho in
   copy_file "myecho.exe" "my echo.exe";
   printf "-------- Spaces\n";
   run ["Lorem ipsum dolor"; "sit amet,"; "consectetur adipiscing elit,"];
@@ -100,3 +101,7 @@ let _ =
                "in voluptate"; "-out"; "velit esse cillum"; "-err"; "dolore"];
   cat_file "my file.tmp"; Sys.remove "my file.tmp";
   Sys.remove "my echo.exe"
+
+let _ =
+  printf "-------- Forward slashes in program position\n";
+  run "./myecho.exe" ["alea iacta est"]

diff --git a/testsuite/tests/lib-filename/quotecommand.reference b/testsuite/tests/lib-filename/quotecommand.reference
index 937c9fe66b56c1f1385e313f762a91bc8fc65358..4011e7a2d352ad6b4947d31d76b1cc881f9af941 100644 (file)
--- a/testsuite/tests/lib-filename/quotecommand.reference
+++ b/testsuite/tests/lib-filename/quotecommand.reference
@@ -36,3 +36,5 @@ argv[4] = {|in reprehenderit|}
 argv[5] = {|in voluptate|}
 argv[7] = {|velit esse cillum|}
 argv[9] = {|dolore|}
+-------- Forward slashes in program position
+argv[1] = {|alea iacta est|}

diff --git a/testsuite/tests/lib-list/test.ml b/testsuite/tests/lib-list/test.ml
index 46b73b07201a3c87909d8ec2edbcaa1cbdfd92b9..227c4547756d296f3a4157e33f6973f375f37280 100644 (file)
--- a/testsuite/tests/lib-list/test.ml
+++ b/testsuite/tests/lib-list/test.ml
@@ -61,6 +61,29 @@ let () =
 
   assert (List.filteri (fun i _ -> i < 2) (List.rev l) = [9; 8]);
 
+  let hello = ['H';'e';'l';'l';'o'] in
+  let world = ['W';'o';'r';'l';'d';'!'] in
+  let hello_world = hello @ [' '] @ world in
+  assert (List.take 5 hello_world = hello);
+  assert (List.take 3 [1; 2; 3; 4; 5] = [1; 2; 3]);
+  assert (List.take 3 [1; 2] = [1; 2]);
+  assert (List.take 3 [] = []);
+  assert ((try List.take (-1) [1; 2] with Invalid_argument _ -> [999]) = [999]);
+  assert (List.take 0 [1; 2] = []);
+  assert (List.drop 6 hello_world = world);
+  assert (List.drop 3 [1; 2; 3; 4; 5] = [4; 5]);
+  assert (List.drop 3 [1; 2] = []);
+  assert (List.drop 3 [] = []);
+  assert ((try List.drop (-1) [1; 2] with Invalid_argument _ -> [999]) = [999]);
+  assert (List.drop 0 [1; 2] = [1; 2]);
+  assert (List.take_while (fun x -> x < 3) [1; 2; 3; 4; 1; 2; 3; 4]
+          = [1; 2]);
+  assert (List.take_while (fun x -> x < 9) [1; 2; 3] = [1; 2; 3]);
+  assert (List.take_while (fun x -> x < 0) [1; 2; 3] = []);
+  assert (List.drop_while (fun x -> x < 3) [1; 2; 3; 4; 5; 1; 2; 3]
+          = [3; 4; 5; 1; 2; 3]);
+  assert (List.drop_while (fun x -> x < 9) [1; 2; 3] = []);
+  assert (List.drop_while (fun x -> x < 0) [1; 2; 3] = [1; 2; 3]);
   assert (List.partition is_even [1; 2; 3; 4; 5]
           = ([2; 4], [1; 3; 5]));
   assert (List.partition_map string_of_even_or_int [1; 2; 3; 4; 5]

diff --git a/testsuite/tests/lib-queue/test.ml b/testsuite/tests/lib-queue/test.ml
index cff8e2cd65ec55115416250b11c90b2defc6eac6..b08306d92310038883ad7cb0d67360da709f0056 100644 (file)
--- a/testsuite/tests/lib-queue/test.ml
+++ b/testsuite/tests/lib-queue/test.ml
@@ -8,7 +8,7 @@ end
 
 let does_raise f q =
   try
-    ignore (f q : int);
+    ignore (f q);
     false
   with Q.Empty ->
     true
@@ -137,4 +137,11 @@ let () =
   assert (Q.length q2 = 8); assert (Q.to_list q2 = [5; 6; 7; 8; 1; 2; 3; 4]);
 ;;
 
+let () =
+  let q = Q.create () in
+  Q.add 1 q; Q.drop q; assert (does_raise Q.drop q);
+  Q.add 2 q; Q.drop q; assert (does_raise Q.drop q);
+  assert (Q.length q = 0);
+;;
+
 let () = print_endline "OK"

diff --git a/testsuite/tests/lib-runtime-events/stubs.c b/testsuite/tests/lib-runtime-events/stubs.c
index 93415e6a64ca7b4432f63daf4145e3f7d110cbd6..130ade4b69bfe5188d5ae31729f984b289210941 100644 (file)
--- a/testsuite/tests/lib-runtime-events/stubs.c
+++ b/testsuite/tests/lib-runtime-events/stubs.c
@@ -1,11 +1,11 @@
 #define CAML_NAME_SPACE
 
-#include "caml/alloc.h"
-#include "caml/runtime_events.h"
-#include "caml/runtime_events_consumer.h"
-#include "caml/fail.h"
-#include "caml/memory.h"
-#include "caml/mlvalues.h"
+#include <caml/alloc.h>
+#include <caml/runtime_events.h>
+#include <caml/runtime_events_consumer.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
 
 #include <assert.h>
 

diff --git a/testsuite/tests/lib-runtime-events/test_corrupted.ml b/testsuite/tests/lib-runtime-events/test_corrupted.ml
new file mode 100644 (file)
index 0000000..0444801
--- /dev/null
+++ b/testsuite/tests/lib-runtime-events/test_corrupted.ml
@@ -0,0 +1,133 @@
+(* TEST
+ include runtime_events;
+ include unix;
+ set OCAML_RUNTIME_EVENTS_PRESERVE = "1";
+ libunix;
+ {
+   bytecode;
+ }{
+   native;
+ }
+*)
+
+  let runtime_begin _ _ _ = ()
+  let runtime_end _ _ _ = ()
+  let runtime_counter _ _ _ _ = ()
+  let alloc _ _ _ = ()
+  let lifecycle _ _ _ _ = ()
+  let lost_events _ _ = ()
+  let callbacks = Runtime_events.Callbacks.create
+    ~runtime_begin ~runtime_end ~runtime_counter ~alloc ~lifecycle ~lost_events ()
+
+  let parse path_pid =
+    let cursor =
+        Runtime_events.create_cursor path_pid in
+    let finally () = Runtime_events.free_cursor cursor in
+    Fun.protect ~finally @@ fun () ->
+    Runtime_events.read_poll cursor callbacks None
+
+  let parse_corrupted path_pid =
+    try let (_:int) = parse path_pid in ()
+    with Failure _ | Invalid_argument _ ->
+      (* parsing corrupted rings, raises exceptions,
+         this is expected *)
+      ()
+
+  let buf = Bytes.create (8 * 8)
+
+  let with_ring ring_file f =
+    let fd = Unix.openfile ring_file [Unix.O_RDWR] 0 in
+    let finally () = Unix.close fd in
+    Fun.protect ~finally @@ fun () ->
+    let size = Int64.to_int Unix.LargeFile.((fstat fd).st_size) in
+    let n = Unix.read fd buf 0 (Bytes.length buf) in
+    assert (n = Bytes.length buf);
+    let version = Bytes.get_int64_ne buf 0 in
+    assert (version = 1L);
+    (* this needs to be updated if on-disk layout changes *)
+    let data_offset = Bytes.get_int64_ne buf (6*8) in
+
+    let write_event_header is_runtime event_type event_id event_length =
+      let (<<:) i n = Int64.(shift_left (of_int i) n) and (|:) = Int64.logor in
+      (* see runtime_events.h *)
+      let event_header =
+        (event_length <<: 54) |:
+        (is_runtime <<: 53) |:
+        (event_type <<: 49) |:
+        (event_id <<: 36)
+      in
+      Bytes.set_int64_ne buf 0 event_header;
+      let n = Unix.LargeFile.lseek fd data_offset Unix.SEEK_SET in
+      assert (n = data_offset);
+      let n = Unix.write fd buf 0 (Bytes.length buf) in
+      assert (n = Bytes.length buf)
+    in
+
+    let write_metadata_header offset value =
+      let offset = Int64.of_int offset in
+      let n = Unix.LargeFile.lseek fd offset Unix.SEEK_SET in
+      assert (n = offset);
+      Bytes.set_int64_ne buf 0 value;
+      let n = Unix.write fd buf 0 (Bytes.length buf) in
+      assert (n = Bytes.length buf)
+    in
+
+    f ~size ~write_event_header ~write_metadata_header
+
+  (* this tests the preservation of ring buffers after termination *)
+
+  let () =
+    (* start runtime_events now to avoid a race *)
+    let parent_cwd = Sys.getcwd () in
+    let child_pid = Unix.fork () in
+    if child_pid == 0 then begin
+      (* we are in the child, so start Runtime_events *)
+      Runtime_events.start ();
+      (* this creates a ring buffer. Now exit. *)
+    end else begin
+      (* now wait for our child to finish *)
+      Unix.wait () |> ignore;
+      (* child has finished. We now have a valid ring *)
+      let ring_file =
+          Filename.concat parent_cwd (string_of_int child_pid ^ ".events")
+      and path_pid = Some (parent_cwd, child_pid);
+         in
+      let finally () = Unix.unlink ring_file in
+      Fun.protect ~finally @@ fun () ->
+      with_ring ring_file @@ fun ~size ~write_event_header ~write_metadata_header ->
+      (* we must succeed parsing it as is *)
+      let n = parse path_pid in
+      assert (n > 0);
+      let original = Bytes.to_string buf in
+
+      (* now overwrite various fields, corrupting the ring,
+         and check that we don't crash (raising exceptions is fine).
+       *)
+      for offset = 8 downto 0 do
+        [0L; size * 3/4 |> Int64.of_int; size * 2 |> Int64.of_int;
+         Int64.max_int; Int64.min_int; Int64.(shift_right_logical max_int 1)
+        ] |> List.iter @@ fun value ->
+        write_metadata_header (8 * offset) value;
+        parse_corrupted path_pid;
+        (* restore original, we only corrupt and test one offset at a time,
+           otherwise we may not find missing bounds checks if we exit early
+           due to bounds error on an earlier offset
+         *)
+        Bytes.blit_string original 0 buf 0 (Bytes.length buf);
+      done;
+      (* restore metadata header, so we have a valid ring again *)
+      write_metadata_header 0 1L (* version *);
+
+      for is_runtime = 0 to 1 do
+        for event_type = 0 to 15 (* event type is 4 bits *) do
+          for event_id = 0 to 64 (* event_id is 13 bits, but not all used yet *) do
+            for length = 0 to 3 (* short lengths trigger uninit read bugs *) do
+                (* modify just 1 event in the otherwise valid ring *)
+                write_event_header is_runtime event_type event_id length;
+                (* parse ring *)
+                parse_corrupted path_pid;
+            done
+          done
+        done;
+      done;
+    end

diff --git a/testsuite/tests/lib-runtime-events/test_create_cursor_failures.ml b/testsuite/tests/lib-runtime-events/test_create_cursor_failures.ml
new file mode 100644 (file)
index 0000000..8481e57
--- /dev/null
+++ b/testsuite/tests/lib-runtime-events/test_create_cursor_failures.ml
@@ -0,0 +1,47 @@
+(* TEST
+ include unix;
+ include runtime_events;
+ hasunix;
+ {
+   bytecode;
+ }{
+   native;
+ }
+*)
+
+(* Tests that [create_cursor]:
+ * - fails on [None] if runtime events haven't been started
+ * - doesn't double-free when it fails to attach to [None]
+ * - does manage to attach to this process if we provide the right PID
+ *)
+
+let create_and_free ?(pid) () =
+  try
+    let dir_and_pid = Option.map (fun p -> ".", p) pid in
+    let cur = Runtime_events.create_cursor dir_and_pid in
+    Runtime_events.free_cursor cur;
+    print_endline "OK"
+  with Failure msg -> print_endline msg
+
+let start_and_pause () =
+  Runtime_events.start ();
+  Runtime_events.pause ()
+
+(* Windows workaround to get the correct PID *)
+let find_events_pid cursor =
+  Scanf.sscanf (Option.get (Runtime_events.path())) "%d.events" Fun.id
+
+(* force failure of [create_cursor None] *)
+let make_unreadable () =
+  Unix.chmod (Option.get (Runtime_events.path())) 0o000
+
+let () =
+  create_and_free (); (* fail, not started *)
+  start_and_pause ();
+  let pid = find_events_pid () in
+  create_and_free ~pid (); (* success *)
+  create_and_free (); (* success *)
+  make_unreadable ();
+  create_and_free ~pid (); (* fail, cannot open *)
+  create_and_free (); (* fail, cannot open *)
+  create_and_free (); (* fail, cannot open *)

diff --git a/testsuite/tests/lib-runtime-events/test_create_cursor_failures.reference b/testsuite/tests/lib-runtime-events/test_create_cursor_failures.reference
new file mode 100644 (file)
index 0000000..948c609
--- /dev/null
+++ b/testsuite/tests/lib-runtime-events/test_create_cursor_failures.reference
@@ -0,0 +1,6 @@
+Runtime_events: no ring for current process.          Was runtime_events started?
+OK
+OK
+Runtime_events: could not create cursor for specified path.
+Runtime_events: could not create cursor for specified path.
+Runtime_events: could not create cursor for specified path.

diff --git a/testsuite/tests/lib-sys/rename.ml b/testsuite/tests/lib-sys/rename.ml
index 5de83a86c8e4139bda876a1ceb7ed3c982e27a54..33eb7cd9f6c1165b23feeed597c285fce72a3e17 100644 (file)
--- a/testsuite/tests/lib-sys/rename.ml
+++ b/testsuite/tests/lib-sys/rename.ml
@@ -102,3 +102,13 @@ let _ =
   safe_remove_dir "foo";
   safe_remove f2;
   safe_remove_dir f2;
+  print_string "Rename parent directory to empty child directory: ";
+  Sys.mkdir "foo" 0o755;
+  let bar = Filename.concat "foo" "bar" in
+  Sys.mkdir bar 0o755;
+  testfailure "foo" bar;
+  assert (Sys.file_exists "foo");
+  assert (Sys.file_exists bar);
+  print_newline();
+  safe_remove_dir bar;
+  safe_remove_dir "foo";

diff --git a/testsuite/tests/lib-sys/rename.reference b/testsuite/tests/lib-sys/rename.reference
index c3a69a5d0be28ec170ef61aba57f1cb8e3b62fbf..ea4c66da9f6c9294f92cbec198f21e230799dfad 100644 (file)
--- a/testsuite/tests/lib-sys/rename.reference
+++ b/testsuite/tests/lib-sys/rename.reference
@@ -8,3 +8,4 @@ Rename directory to a non-empty directory: fails as expected
 Rename directory to existing empty directory: passed
 Rename existing empty directory to itself: source directory still exists!
 Rename directory to existing file: fails as expected
+Rename parent directory to empty child directory: fails as expected

diff --git a/testsuite/tests/lib-systhreads/test_c_thread_register_cstubs.c b/testsuite/tests/lib-systhreads/test_c_thread_register_cstubs.c
index bb1243c96c041abd524fd93c382139c559756be2..882e7b68604d2ef579e8ad9dfaf7adcbfd7ef4d7 100644 (file)
--- a/testsuite/tests/lib-systhreads/test_c_thread_register_cstubs.c
+++ b/testsuite/tests/lib-systhreads/test_c_thread_register_cstubs.c
@@ -6,11 +6,11 @@
 #include <pthread.h>
 #define THREAD_FUNCTION void *
 #endif
-#include "caml/mlvalues.h"
-#include "caml/gc.h"
-#include "caml/memory.h"
-#include "caml/callback.h"
-#include "caml/threads.h"
+#include <caml/mlvalues.h>
+#include <caml/gc.h>
+#include <caml/memory.h>
+#include <caml/callback.h>
+#include <caml/threads.h>
 
 THREAD_FUNCTION thread_func(void *fn) {
   caml_c_thread_register();

diff --git a/testsuite/tests/lib-threads/beat.ml b/testsuite/tests/lib-threads/beat.ml
index f4655ccb8df6923b3751fad9c2f155f0a319c907..e8d73d1e4661a05921a4dd6db12ee8f1f16c7eb6 100644 (file)
--- a/testsuite/tests/lib-threads/beat.ml
+++ b/testsuite/tests/lib-threads/beat.ml
@@ -3,7 +3,7 @@
    include systhreads;
    hassysthreads;
  }{
-   reason = "off-by-one error on MacOS+Clang (#408)";
+   reason = "off-by-one error on MacOS+Clang (https://github.com/ocaml-multicore/ocaml-multicore/issues/408)";
    skip;
    {
      bytecode;

diff --git a/testsuite/tests/lib-threads/sockets.ml b/testsuite/tests/lib-threads/sockets.ml
index 91e67f718584e629a9d02106dc4be51269aa497a..23ec204b98249bbaa69b9c8d079ac7dacac22220 100644 (file)
--- a/testsuite/tests/lib-threads/sockets.ml
+++ b/testsuite/tests/lib-threads/sockets.ml
@@ -16,7 +16,6 @@ open Printf
 let serve_connection s =
   let buf = Bytes.make 1024 '>' in
   let n = Unix.read s buf 2 (Bytes.length buf - 2) in
-  Thread.delay 1.0;
   ignore (Unix.write s buf 0 (n + 2));
   Unix.close s
 
@@ -26,14 +25,27 @@ let server sock =
     ignore(Thread.create serve_connection s)
   done
 
-let client (addr, msg) =
+let client1_done = Event.new_channel ()
+
+let wait_for_turn id =
+  if id = 2 then
+    Event.receive client1_done |> Event.sync |> ignore
+
+let signal_turn id =
+  if id = 1 then
+    Event.send client1_done 2 |> Event.sync
+
+let client (id, addr) =
+  let msg = "Client #" ^ Int.to_string id ^ "\n" in
   let sock =
     Unix.socket (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in
   Unix.connect sock addr;
   let buf = Bytes.make 1024 ' ' in
-  ignore(Unix.write_substring sock msg 0 (String.length msg));
+  ignore (Unix.write_substring sock msg 0 (String.length msg));
   let n = Unix.read sock buf 0 (Bytes.length buf) in
-  print_bytes (Bytes.sub buf 0 n); flush stdout
+  wait_for_turn id;
+  print_bytes (Bytes.sub buf 0 n); flush stdout;
+  signal_turn id
 
 let _ =
   let addr = Unix.ADDR_INET(Unix.inet_addr_loopback, 0) in
@@ -44,6 +56,6 @@ let _ =
   let addr = Unix.getsockname sock in
   Unix.listen sock 5;
   ignore (Thread.create server sock);
-  ignore (Thread.create client (addr, "Client #1\n"));
-  Thread.delay 0.5;
-  client (addr, "Client #2\n")
+  let c = Thread.create client (2, addr) in
+  client (1, addr);
+  Thread.join c

diff --git a/testsuite/tests/lib-uchar/test.ml b/testsuite/tests/lib-uchar/test.ml
index bc7643fc3b6d1ad427110737ba691c173e840b33..134fdf0023afabbeaa7cf032a14ffd4ad030d1a4 100644 (file)
--- a/testsuite/tests/lib-uchar/test.ml
+++ b/testsuite/tests/lib-uchar/test.ml
@@ -71,6 +71,14 @@ let test_compare () =
   assert (Uchar.(compare max min) = 1);
   ()
 
+let test_hash () =
+  let f u =
+    assert (Hashtbl.hash u = Uchar.hash u);
+    assert (Hashtbl.seeded_hash 42 u = Uchar.seeded_hash 42 u)
+  in
+  List.iter (Fun.compose f Uchar.of_int)
+    [0x0000; 0x002D; 0x00E9; 0x062D; 0x2014; 0x1F349]
+
 let test_utf_decode () =
   let d0 = Uchar.utf_decode 1 Uchar.min in
   let d1 = Uchar.utf_decode 4 Uchar.max in
@@ -109,6 +117,7 @@ let tests () =
   test_to_char ();
   test_equal ();
   test_compare ();
+  test_hash ();
   test_utf_decode ();
   test_utf_x_byte_length ();
   ()

diff --git a/testsuite/tests/lib-unix/common/append.ml b/testsuite/tests/lib-unix/common/append.ml
new file mode 100644 (file)
index 0000000..accb3d5
--- /dev/null
+++ b/testsuite/tests/lib-unix/common/append.ml
@@ -0,0 +1,42 @@
+(* TEST
+   include unix;
+   hasunix;
+   {
+     bytecode;
+   }{
+     native;
+   }
+*)
+
+let str = "Hello, OCaml!"
+
+let append () =
+  let fd =
+    Unix.openfile "append.txt"
+      [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_APPEND ]
+      0o644
+  in
+  let len = String.length str in
+  let rec f = function
+    | 0 -> ()
+    | rem ->
+        let n = Unix.write_substring fd str (len - rem) rem in
+        f (rem - n)
+  in
+  f len;
+  Unix.close fd
+
+let () =
+  append ();
+  append ();
+  let fd = Unix.openfile "append.txt" [ Unix.O_RDONLY ] 0o644 in
+  let buf = Buffer.create 10 in
+  let b = Bytes.create 10 in
+  let rec f () =
+    let n = Unix.read fd b 0 10 in
+    Buffer.add_subbytes buf b 0 n;
+    if n <> 0 then f ()
+  in
+  f ();
+  Unix.close fd;
+  assert (Buffer.contents buf = str ^ str)

diff --git a/testsuite/tests/lib-unix/common/fdstatus_aux.c b/testsuite/tests/lib-unix/common/fdstatus_aux.c
index 127bacd25a1c355e262da2ce4aa4001760ca519b..c5b4b6bfcdb839a7946337741385b069f6b4fda0 100644 (file)
--- a/testsuite/tests/lib-unix/common/fdstatus_aux.c
+++ b/testsuite/tests/lib-unix/common/fdstatus_aux.c
@@ -62,8 +62,8 @@ void process_fd(const char * s)
 
 #endif
 
-#include "caml/mlvalues.h"
-#include "caml/memory.h"
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
 
 CAMLprim value caml_process_fd(value CAMLnum, value CAMLfd)
 {

diff --git a/testsuite/tests/lib-unix/kill/unix_kill.ml b/testsuite/tests/lib-unix/kill/unix_kill.ml
index a58fedacd30b69b98f4e1df7c6f79f1e3f708f8e..942b5bb0a1ab24fb4882c639030716f255cb5714 100644 (file)
--- a/testsuite/tests/lib-unix/kill/unix_kill.ml
+++ b/testsuite/tests/lib-unix/kill/unix_kill.ml
@@ -1,6 +1,12 @@
 (* TEST
  include unix;
  libunix;
+ (*
+   Disabled on MacOS amd64 with TSan due to a
+   possible infinite signal loop with TSan under MacOS
+   see https://github.com/llvm/llvm-project/issues/63824
+ *)
+ not_macos_amd64_tsan;
  {
    bytecode;
  }{

diff --git a/testsuite/tests/match-side-effects/check_partial.ml b/testsuite/tests/match-side-effects/check_partial.ml
new file mode 100644 (file)
index 0000000..53fcea4
--- /dev/null
+++ b/testsuite/tests/match-side-effects/check_partial.ml
@@ -0,0 +1,118 @@
+(* TEST
+ flags = "-dlambda";
+ expect;
+*)
+
+(* This test exercises pattern-matching examples that mix mutable
+   state with code execution (through guards or lazy patterns). Some
+   of those tests appear to be exhaustive to the type-checker but are
+   in fact not exhaustive, forcing the pattern-matching compiler to
+   add Match_failure clauses for soundness. The pattern-matching
+   compiler also sometimes conservatively add Match_failure clauses in
+   cases that were in fact exhaustive.
+*)
+
+type _ t =
+  | Int : int -> int t
+  | True : bool t
+  | False : bool t
+
+let lazy_total : _ * bool t -> int = function
+  | ({ contents = _ }, True) -> 0
+  | ({ contents = lazy () }, False) -> 12
+(* This pattern-matching is total: a Match_failure case is not
+   necessary for soundness. *)
+[%%expect {|
+0
+type _ t = Int : int -> int t | True : bool t | False : bool t
+(let
+  (lazy_total/281 =
+     (function param/283 : int
+       (let (*match*/285 =o (field_mut 0 (field_imm 0 param/283)))
+         (switch* (field_imm 1 param/283)
+          case int 0: 0
+          case int 1:
+           (let
+             (*match*/293 =
+                (let (tag/288 =a (caml_obj_tag *match*/285))
+                  (if (== tag/288 250) (field_mut 0 *match*/285)
+                    (if (|| (== tag/288 246) (== tag/288 244))
+                      (apply (field_imm 1 (global CamlinternalLazy!))
+                        (opaque *match*/285))
+                      *match*/285))))
+             12)))))
+  (apply (field_mut 1 (global Toploop!)) "lazy_total" lazy_total/281))
+val lazy_total : unit lazy_t ref * bool t -> int = <fun>
+|}];;
+
+let lazy_needs_partial : _ * bool t ref -> int = function
+  | (_, { contents = True }) -> 0
+  | (lazy (), { contents = False }) -> 12
+(* This pattern-matching is partial: a Match_failure case is
+   necessary for soundness. *)
+[%%expect {|
+(let
+  (lazy_needs_partial/295 =
+     (function param/297 : int
+       (catch
+         (let
+           (*match*/298 =a (field_imm 0 param/297)
+            *match*/300 =o (field_mut 0 (field_imm 1 param/297)))
+           (switch* *match*/300
+            case int 0: 0
+            case int 1:
+             (let
+               (*match*/303 =
+                  (let (tag/302 =a (caml_obj_tag *match*/298))
+                    (if (== tag/302 250) (field_mut 0 *match*/298)
+                      (if (|| (== tag/302 246) (== tag/302 244))
+                        (apply (field_imm 1 (global CamlinternalLazy!))
+                          (opaque *match*/298))
+                        *match*/298)))
+                *match*/305 =o (field_mut 0 (field_imm 1 param/297)))
+               (if (isint *match*/305) (if *match*/305 12 (exit 3)) (exit 3)))))
+        with (3)
+         (raise (makeblock 0 (global Match_failure/20!) [0: "" 1 49])))))
+  (apply (field_mut 1 (global Toploop!)) "lazy_needs_partial"
+    lazy_needs_partial/295))
+val lazy_needs_partial : unit lazy_t * bool t ref -> int = <fun>
+|}];;
+
+let guard_total : bool t ref -> int = function
+  | _ when Sys.opaque_identity false -> 1
+  | { contents = True } -> 0
+  | { contents = False } -> 12
+(* This pattern-matching is total: a Match_failure case is not
+   necessary for soundness. *)
+[%%expect {|
+(let
+  (guard_total/306 =
+     (function param/383 : int
+       (if (opaque 0) 1
+         (let (*match*/384 =o (field_mut 0 param/383))
+           (if (isint *match*/384) (if *match*/384 12 0)
+             (raise (makeblock 0 (global Match_failure/20!) [0: "" 1 38])))))))
+  (apply (field_mut 1 (global Toploop!)) "guard_total" guard_total/306))
+val guard_total : bool t ref -> int = <fun>
+|}];;
+
+let guard_needs_partial : bool t ref -> int = function
+  | { contents = True } -> 0
+  | _ when Sys.opaque_identity false -> 1
+  | { contents = False } -> 12
+(* This pattern-matching is partial: a Match_failure case is
+   necessary for soundness. *)
+[%%expect {|
+(let
+  (guard_needs_partial/385 =
+     (function param/387 : int
+       (let (*match*/388 =o (field_mut 0 param/387))
+         (catch (if (isint *match*/388) (if *match*/388 (exit 9) 0) (exit 9))
+          with (9)
+           (if (opaque 0) 1
+             (if (isint *match*/388) 12
+               (raise (makeblock 0 (global Match_failure/20!) [0: "" 1 46]))))))))
+  (apply (field_mut 1 (global Toploop!)) "guard_needs_partial"
+    guard_needs_partial/385))
+val guard_needs_partial : bool t ref -> int = <fun>
+|}];;

diff --git a/testsuite/tests/match-side-effects/partiality.ml b/testsuite/tests/match-side-effects/partiality.ml
index 916524c41840ca06d57602a39bf8c3741eea0a25..b833dcb5963bef48b4cb1ae61f2bdc6d9f21ef47 100644 (file)
--- a/testsuite/tests/match-side-effects/partiality.ml
+++ b/testsuite/tests/match-side-effects/partiality.ml
@@ -3,6 +3,14 @@
  expect;
 *)
 
+(* We explicitly enable the warning (see the discussion in the
+   "Warning reference" section of the reference manual), which makes
+   it clear which examples have been intentionally pessimized by the
+   compiler. *)
+#warnings "+degraded-to-partial-match";;
+[%%expect {|
+|}];;
+
 (* The original example of unsoundness in #7421. *)
 type t = {a: bool; mutable b: int option}
 
@@ -17,12 +25,20 @@ let f x =
    (field_mut 1) access, or the second access should include
    a Match_failure case.
 
-   FAIL: the second occurrence of (field_mut 1) is used with a direct
-   (field_imm 0) access without a constructor check. The compiler is
-   unsound here. *)
+   PASS: the second access includes a Match_failure case. *)
 [%%expect {|
 0
 type t = { a : bool; mutable b : int option; }
+Lines 4-8, characters 2-32:
+4 | ..match x with
+5 |   | {a = false; b = _} -> 0
+6 |   | {a = _;     b = None} -> 1
+7 |   | {a = _;     b = _} when (x.b <- None; false) -> 2
+8 |   | {a = true;  b = Some y} -> y
+Warning 74 [degraded-to-partial-match]: This pattern-matching is compiled
+as partial, even if it appears to be total. It may generate a Match_failure
+exception. This typically occurs due to complex matches on mutable fields.
+(see manual section 13.5.5)
 (let
   (f/280 =
      (function x/282 : int
@@ -31,10 +47,13 @@ type t = { a : bool; mutable b : int option; }
            (if *match*/286
              (if (seq (setfield_ptr 1 x/282 0) 0) 2
                (let (*match*/287 =o (field_mut 1 x/282))
-                 (field_imm 0 *match*/287)))
+                 (if *match*/287 (field_imm 0 *match*/287)
+                   (raise
+                     (makeblock 0 (global Match_failure/20!) [0: "" 4 2])))))
              1))
          0)))
   (apply (field_mut 1 (global Toploop!)) "f" f/280))
+
 val f : t -> int = <fun>
 |}]
 
@@ -44,24 +63,59 @@ val f : t -> int = <fun>
    inside a mutable position. *)
 type t = {a: bool; mutable b: int option}
 
+let simple x =
+  match x with
+  | {b = None} -> 1
+  | {b = Some y} -> y
+;;
+(* Performance expectation: there should not be a Match_failure case. *)
+[%%expect {|
+0
+type t = { a : bool; mutable b : int option; }
+(let
+  (simple/291 =
+     (function x/293 : int
+       (let (*match*/296 =o (field_mut 1 x/293))
+         (if *match*/296 (field_imm 0 *match*/296) 1))))
+  (apply (field_mut 1 (global Toploop!)) "simple" simple/291))
+val simple : t -> int = <fun>
+|}]
+
+(* This more complex case has the switch on [b] split across two cases
+   on [a], so it may need a [Match_failure] for soundness -- it does
+   if the two accesses to [b] are done on different reads of the same
+   mutable field.
+
+   PASS: two reads of [field_mut 1 x], and a Match_failure case. *)
 let f x =
   match x with
   | {a = false; b = _} -> 0
   | {a = _;     b = None} -> 1
   | {a = true;  b = Some y} -> y
 ;;
-(* Performance expectation: there should not be a Match_failure case. *)
 [%%expect {|
-0
-type t = { a : bool; mutable b : int option; }
+Lines 2-5, characters 2-32:
+2 | ..match x with
+3 |   | {a = false; b = _} -> 0
+4 |   | {a = _;     b = None} -> 1
+5 |   | {a = true;  b = Some y} -> y
+Warning 74 [degraded-to-partial-match]: This pattern-matching is compiled
+as partial, even if it appears to be total. It may generate a Match_failure
+exception. This typically occurs due to complex matches on mutable fields.
+(see manual section 13.5.5)
 (let
-  (f/291 =
-     (function x/292 : int
-       (if (field_int 0 x/292)
-         (let (*match*/296 =o (field_mut 1 x/292))
-           (if *match*/296 (field_imm 0 *match*/296) 1))
+  (f/297 =
+     (function x/298 : int
+       (if (field_int 0 x/298)
+         (let (*match*/302 =o (field_mut 1 x/298))
+           (if *match*/302 (field_imm 0 *match*/302)
+             (let (*match*/303 =o (field_mut 1 x/298))
+               (if *match*/303
+                 (raise (makeblock 0 (global Match_failure/20!) [0: "" 2 2]))
+                 1))))
          0)))
-  (apply (field_mut 1 (global Toploop!)) "f" f/291))
+  (apply (field_mut 1 (global Toploop!)) "f" f/297))
+
 val f : t -> int = <fun>
 |}]
 
@@ -76,29 +130,40 @@ let f r =
   | None -> 3
 ;;
 (* Correctness condition: there should either be a single
-   (field_mut 1) access, or the second access should include
+   (field_mut 0) access, or the second access should include
    a Match_failure case.
 
-   FAIL: the second occurrence of (field_mut 0) is used with a direct
-   (field_imm 0) access without a constructor check. The compiler is
-   unsound here. *)
+   PASS: two different reads (field_mut 0), and a Match_failure case. *)
 [%%expect {|
+Lines 2-6, characters 2-13:
+2 | ..match Some r with
+3 |   | Some { contents = None } -> 0
+4 |   | _ when (r := None; false) -> 1
+5 |   | Some { contents = Some n } -> n
+6 |   | None -> 3
+Warning 74 [degraded-to-partial-match]: This pattern-matching is compiled
+as partial, even if it appears to be total. It may generate a Match_failure
+exception. This typically occurs due to complex matches on mutable fields.
+(see manual section 13.5.5)
 (let
-  (f/298 =
-     (function r/299 : int
-       (let (*match*/301 = (makeblock 0 r/299))
+  (f/304 =
+     (function r/305 : int
+       (let (*match*/307 = (makeblock 0 r/305))
          (catch
-           (if *match*/301
-             (let (*match*/303 =o (field_mut 0 (field_imm 0 *match*/301)))
-               (if *match*/303 (exit 7) 0))
-             (exit 7))
-          with (7)
-           (if (seq (setfield_ptr 0 r/299 0) 0) 1
-             (if *match*/301
-               (let (*match*/305 =o (field_mut 0 (field_imm 0 *match*/301)))
-                 (field_imm 0 *match*/305))
+           (if *match*/307
+             (let (*match*/309 =o (field_mut 0 (field_imm 0 *match*/307)))
+               (if *match*/309 (exit 13) 0))
+             (exit 13))
+          with (13)
+           (if (seq (setfield_ptr 0 r/305 0) 0) 1
+             (if *match*/307
+               (let (*match*/311 =o (field_mut 0 (field_imm 0 *match*/307)))
+                 (if *match*/311 (field_imm 0 *match*/311)
+                   (raise
+                     (makeblock 0 (global Match_failure/20!) [0: "" 2 2]))))
                3))))))
-  (apply (field_mut 1 (global Toploop!)) "f" f/298))
+  (apply (field_mut 1 (global Toploop!)) "f" f/304))
+
 val f : int option ref -> int = <fun>
 |}]
 
@@ -118,10 +183,10 @@ let test = function
 0
 type _ t = Int : int -> int t | Bool : bool -> bool t
 (let
-  (test/309 =
-     (function param/312 : int
-       (if param/312 (field_imm 0 (field_imm 0 param/312)) 0)))
-  (apply (field_mut 1 (global Toploop!)) "test" test/309))
+  (test/315 =
+     (function param/318 : int
+       (if param/318 (field_imm 0 (field_imm 0 param/318)) 0)))
+  (apply (field_mut 1 (global Toploop!)) "test" test/315))
 val test : int t option -> int = <fun>
 |}]
 
@@ -139,11 +204,11 @@ let test = function
 0
 type _ t = Int : int -> int t | Bool : bool -> bool t
 (let
-  (test/317 =
-     (function param/319 : int
-       (let (*match*/320 =o (field_mut 0 param/319))
-         (if *match*/320 (field_imm 0 (field_imm 0 *match*/320)) 0))))
-  (apply (field_mut 1 (global Toploop!)) "test" test/317))
+  (test/323 =
+     (function param/325 : int
+       (let (*match*/326 =o (field_mut 0 param/325))
+         (if *match*/326 (field_imm 0 (field_imm 0 *match*/326)) 0))))
+  (apply (field_mut 1 (global Toploop!)) "test" test/323))
 val test : int t option ref -> int = <fun>
 |}]
 
@@ -164,18 +229,285 @@ let test n =
 0
 type _ t = Int : int -> int t | Bool : bool -> bool t
 (let
-  (test/325 =
-     (function n/326 : int
+  (test/331 =
+     (function n/332 : int
        (let
-         (*match*/329 =
+         (*match*/335 =
             (makeblock 0 (makeblock 0 (makemutable 0 (int) 1) [0: 42])))
-         (if *match*/329
+         (if *match*/335
            (let
-             (*match*/330 =a (field_imm 0 *match*/329)
-              *match*/332 =o (field_mut 0 (field_imm 0 *match*/330)))
-             (if *match*/332 (field_imm 0 (field_imm 1 *match*/330))
-               (~ (field_imm 0 (field_imm 1 *match*/330)))))
+             (*match*/336 =a (field_imm 0 *match*/335)
+              *match*/338 =o (field_mut 0 (field_imm 0 *match*/336)))
+             (if *match*/338 (field_imm 0 (field_imm 1 *match*/336))
+               (~ (field_imm 0 (field_imm 1 *match*/336)))))
            3))))
-  (apply (field_mut 1 (global Toploop!)) "test" test/325))
+  (apply (field_mut 1 (global Toploop!)) "test" test/331))
 val test : 'a -> int = <fun>
 |}]
+
+
+
+(* In this example, the constructor on which unsound assumptions could
+   be made is not located directly below a mutable constructor, but
+   one level deeper inside an immutable pair constructor (below the
+   mutable constructor). This checks that there is a form of
+   "transitive" propagation of mutability.
+
+   Correctness condition: either there is a single mutable field read,
+   or the accesses below the second mutable read have a Match_failure
+   case.
+*)
+let deep r =
+  match Some r with
+  | Some { contents = ((), None) } -> 0
+  | _ when (r := ((), None); false) -> 1
+  | Some { contents = ((), Some n) } -> n
+  | None -> 3
+;;
+(* PASS: two different reads (field_mut 0), and a Match_failure case. *)
+[%%expect {|
+Lines 2-6, characters 2-13:
+2 | ..match Some r with
+3 |   | Some { contents = ((), None) } -> 0
+4 |   | _ when (r := ((), None); false) -> 1
+5 |   | Some { contents = ((), Some n) } -> n
+6 |   | None -> 3
+Warning 74 [degraded-to-partial-match]: This pattern-matching is compiled
+as partial, even if it appears to be total. It may generate a Match_failure
+exception. This typically occurs due to complex matches on mutable fields.
+(see manual section 13.5.5)
+(let
+  (deep/341 =
+     (function r/343 : int
+       (let (*match*/345 = (makeblock 0 r/343))
+         (catch
+           (if *match*/345
+             (let (*match*/347 =o (field_mut 0 (field_imm 0 *match*/345)))
+               (if (field_imm 1 *match*/347) (exit 21) 0))
+             (exit 21))
+          with (21)
+           (if (seq (setfield_ptr 0 r/343 [0: 0 0]) 0) 1
+             (if *match*/345
+               (let
+                 (*match*/351 =o (field_mut 0 (field_imm 0 *match*/345))
+                  *match*/353 =a (field_imm 1 *match*/351))
+                 (if *match*/353 (field_imm 0 *match*/353)
+                   (raise
+                     (makeblock 0 (global Match_failure/20!) [0: "" 2 2]))))
+               3))))))
+  (apply (field_mut 1 (global Toploop!)) "deep" deep/341))
+
+val deep : (unit * int option) ref -> int = <fun>
+|}]
+
+
+(* In this example:
+   - the pattern-matching is total, with subtle GADT usage
+     (only the type-checker can tell that it is Total)
+   - there are no mutable fields
+
+   Performance expectation: there should not be a Match_failure clause.
+
+   This example is a reduction of a regression caused by #13076 on the
+   'CamlinternalFormat.trans' function in the standard library.
+*)
+type _ t = Bool : bool t | Int : int t | Char : char t;;
+let test : type a . a t * a t -> unit = function
+  | Int, Int -> ()
+  | Bool, Bool -> ()
+  | _, Char -> ()
+;;
+(* PASS: no Match_failure clause generated. *)
+[%%expect {|
+0
+type _ t = Bool : bool t | Int : int t | Char : char t
+(let
+  (test/358 =
+     (function param/360 : int
+       (catch
+         (if (>= (field_imm 0 param/360) 2) (exit 24)
+           (if (>= (field_imm 1 param/360) 2) (exit 24) 0))
+        with (24) 0)))
+  (apply (field_mut 1 (global Toploop!)) "test" test/358))
+val test : 'a t * 'a t -> unit = <fun>
+|}];;
+
+(* Another regression testcase from #13076, proposed by Nick Roberts.
+
+   Performance expectation: no Match_failure clause.
+*)
+type nothing = |
+type t = A | B | C of nothing
+let f : bool * t -> int = function
+  | true, A -> 3
+  | false, A -> 4
+  | _, B -> 5
+  | _, C _ -> .
+(* PASS: no Match_failure clause generated. *)
+[%%expect {|
+0
+type nothing = |
+0
+type t = A | B | C of nothing
+(let
+  (f/370 =
+     (function param/371 : int
+       (catch
+         (if (field_imm 0 param/371)
+           (switch* (field_imm 1 param/371)
+            case int 0: 3
+            case int 1: (exit 27))
+           (switch* (field_imm 1 param/371)
+            case int 0: 4
+            case int 1: (exit 27)))
+        with (27) 5)))
+  (apply (field_mut 1 (global Toploop!)) "f" f/370))
+val f : bool * t -> int = <fun>
+|}];;
+
+
+(* Another regression testcase from #13076, proposed by Nick Roberts.
+
+   Performance expectation: no Match_failure clause.
+*)
+type t =
+  | A of int
+  | B of string
+  | C of string
+  | D of string
+
+let compare t1 t2 =
+  match t1, t2 with
+  | A i, A j -> Int.compare i j
+  | B l1, B l2 -> String.compare l1 l2
+  | C l1, C l2 -> String.compare l1 l2
+  | D l1, D l2 -> String.compare l1 l2
+  | A _, (B _ | C _ | D _ ) -> -1
+  | (B _ | C _ | D _ ), A _ -> 1
+  | B _, (C _ | D _) -> -1
+  | (C _ | D _), B _ -> 1
+  | C _, D _ -> -1
+  | D _, C _ -> 1
+(* PASS: no Match_failure clause generated. *)
+[%%expect {|
+0
+type t = A of int | B of string | C of string | D of string
+(let
+  (compare/381 =
+     (function t1/382 t2/383 : int
+       (catch
+         (switch* t1/382
+          case tag 0:
+           (switch t2/383
+            case tag 0:
+             (apply (field_imm 8 (global Stdlib__Int!)) (field_imm 0 t1/382)
+               (field_imm 0 t2/383))
+            default: -1)
+          case tag 1:
+           (catch
+             (switch* t2/383
+              case tag 0: (exit 31)
+              case tag 1:
+               (apply (field_imm 9 (global Stdlib__String!))
+                 (field_imm 0 t1/382) (field_imm 0 t2/383))
+              case tag 2: (exit 36)
+              case tag 3: (exit 36))
+            with (36) -1)
+          case tag 2:
+           (switch* t2/383
+            case tag 0: (exit 31)
+            case tag 1: (exit 31)
+            case tag 2:
+             (apply (field_imm 9 (global Stdlib__String!))
+               (field_imm 0 t1/382) (field_imm 0 t2/383))
+            case tag 3: -1)
+          case tag 3:
+           (switch* t2/383
+            case tag 0: (exit 31)
+            case tag 1: (exit 31)
+            case tag 2: 1
+            case tag 3:
+             (apply (field_imm 9 (global Stdlib__String!))
+               (field_imm 0 t1/382) (field_imm 0 t2/383))))
+        with (31) (switch* t2/383 case tag 0: 1
+                                  case tag 1: 1))))
+  (apply (field_mut 1 (global Toploop!)) "compare" compare/381))
+val compare : t -> t -> int = <fun>
+|}];;
+
+
+(* Different testcases involving or-patterns and polymorphic variants,
+   proposed by Nick Roberts. In both cases, we do *not* expect a Match_failure case. *)
+
+let f x y =
+ match x, y with
+ | _, `Y1 -> 0
+ | `X1, `Y2 -> 1
+ | (`X2 | `X3), `Y3 -> 2
+ | `X1, `Y3
+ | `X2, `Y2
+ | `X3, _  -> 3
+(* PASS: no Match_failure generated *)
+[%%expect {|
+(let
+  (f/503 =
+     (function x/504[int] y/505[int] : int
+       (catch
+         (catch
+           (catch
+             (if (isint y/505) (if (!= y/505 19896) (exit 45) 0) (exit 45))
+            with (45)
+             (if (!= x/504 19674)
+               (if (>= x/504 19675) (exit 44)
+                 (if (>= y/505 19898) (exit 42) 1))
+               (if (isint y/505) (if (!= y/505 19897) (exit 44) (exit 42))
+                 (exit 44))))
+          with (44)
+           (if (isint y/505) (if (!= y/505 19898) (exit 42) 2) (exit 42)))
+        with (42) 3)))
+  (apply (field_mut 1 (global Toploop!)) "f" f/503))
+val f : [< `X1 | `X2 | `X3 ] -> [< `Y1 | `Y2 | `Y3 ] -> int = <fun>
+|}];;
+
+
+let check_results r1 r2 =
+  match r1 r2 with
+  | (Ok _ as r), _ | _, (Ok _ as r) -> r
+  | (Error `A as r), Error _
+  | Error _, (Error `A as r) -> r
+  | (Error `B as r), Error `B -> r
+(* PASS: no Match_failure case generated *)
+[%%expect {|
+(let
+  (check_results/506 =
+     (function r1/508 r2/509
+       (let (*match*/515 = (apply r1/508 r2/509))
+         (catch
+           (catch
+             (let (r/514 =a (field_imm 0 *match*/515))
+               (catch
+                 (switch* r/514
+                  case tag 0: (exit 50 r/514)
+                  case tag 1:
+                   (catch
+                     (if (>= (field_imm 0 r/514) 66)
+                       (let (*match*/523 =a (field_imm 1 *match*/515))
+                         (switch* *match*/523
+                          case tag 0: (exit 52)
+                          case tag 1:
+                           (let (*match*/524 =a (field_imm 0 *match*/523))
+                             (if (isint *match*/524)
+                               (if (!= *match*/524 66) (exit 53) r/514)
+                               (exit 53)))))
+                       (switch* (field_imm 1 *match*/515)
+                        case tag 0: (exit 52)
+                        case tag 1: (exit 51 r/514)))
+                    with (53) (exit 51 (field_imm 1 *match*/515))))
+                with (52) (exit 50 (field_imm 1 *match*/515))))
+            with (50 r/510) r/510)
+          with (51 r/512) r/512))))
+  (apply (field_mut 1 (global Toploop!)) "check_results" check_results/506))
+val check_results :
+  ('a -> ('b, [< `A | `B ]) result * ('b, [< `A | `B ]) result) ->
+  'a -> ('b, [> `A | `B ]) result = <fun>
+|}];;

diff --git a/testsuite/tests/match-side-effects/pr13152.ml b/testsuite/tests/match-side-effects/pr13152.ml
new file mode 100644 (file)
index 0000000..d0f132a
--- /dev/null
+++ b/testsuite/tests/match-side-effects/pr13152.ml
@@ -0,0 +1,38 @@
+(* TEST
+ expect;
+*)
+
+(** This example from Nick Roberts demonstrates that the following combination is possible:
+    - the pattern-matching is Total according to the type-checker
+    - the last clause is not taken, we get Match_failure instead
+    - the scrutinee changes values, but it *never* matches the last clause.
+
+    In particular, "optimizing" the last clause into a wildcard when
+    the whole pattern-matching is total would give fairly dubious
+    behavior here. We suspect that the example could be tweaked with
+    judicious uses of GADTs to break type-soundness if optimized in
+    this way. *)
+
+type 'a myref = { mutable mut : 'a }
+type abc = A | B | C
+type t = {a: bool; b: abc myref }
+
+let example () =
+  let input = { a = true; b = { mut = A } } in
+  match input with
+  | {a = false; b = _} -> 1
+  | {a = _;     b = { mut = B }} -> 2
+  | {a = _;     b = _} when (input.b.mut <- B; false) -> 3
+  | {a = true;  b = { mut = A }} -> 4
+  | {a = _;     b = _} when (input.b.mut <- A; false) -> 5
+  | {a = true;  b = { mut = C }} -> 6
+;;
+
+let (_ : int) = example ()
+[%%expect {|
+type 'a myref = { mutable mut : 'a; }
+type abc = A | B | C
+type t = { a : bool; b : abc myref; }
+val example : unit -> int = <fun>
+Exception: Match_failure ("", 18, 2).
+|}];;

diff --git a/testsuite/tests/match-side-effects/test_contexts_code.ml b/testsuite/tests/match-side-effects/test_contexts_code.ml
index c2c679de02a8a993e89d71970f50e8a9914d4b5c..6977fd1f4ba972b06164b7fb20fc236a9cbb4495 100644 (file)
--- a/testsuite/tests/match-side-effects/test_contexts_code.ml
+++ b/testsuite/tests/match-side-effects/test_contexts_code.ml
@@ -7,9 +7,10 @@
 #use "contexts_1.ml";;
 (* Notice that (field_mut 1 input) occurs twice, it
    is evaluated once in the 'false' branch and once in the 'true'
-   branch. The compiler assumes that its static knowledge about the
+   branch. The compiler does not assume that its static knowledge about the
    first read (it cannot be a [Right] as we already matched against it
-   and failed) also applies to the second read, which is unsound.
+   and failed) also applies to the second read, and it inserts a Match_failure
+   case if [Right] is read again.
 *)
 [%%expect {|
 
@@ -39,7 +40,12 @@ let example_1 () =
               case tag 0:
                (if (seq (setfield_ptr 1 input/312 [1: 3]) 0) [1: 3]
                  (let (*match*/339 =o (field_mut 1 input/312))
-                   (makeblock 0 (int) (field_imm 0 *match*/339))))
+                   (switch* *match*/339
+                    case tag 0: (makeblock 0 (int) (field_imm 0 *match*/339))
+                    case tag 1:
+                     (raise
+                       (makeblock 0 (global Match_failure/20!)
+                         [0: "contexts_1.ml" 17 2])))))
               case tag 1: [1: 2]))
            [1: 1]))))
   (apply (field_mut 1 (global Toploop!)) "example_1" example_1/310))
@@ -81,7 +87,12 @@ let example_2 () =
                (if (seq (setfield_ptr 0 (field_imm 1 input/348) [1: 3]) 0)
                  [1: 3]
                  (let (*match*/357 =o (field_mut 0 (field_imm 1 input/348)))
-                   (makeblock 0 (int) (field_imm 0 *match*/357))))
+                   (switch* *match*/357
+                    case tag 0: (makeblock 0 (int) (field_imm 0 *match*/357))
+                    case tag 1:
+                     (raise
+                       (makeblock 0 (global Match_failure/20!)
+                         [0: "contexts_2.ml" 11 2])))))
               case tag 1: [1: 2]))
            [1: 1]))))
   (apply (field_mut 1 (global Toploop!)) "example_2" example_2/346))

diff --git a/testsuite/tests/match-side-effects/test_contexts_results.ml b/testsuite/tests/match-side-effects/test_contexts_results.ml
index a4126366cbdf0a74263518bf1a79c5a095209281..9078358f21beff4c568e1b0c79b676f373c29805 100644 (file)
--- a/testsuite/tests/match-side-effects/test_contexts_results.ml
+++ b/testsuite/tests/match-side-effects/test_contexts_results.ml
@@ -10,10 +10,10 @@ val example_1 : unit -> (bool, int) Result.t = <fun>
 |}]
 
 let _ = example_1 ();;
-(* <unknown constructor> means that we got an 'unsound boolean',
-   which is neither 'true' nor 'false'. There was a bug here! *)
+(* Getting a Match_failure is not the only reasonable behavior
+   for this test, but it is sound. *)
 [%%expect {|
-- : (bool, int) Result.t = Result.Ok <unknown constructor>
+Exception: Match_failure ("contexts_1.ml", 17, 2).
 |}]
 
 #use "contexts_2.ml";;
@@ -24,9 +24,9 @@ val example_2 : unit -> (bool, int) Result.t = <fun>
 |}];;
 
 let _ = example_2 ();;
-(* Also a bug! *)
+(* same as [example_1 ()] *)
 [%%expect {|
-- : (bool, int) Result.t = Result.Ok <unknown constructor>
+Exception: Match_failure ("contexts_2.ml", 11, 2).
 |}]
 
 #use "contexts_3.ml";;

diff --git a/testsuite/tests/memory-model/forbidden.ml b/testsuite/tests/memory-model/forbidden.ml
index 9227a2f559691f536d21f3a3a799f48943864525..676904c15fef6130560b1371d0ef7f9c166866d6 100644 (file)
--- a/testsuite/tests/memory-model/forbidden.ml
+++ b/testsuite/tests/memory-model/forbidden.ml
@@ -292,6 +292,55 @@ module MP = struct
 
   end
 
+
+  module PAPAP = struct
+    (* This (forbidden) test is analog to MP+PA above.
+     * In fact, it includes PA which tests the following,
+     * forbidden "Message passing" execution:
+     *
+     *       +-------Fr------------+
+     *       |                     |
+     *      \/                     |
+     *     W[x]1    +----> RA[y]1  |
+     *       |      |         |    |
+     *       |      Rf        |    |
+     *      \/      |        \/    |
+     *      WA[y]1--+       R[x]0--+
+     *
+     * However, when one adds a non atomic read `!x` _before_
+     * the atomic read `Atomic.get y`, and if the native compiler
+     * CSE changes the second  non atomic read `!x` into a
+     * temporary (register) read, then the function code1
+     * now behaves as:
+     *   let r2 = !x in
+     *   let r0 = Atomic_get y in
+     *   let r1 = r2 in ...
+     *
+     * In effect, code1 now behaves as if the second non-atomic
+     * read !x has moved _before_ the atomic read of `y`, which
+     * the model forbids.
+     *)
+    module Key = MakeKey(struct let name = "MP+PA+PAP" end)(NO)
+
+    module Env = EnvPA
+
+    type out0 = unit
+
+    let code0 (x,y) =
+      x := 1 ;
+      Atomic.set y 1
+
+    type out1 = { t0:int; t1:int; }
+
+    let code1 (x,y) =
+      let r2 = !x in
+      let r0 =  Atomic.get y in
+      let r1 = !x in
+      {t0=r0; t1=r1+r2;}
+
+    let out2key _ () { t0; t1; } = Key.make t0 t1
+
+  end
   module PFetch = struct
 
     module Key = MakeKey(struct let name = "MP+PFetch" end)(NO)
@@ -698,6 +747,8 @@ module Forbid(C:Opt.Config) = struct
   let () = TB.zyva()
   module TC = Run(S.AA)
   let () = TC.zyva()
+  module TD = Run(MP.PAPAP)
+  let () = TD.zyva()
 end
 
 module Allow(C:Opt.Config) = struct

diff --git a/testsuite/tests/memory-model/forbidden.reference b/testsuite/tests/memory-model/forbidden.reference
index 3175acd35d2d0a07883a91b14d537a0914a4732f..5420c014eb2f9fcc7b1d3defff2b19d80ac225c0 100644 (file)
--- a/testsuite/tests/memory-model/forbidden.reference
+++ b/testsuite/tests/memory-model/forbidden.reference
@@ -14,6 +14,7 @@ Observation 2+2W+AA Never
 Observation S+PA Never
 Observation S+AP Never
 Observation S+AA Never
+Observation MP+PA+PAP Never
 Observation SB+AA Never
 Observation R+PA Never
 Observation R+AA Never
@@ -30,3 +31,4 @@ Observation 2+2W+AA Never
 Observation S+PA Never
 Observation S+AP Never
 Observation S+AA Never
+Observation MP+PA+PAP Never

diff --git a/testsuite/tests/parallel/domain_parallel_spawn_burn.ml b/testsuite/tests/parallel/domain_parallel_spawn_burn.ml
index 5801f3afdbb620d325120648cc3df57f301ec883..46a3d55d4aeaa0f11ae081b635f6842967c30659 100644 (file)
--- a/testsuite/tests/parallel/domain_parallel_spawn_burn.ml
+++ b/testsuite/tests/parallel/domain_parallel_spawn_burn.ml
@@ -1,18 +1,17 @@
-(* TEST *)
+(* TEST
+  include unix;
+  hasunix;
+  { bytecode; } { native; }
+ *)
 
 open Domain
 
-(* This test looks to spawn domains while doing a bunch of explicit minor and major GC calls
-   from parallel domains *)
+(* This test looks to spawn domains while doing a bunch of explicit
+   minor and major GC calls from parallel domains *)
 
 let test_size =
   try int_of_string (Sys.getenv "OCAML_TEST_SIZE")
-  with Not_found | Failure _ -> 0
-
-(* Don't run the test if we have only 2 cores available, it times out often. *)
-
-let _  =
-  if test_size <= 1 then begin print_endline "ok"; exit 0 end
+  with Not_found | Failure _ -> 2
 
 let (list_size, num_domains) =
   if test_size >= 2 then (14, 25) else (13, 12)
@@ -23,10 +22,8 @@ let rec burn l =
     burn (l @ l |> List.map (fun x -> x + 1))
 
 let test_parallel_spawn () =
-  for i = 1 to 20 do
     Array.init num_domains (fun _ -> Domain.spawn (fun () -> burn [0]))
     |> Array.iter join
-  done
 
 let () =
   let running = Atomic.make true in
@@ -36,13 +33,19 @@ let () =
     done
   in
 
-  let domain_minor_gc = Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.minor ())) in
-  let domain_major_gc = Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.major ())) in
+  let domain_minor_gc =
+    Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.minor ()))
+  in
+  let domain_major_gc =
+    Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.major ()))
+  in
+  let domain_parallel_spawn = Domain.spawn test_parallel_spawn in
 
-  test_parallel_spawn ();
+  Unix.sleep 3;
 
   Atomic.set running false;
   join domain_minor_gc;
   join domain_major_gc;
+  join domain_parallel_spawn;
 
   print_endline "ok"

diff --git a/testsuite/tests/parallel/domain_parallel_spawn_burn_gc_set.ml b/testsuite/tests/parallel/domain_parallel_spawn_burn_gc_set.ml
index 6b8a2c6fa46f8b57d27c469123e99c1294d64efb..37a441d293bcbef04e8c04bdc9a4cfe12bffd777 100644 (file)
--- a/testsuite/tests/parallel/domain_parallel_spawn_burn_gc_set.ml
+++ b/testsuite/tests/parallel/domain_parallel_spawn_burn_gc_set.ml
@@ -1,4 +1,8 @@
-(* TEST *)
+(* TEST
+  include unix;
+  hasunix;
+  { bytecode; } { native; }
+ *)
 
 open Domain
 
@@ -16,15 +20,10 @@ let rec set_gc l =
 
 let test_size =
   try int_of_string (Sys.getenv "OCAML_TEST_SIZE")
-  with Not_found | Failure _ -> 0
+  with Not_found | Failure _ -> 2
 
-let (list_size, num_domains, niters) =
-  if test_size >= 2 then (14, 8, 20) else (13, 4, 5)
-
-(* Don't run the test if we have only 2 cores available, it times out often. *)
-
-let _  =
-  if test_size <= 1 then begin print_endline "ok"; exit 0 end
+let (list_size, num_domains) =
+  if test_size >= 2 then (14, 8) else (13, 4)
 
 let rec burn l =
   if List.hd l > list_size then ()
@@ -32,10 +31,8 @@ let rec burn l =
     burn (l @ l |> List.map (fun x -> x + 1))
 
 let test_parallel_spawn () =
-  for i = 1 to niters do
     Array.init num_domains (fun _ -> Domain.spawn (fun () -> burn [0]))
     |> Array.iter join
-  done
 
 let () =
   let running = Atomic.make true in
@@ -51,13 +48,15 @@ let () =
     Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.major ())) in
   let domain_set_gc = Domain.spawn (run_until_stop (fun () -> set_gc 1; )) in
   let domain_set_gc2 = Domain.spawn (run_until_stop (fun () -> set_gc 3; )) in
+  let domain_parallel_spawn = Domain.spawn test_parallel_spawn in
 
-  test_parallel_spawn ();
+  Unix.sleep 3;
 
   Atomic.set running false;
   join domain_minor_gc;
   join domain_set_gc;
   join domain_major_gc;
   join domain_set_gc2;
+  join domain_parallel_spawn;
 
   print_endline "ok"

diff --git a/testsuite/tests/parallel/domain_serial_spawn_burn.ml b/testsuite/tests/parallel/domain_serial_spawn_burn.ml
index fb931e298a6c6da4d13fc0377269411019768186..718bc7ac513dfc1ecc114c0639385d43f49e245c 100644 (file)
--- a/testsuite/tests/parallel/domain_serial_spawn_burn.ml
+++ b/testsuite/tests/parallel/domain_serial_spawn_burn.ml
@@ -12,17 +12,14 @@ open Domain
 
 let test_size =
   try int_of_string (Sys.getenv "OCAML_TEST_SIZE")
-  with Not_found | Failure _ -> 0
+  with Not_found | Failure _ -> 2
 
 
-(* This test looks to spawn domains while doing a bunch of explicit minor and major GC calls
-   from parallel domains *)
-
-(* Don't run the test if we have only 2 cores available, it times out often. *)
+(* This test looks to spawn domains while doing a bunch of explicit
+   minor and major GC calls from parallel domains *)
 
 let list_size =
-  if test_size < 2 then begin print_endline "ok"; exit 0 end
-  else if test_size = 2 then 14
+  if test_size = 2 then 14
   else 15
 
 let rec burn l =
@@ -31,7 +28,7 @@ let rec burn l =
     burn (l @ l |> List.map (fun x -> x + 1))
 
 let test_serial_domain_spawn () =
-  for i = 1 to 250 do
+  for i = 1 to 10 do
     let d = Domain.spawn (fun () -> burn [0]) in
     join d
   done
@@ -44,13 +41,19 @@ let () =
     done
   in
 
-  let domain_minor_gc = Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.minor ())) in
-  let domain_major_gc = Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.major ())) in
+  let domain_minor_gc =
+    Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.minor ()))
+  in
+  let domain_major_gc =
+    Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.major ()))
+  in
+  let domain_serial_domain_spawn = Domain.spawn test_serial_domain_spawn in
 
-  test_serial_domain_spawn ();
+  Unix.sleep 3;
 
   Atomic.set running false;
   join domain_minor_gc;
   join domain_major_gc;
+  join domain_serial_domain_spawn;
 
   print_endline "ok"

diff --git a/testsuite/tests/parallel/max_domains1.ml b/testsuite/tests/parallel/max_domains1.ml
new file mode 100644 (file)
index 0000000..0bb85e5
--- /dev/null
+++ b/testsuite/tests/parallel/max_domains1.ml
@@ -0,0 +1,8 @@
+(* TEST
+ ocamlrunparam += ",d=1";
+*)
+
+let _ =
+  try
+    Domain.spawn (fun _ -> print_endline "Expect failure") |> ignore
+  with Failure _ -> print_string "ok\n"

diff --git a/testsuite/tests/parallel/max_domains1.reference b/testsuite/tests/parallel/max_domains1.reference
new file mode 100644 (file)
index 0000000..9766475
--- /dev/null
+++ b/testsuite/tests/parallel/max_domains1.reference
@@ -0,0 +1 @@
+ok

diff --git a/testsuite/tests/parallel/max_domains2.ml b/testsuite/tests/parallel/max_domains2.ml
new file mode 100644 (file)
index 0000000..977c826
--- /dev/null
+++ b/testsuite/tests/parallel/max_domains2.ml
@@ -0,0 +1,15 @@
+(* TEST
+ ocamlrunparam += ",d=129";
+ { native; }
+*)
+
+let m = Mutex.create ()
+
+let _ =
+  Mutex.lock m;
+  (* The default max domains limit is 128. In this test, we make this limit 129
+     and spawn 128 domains in addition to the main domain. *)
+  for i = 1 to 128 do
+    Domain.spawn (fun _ -> Mutex.lock m) |> ignore
+  done;
+  print_endline "ok"

diff --git a/testsuite/tests/parallel/max_domains2.reference b/testsuite/tests/parallel/max_domains2.reference
new file mode 100644 (file)
index 0000000..9766475
--- /dev/null
+++ b/testsuite/tests/parallel/max_domains2.reference
@@ -0,0 +1 @@
+ok

diff --git a/testsuite/tests/parallel/recommended_domain_count_cstubs.c b/testsuite/tests/parallel/recommended_domain_count_cstubs.c
index 0f11c877840800daea319666271d11c58ae261d0..cb8b571686887f5027eaf5bb9e0de962f2662c7d 100644 (file)
--- a/testsuite/tests/parallel/recommended_domain_count_cstubs.c
+++ b/testsuite/tests/parallel/recommended_domain_count_cstubs.c
@@ -1,13 +1,14 @@
 #define CAML_INTERNALS
 
-#include "caml/misc.h"
-#include "caml/memory.h"
-#include "caml/domain.h"
+#include <caml/domain.h>
+#include <caml/memory.h>
+#include <caml/misc.h>
+#include <caml/startup_aux.h>
 
 CAMLprim value
 caml_get_max_domains(value nada)
 {
   CAMLparam0();
 
-  CAMLreturn(Val_long(Max_domains));
+  CAMLreturn(Val_long(caml_params->max_domains));
 }

diff --git a/testsuite/tests/parallel/test_c_thread_register_cstubs.c b/testsuite/tests/parallel/test_c_thread_register_cstubs.c
index aec39d2389cde439853b48d17db8d81be77cd484..b977abc7d8669b97bfaa638410b4cb96c7c17d52 100644 (file)
--- a/testsuite/tests/parallel/test_c_thread_register_cstubs.c
+++ b/testsuite/tests/parallel/test_c_thread_register_cstubs.c
@@ -6,11 +6,11 @@
 #include <pthread.h>
 #define THREAD_FUNCTION void *
 #endif
-#include "caml/mlvalues.h"
-#include "caml/gc.h"
-#include "caml/memory.h"
-#include "caml/callback.h"
-#include "caml/threads.h"
+#include <caml/mlvalues.h>
+#include <caml/gc.h>
+#include <caml/memory.h>
+#include <caml/callback.h>
+#include <caml/threads.h>
 
 void *create_root(value v)
 {

diff --git a/testsuite/tests/parse-errors/unclosed_simple_pattern.compilers.reference b/testsuite/tests/parse-errors/unclosed_simple_pattern.compilers.reference
index 57424442a48602481aea8b17a75f2cc38845bd44..bd62e0a990d7963344bcf74dc86b7c159a037737 100644 (file)
--- a/testsuite/tests/parse-errors/unclosed_simple_pattern.compilers.reference
+++ b/testsuite/tests/parse-errors/unclosed_simple_pattern.compilers.reference
@@ -25,7 +25,7 @@ Line 3, characters 4-5:
 Line 6, characters 18-25:
 6 |   | (module Foo : sig end
                       ^^^^^^^
-Error: invalid package type: only module type identifier and "with type" constraints are supported
+Error: Syntax error: invalid package type: only module type identifier and "with type" constraints are supported
 Line 7, characters 0-2:
 7 | ;;
     ^^

diff --git a/testsuite/tests/parsetree/locations_test.compilers.reference b/testsuite/tests/parsetree/locations_test.compilers.reference
index 6a46e9fb16182b057f0e1625db052792ee9bd2dc..5a6b3a4848332cf3225d9aa48753c7ba760ade16 100644 (file)
--- a/testsuite/tests/parsetree/locations_test.compilers.reference
+++ b/testsuite/tests/parsetree/locations_test.compilers.reference
@@ -74,7 +74,9 @@ Ptop_def
               expression (//toplevel//[2,1+9]..[2,1+16])
                 Pexp_ident "payload" (//toplevel//[2,1+9]..[2,1+16])
           ]
-        Pexp_constant PConst_int (3,None)
+        Pexp_constant
+        constant (//toplevel//[2,1+0]..[2,1+1])
+          PConst_int (3,None)
   ]
 
 - : int = 3
@@ -117,7 +119,7 @@ Ptop_def
               []
   ]
 
-module type F = functor (A : S) (B : S) -> sig end
+module type F = (A : S) (B : S) -> sig end
 Ptop_def
   [
     structure_item (//toplevel//[2,1+0]..[2,1+48])
@@ -136,7 +138,7 @@ Ptop_def
               []
   ]
 
-module F : functor (A : S) (B : S) -> sig end
+module F : (A : S) (B : S) -> sig end
 Ptop_def
   [
     structure_item (//toplevel//[4,18+0]..[4,18+31])
@@ -228,7 +230,9 @@ Ptop_def
             Ptyp_constr "int" (//toplevel//[4,29+8]..[4,29+11])
             []
           expression (//toplevel//[4,29+14]..[4,29+15])
-            Pexp_constant PConst_int (3,None)
+            Pexp_constant
+            constant (//toplevel//[4,29+14]..[4,29+15])
+              PConst_int (3,None)
       ]
   ]
 
@@ -375,7 +379,9 @@ Ptop_def
                 expression (//toplevel//[2,1+19]..[2,1+28])
                   Pexp_constraint
                   expression (//toplevel//[2,1+27]..[2,1+28])
-                    Pexp_constant PConst_int (3,None)
+                    Pexp_constant
+                    constant (//toplevel//[2,1+27]..[2,1+28])
+                      PConst_int (3,None)
                   core_type (//toplevel//[2,1+21]..[2,1+24])
                     Ptyp_constr "int" (//toplevel//[2,1+21]..[2,1+24])
                     []
@@ -537,7 +543,9 @@ Ptop_def
                     "foo" (//toplevel//[3,9+13]..[3,9+16])
                     Concrete Fresh
                     expression (//toplevel//[3,9+19]..[3,9+21])
-                      Pexp_constant PConst_int (12,None)
+                      Pexp_constant
+                      constant (//toplevel//[3,9+19]..[3,9+21])
+                        PConst_int (12,None)
                 class_field (//toplevel//[3,9+22]..[3,9+46])
                   Pcf_method Public
                     "x" (//toplevel//[3,9+29]..[3,9+30])
@@ -585,7 +593,9 @@ Ptop_def
               [
                 "contents" (//toplevel//[4,19+12]..[4,19+20])
                   expression (//toplevel//[4,19+23]..[4,19+24])
-                    Pexp_constant PConst_int (3,None)
+                    Pexp_constant
+                    constant (//toplevel//[4,19+23]..[4,19+24])
+                      PConst_int (3,None)
               ]
               None
       ]
@@ -611,7 +621,9 @@ Ptop_def
                   Pexp_tuple
                   [
                     expression (//toplevel//[2,1+12]..[2,1+13])
-                      Pexp_constant PConst_int (3,None)
+                      Pexp_constant
+                      constant (//toplevel//[2,1+12]..[2,1+13])
+                        PConst_int (3,None)
                     expression (//toplevel//[2,1+15]..[2,1+18]) ghost
                       Pexp_construct "::" (//toplevel//[2,1+15]..[2,1+18]) ghost
                       Some
@@ -619,7 +631,9 @@ Ptop_def
                           Pexp_tuple
                           [
                             expression (//toplevel//[2,1+15]..[2,1+16])
-                              Pexp_constant PConst_int (4,None)
+                              Pexp_constant
+                              constant (//toplevel//[2,1+15]..[2,1+16])
+                                PConst_int (4,None)
                             expression (//toplevel//[2,1+17]..[2,1+18]) ghost
                               Pexp_construct "[]" (//toplevel//[2,1+17]..[2,1+18]) ghost
                               None
@@ -644,9 +658,13 @@ Ptop_def
             expression (//toplevel//[2,1+12]..[2,1+16])
               Pexp_sequence
               expression (//toplevel//[2,1+12]..[2,1+13])
-                Pexp_constant PConst_int (3,None)
+                Pexp_constant
+                constant (//toplevel//[2,1+12]..[2,1+13])
+                  PConst_int (3,None)
               expression (//toplevel//[2,1+15]..[2,1+16])
-                Pexp_constant PConst_int (4,None)
+                Pexp_constant
+                constant (//toplevel//[2,1+15]..[2,1+16])
+                  PConst_int (4,None)
       ]
   ]
 
@@ -955,7 +973,9 @@ Ptop_def
           <arg>
           Nolabel
             expression (//toplevel//[4,27+4]..[4,27+5])
-              Pexp_constant PConst_int (4,None)
+              Pexp_constant
+              constant (//toplevel//[4,27+4]..[4,27+5])
+                PConst_int (4,None)
         ]
   ]
 
@@ -976,11 +996,15 @@ Ptop_def
           <arg>
           Nolabel
             expression (//toplevel//[1,0+4]..[1,0+5])
-              Pexp_constant PConst_int (4,None)
+              Pexp_constant
+              constant (//toplevel//[1,0+4]..[1,0+5])
+                PConst_int (4,None)
           <arg>
           Nolabel
             expression (//toplevel//[1,0+10]..[1,0+11])
-              Pexp_constant PConst_int (4,None)
+              Pexp_constant
+              constant (//toplevel//[1,0+10]..[1,0+11])
+                PConst_int (4,None)
         ]
   ]
 
@@ -1001,7 +1025,9 @@ Ptop_def
           <arg>
           Nolabel
             expression (//toplevel//[2,1+5]..[2,1+6])
-              Pexp_constant PConst_int (4,None)
+              Pexp_constant
+              constant (//toplevel//[2,1+5]..[2,1+6])
+                PConst_int (4,None)
         ]
   ]
 
@@ -1022,11 +1048,15 @@ Ptop_def
           <arg>
           Nolabel
             expression (//toplevel//[1,0+5]..[1,0+6])
-              Pexp_constant PConst_int (4,None)
+              Pexp_constant
+              constant (//toplevel//[1,0+5]..[1,0+6])
+                PConst_int (4,None)
           <arg>
           Nolabel
             expression (//toplevel//[1,0+11]..[1,0+12])
-              Pexp_constant PConst_int (4,None)
+              Pexp_constant
+              constant (//toplevel//[1,0+11]..[1,0+12])
+                PConst_int (4,None)
         ]
   ]
 
@@ -1047,7 +1077,9 @@ Ptop_def
           <arg>
           Nolabel
             expression (//toplevel//[2,1+5]..[2,1+6])
-              Pexp_constant PConst_int (4,None)
+              Pexp_constant
+              constant (//toplevel//[2,1+5]..[2,1+6])
+                PConst_int (4,None)
         ]
   ]
 
@@ -1068,11 +1100,15 @@ Ptop_def
           <arg>
           Nolabel
             expression (//toplevel//[1,0+5]..[1,0+6])
-              Pexp_constant PConst_int (4,None)
+              Pexp_constant
+              constant (//toplevel//[1,0+5]..[1,0+6])
+                PConst_int (4,None)
           <arg>
           Nolabel
             expression (//toplevel//[1,0+11]..[1,0+12])
-              Pexp_constant PConst_int (4,None)
+              Pexp_constant
+              constant (//toplevel//[1,0+11]..[1,0+12])
+                PConst_int (4,None)
         ]
   ]
 
@@ -1164,19 +1200,25 @@ Ptop_def
                 structure_item (//toplevel//[4,19+0]..[4,19+36])
                   Pstr_eval
                   expression (//toplevel//[4,19+0]..[4,19+36])
-                    Pexp_constant PConst_string(" Some docstring attached to x. ",(//toplevel//[4,19+0]..[4,19+36]),None)
+                    Pexp_constant
+                    constant (//toplevel//[4,19+0]..[4,19+36])
+                      PConst_string(" Some docstring attached to x. ",(//toplevel//[4,19+0]..[4,19+36]),None)
               ]
             attribute "ocaml.doc"
               [
                 structure_item (//toplevel//[7,69+0]..[7,69+39])
                   Pstr_eval
                   expression (//toplevel//[7,69+0]..[7,69+39])
-                    Pexp_constant PConst_string(" Another docstring attached to x. ",(//toplevel//[7,69+0]..[7,69+39]),None)
+                    Pexp_constant
+                    constant (//toplevel//[7,69+0]..[7,69+39])
+                      PConst_string(" Another docstring attached to x. ",(//toplevel//[7,69+0]..[7,69+39]),None)
               ]
           pattern (//toplevel//[5,56+4]..[5,56+5])
             Ppat_var "x" (//toplevel//[5,56+4]..[5,56+5])
           expression (//toplevel//[6,64+2]..[6,64+4])
-            Pexp_constant PConst_int (42,None)
+            Pexp_constant
+            constant (//toplevel//[6,64+2]..[6,64+4])
+              PConst_int (42,None)
       ]
   ]
 
@@ -1202,7 +1244,9 @@ Ptop_def
                     expression (//toplevel//[3,56+26]..[3,56+27]) ghost
                       Pexp_poly
                       expression (//toplevel//[3,56+26]..[3,56+27])
-                        Pexp_constant PConst_int (1,None)
+                        Pexp_constant
+                        constant (//toplevel//[3,56+26]..[3,56+27])
+                          PConst_int (1,None)
                       None
               ]
       ]
@@ -1232,7 +1276,9 @@ Ptop_def
                       expression (//toplevel//[1,0+26]..[1,0+27]) ghost
                         Pexp_poly
                         expression (//toplevel//[1,0+26]..[1,0+27])
-                          Pexp_constant PConst_int (1,None)
+                          Pexp_constant
+                          constant (//toplevel//[1,0+26]..[1,0+27])
+                            PConst_int (1,None)
                         None
                 ]
       ]
@@ -1263,7 +1309,9 @@ Ptop_def
                         expression (//toplevel//[1,0+31]..[1,0+32]) ghost
                           Pexp_poly
                           expression (//toplevel//[1,0+31]..[1,0+32])
-                            Pexp_constant PConst_int (1,None)
+                            Pexp_constant
+                            constant (//toplevel//[1,0+31]..[1,0+32])
+                              PConst_int (1,None)
                           None
                   ]
       ]
@@ -1296,7 +1344,9 @@ Ptop_def
                           expression (//toplevel//[1,0+31]..[1,0+32]) ghost
                             Pexp_poly
                             expression (//toplevel//[1,0+31]..[1,0+32])
-                              Pexp_constant PConst_int (1,None)
+                              Pexp_constant
+                              constant (//toplevel//[1,0+31]..[1,0+32])
+                                PConst_int (1,None)
                             None
                     ]
       ]
@@ -1357,7 +1407,9 @@ Ptop_def
                         expression (//toplevel//[3,20+20]..[3,20+21]) ghost
                           Pexp_poly
                           expression (//toplevel//[3,20+20]..[3,20+21])
-                            Pexp_constant PConst_int (1,None)
+                            Pexp_constant
+                            constant (//toplevel//[3,20+20]..[3,20+21])
+                              PConst_int (1,None)
                           None
                   ]
             <arg>
@@ -1377,7 +1429,9 @@ Ptop_def
                           expression (//toplevel//[4,46+20]..[4,46+21]) ghost
                             Pexp_poly
                             expression (//toplevel//[4,46+20]..[4,46+21])
-                              Pexp_constant PConst_int (1,None)
+                              Pexp_constant
+                              constant (//toplevel//[4,46+20]..[4,46+21])
+                                PConst_int (1,None)
                             None
                     ]
             <arg>
@@ -1440,7 +1494,9 @@ Ptop_def
                             <arg>
                             Nolabel
                               expression (//toplevel//[4,76+17]..[4,76+18])
-                                Pexp_constant PConst_int (1,None)
+                                Pexp_constant
+                                constant (//toplevel//[4,76+17]..[4,76+18])
+                                  PConst_int (1,None)
                           ]
                 ]
                 expression (//toplevel//[5,98+2]..[5,98+12])

diff --git a/testsuite/tests/parsetree/source.ml b/testsuite/tests/parsetree/source.ml
index 8e8b5b62de41d389cdd7a585d06dd1da73318d70..cac634a986715bbfc5493f3d46512a82054b444c 100644 (file)
--- a/testsuite/tests/parsetree/source.ml
+++ b/testsuite/tests/parsetree/source.ml
@@ -106,6 +106,7 @@ let () =
   (* Pattern expressions *)
   | lazy%foo[@foo] x -> ()
   | exception%foo[@foo] x -> ()
+  | effect x, k -> ()
 
 (* Class expressions *)
 class x =
@@ -7472,11 +7473,50 @@ module M = struct
   class \#let = object
     inherit \#val \#let as \#mutable
   end
+  let \#true = 0
+  let \#mod = 0
+  type \#mod = [ `A | `B ]
+
+  class \#mod = object end
+
 end
 
 let x = new M.\#begin
 
 let f = fun x (type \#begin) (type \#end) -> 1
 
+let f: type \#if. \#if -> \#if = fun x -> x
+
+let mlet = M.\#let
+let mtrue = M.\#true
+let mmod = M.\#mod
+type tmod = M.\#mod
+type tlet = M.\#let
+type ttrue = M.\#true
+
+class \#mod = object end
+let f: #M.\#mod -> _ =  new \#mod, new M.\#mod
+
+class type \#mod = object end
+class type \#let = \#mod
+
+module type \#mod = sig type \#mod module type \#mod  end
+
+module type t =
+  \#mod with type \#mod = M.\#mod
+         and module type \#mod = M.\#mod
+
+type \#mod = [`A | `B ]
+let g = function #\#mod | #M.\#mod -> ()
+
+type \#mod = ..
+type M.\#mod += A
+
+type t = true of int
+let x = true 0
+
 (* check pretty-printing of local module open in core_type *)
 type t = String.( t )
+
+(* Utf8 identifier *)
+let là = function ça -> ça

diff --git a/testsuite/tests/parsing/broken_invariants.compilers.reference b/testsuite/tests/parsing/broken_invariants.compilers.reference
index a77a45ba19bc4641a2a44a5731557383c630b697..9a394401cfd308aa4f7578a6c944f26b04209746 100644 (file)
--- a/testsuite/tests/parsing/broken_invariants.compilers.reference
+++ b/testsuite/tests/parsing/broken_invariants.compilers.reference
@@ -26,4 +26,20 @@ Line 2, characters 4-15:
 2 |  [%%missing_rhs]
         ^^^^^^^^^^^
 Error: broken invariant in parsetree: Module type substitution with no right hand side
+Line 2, characters 9-26:
+2 | let x: [%empty_poly_binder] = 0;;
+             ^^^^^^^^^^^^^^^^^
+Error: broken invariant in parsetree: Explicit universal type quantification cannot be empty.
+Line 2, characters 11-28:
+2 | let f (x:[%empty_poly_binder]) = 0;;
+               ^^^^^^^^^^^^^^^^^
+Error: broken invariant in parsetree: Explicit universal type quantification cannot be empty.
+Line 2, characters 15-32:
+2 | let f x = (x:[%empty_poly_binder]);;
+                   ^^^^^^^^^^^^^^^^^
+Error: broken invariant in parsetree: Explicit universal type quantification cannot be empty.
+Line 1, characters 16-33:
+1 | let g: int -> [%empty_poly_binder] = fun n x -> x;;
+                    ^^^^^^^^^^^^^^^^^
+Error: broken invariant in parsetree: Explicit universal type quantification cannot be empty.
 

diff --git a/testsuite/tests/parsing/broken_invariants.ml b/testsuite/tests/parsing/broken_invariants.ml
index 24e27a6a6c1b5dc81685a92c1716c61fdc444eeb..255a1a760df1a534c54ffcd9f82e9af98a74eb64 100644 (file)
--- a/testsuite/tests/parsing/broken_invariants.ml
+++ b/testsuite/tests/parsing/broken_invariants.ml
@@ -19,6 +19,13 @@ module type s = sig
  [%%missing_rhs]
 end;;
 
+let x: [%empty_poly_binder] = 0;;
+
+let f (x:[%empty_poly_binder]) = 0;;
+
+let f x = (x:[%empty_poly_binder]);;
+let g: int -> [%empty_poly_binder] = fun n x -> x;;
+
 (* TEST
  readonly_files = "illegal_ppx.ml";
  setup-ocamlc.byte-build-env;

diff --git a/testsuite/tests/parsing/comments.compilers.reference b/testsuite/tests/parsing/comments.compilers.reference
new file mode 100644 (file)
index 0000000..2f27952
--- /dev/null
+++ b/testsuite/tests/parsing/comments.compilers.reference
@@ -0,0 +1,27 @@
+- : string = "Some text"
+- : string = "Some more text"
+Line 3, characters 3-4:
+3 | {p'|Some text|p'};;
+       ^
+Error: Syntax error: "}" expected
+Line 3, characters 0-1:
+3 | {p'|Some text|p'};;
+    ^
+  This "{" might be unmatched
+Line 1, characters 0-3:
+1 | {A|Some other text |A};;
+    ^^^
+Error: "A" cannot be used as a quoted string delimiter,
+       it must contain only lowercase letters.
+Line 1, characters 0-4:
+1 | {À|Some other text |À};;
+    ^^^^
+Error: "À" cannot be used as a quoted string delimiter,
+       it must contain only lowercase letters.
+val one : int = 1
+val two : int = 2
+val three : int = 3
+val four : int = 4
+val set : int = 5
+val meta : int = 6
+

diff --git a/testsuite/tests/parsing/comments.ml b/testsuite/tests/parsing/comments.ml
new file mode 100644 (file)
index 0000000..e5e2acf
--- /dev/null
+++ b/testsuite/tests/parsing/comments.ml
@@ -0,0 +1,49 @@
+(* TEST
+ toplevel;
+*)
+
+(* Reminder: quoted strings *)
+{é|Some text|é};;
+{e|Some more text|e};;
+
+(* Reminder: invalid delimiters for quoted strings *)
+{p'|Some text|p'};;
+{A|Some other text |A};;
+{À|Some other text |À};;
+
+
+let one = (* strings in comments: "*)" "(*" *) 1;;
+
+let two = (* We are not starting a quoted string here: {p'|, {A|, {À|, {x1|*) 2;;
+let three =
+  (* We are not starting a quoted string here:
+    {p'|(*|p'}|, {A|(*|A}, {À|(*|À}, {x1|(*|x1} *) *) *) *) *)
+  3;;
+
+
+let four = (* We are inserting quoted litteral here {p|*)|p}, {œ|(*|œ} *) 4;;
+
+let set = (** [x < min({x'|x'∊l})] *) 5;;
+
+
+let meta = (* (* Reminder: quoted strings *)
+{é|Some text|é};;
+{e|Some more text|e};;
+
+(* Reminder: invalid delimiters for quoted strings *)
+{p'|Some text|p'};;
+{A|Some other text |A};;
+{À|Some other text |À};;
+
+let one = (* strings in comments: "*)" "(*" *) 1;;
+
+let two = (* We are not starting a quoted string here: {p'|, {A|, {À|, {x1|*) 2;;
+let three =
+  (* We are not starting a quoted string here neither:
+    {p'|(*|p'}|, {A|(*|A}, {À|(*|À}, {x1|(*|x1} *) *) *) *) *)
+  3;;
+
+
+let four = (* We are inserting quoted litteral here {p|*)|p}, {œ|(*|œ} *) 4;;
+
+let set = (** [x < min({x'|x'∊l})] *) 5;; *) 6;;

diff --git a/testsuite/tests/parsing/extensions.compilers.reference b/testsuite/tests/parsing/extensions.compilers.reference
index 075a5167fecaf82310e5cefa29f0ba77601fe6c0..11ad5315472e870f92eacdcc2ff4a825ada5c92e 100644 (file)
--- a/testsuite/tests/parsing/extensions.compilers.reference
+++ b/testsuite/tests/parsing/extensions.compilers.reference
@@ -11,7 +11,9 @@
               pattern (extensions.ml[9,153+11]..[9,153+12])
                 Ppat_var "x" (extensions.ml[9,153+11]..[9,153+12])
               expression (extensions.ml[9,153+15]..[9,153+16])
-                Pexp_constant PConst_int (1,None)
+                Pexp_constant
+                constant (extensions.ml[9,153+15]..[9,153+16])
+                  PConst_int (1,None)
           ]
           expression (extensions.ml[9,153+20]..[9,153+21])
             Pexp_ident "x" (extensions.ml[9,153+20]..[9,153+21])
@@ -33,11 +35,15 @@
                   <arg>
                   Nolabel
                     expression (extensions.ml[10,176+10]..[10,176+11])
-                      Pexp_constant PConst_int (2,None)
+                      Pexp_constant
+                      constant (extensions.ml[10,176+10]..[10,176+11])
+                        PConst_int (2,None)
                   <arg>
                   Nolabel
                     expression (extensions.ml[10,176+12]..[10,176+13])
-                      Pexp_constant PConst_int (1,None)
+                      Pexp_constant
+                      constant (extensions.ml[10,176+12]..[10,176+13])
+                        PConst_int (1,None)
                 ]
           ]
         core_type (extensions.ml[10,176+17]..[10,176+31])
@@ -57,7 +63,9 @@
             structure_item (extensions.ml[10,176+40]..[10,176+45])
               Pstr_eval
               expression (extensions.ml[10,176+40]..[10,176+45])
-                Pexp_constant PConst_string("foo",(extensions.ml[10,176+41]..[10,176+44]),None)
+                Pexp_constant
+                constant (extensions.ml[10,176+40]..[10,176+45])
+                  PConst_string("foo",(extensions.ml[10,176+41]..[10,176+44]),None)
           ]
     ]
   structure_item (extensions.ml[12,224+0]..[12,224+26])
@@ -197,7 +205,9 @@
           <arg>
           Nolabel
             expression (extensions.ml[19,418+24]..[19,418+25])
-              Pexp_constant PConst_int (0,None)
+              Pexp_constant
+              constant (extensions.ml[19,418+24]..[19,418+25])
+                PConst_int (0,None)
         ]
   structure_item (extensions.ml[20,445+0]..[20,445+60])
     Pstr_value Nonrec

diff --git a/testsuite/tests/parsing/illegal_ppx.ml b/testsuite/tests/parsing/illegal_ppx.ml
index 0f8f1b424651be994792ee76b7987d287b6086c3..8d65c8fe2f76897539a8e653120e140c8f7c77e9 100644 (file)
--- a/testsuite/tests/parsing/illegal_ppx.ml
+++ b/testsuite/tests/parsing/illegal_ppx.ml
@@ -13,6 +13,7 @@ let missing_rhs loc =
 
 let empty_let loc = H.Str.value ~loc Asttypes.Nonrecursive []
 let empty_type loc = H.Str.type_ ~loc Asttypes.Nonrecursive []
+let empty_poly_binder loc = H.Typ.(poly ~loc [] (any ~loc ()))
 let functor_id loc = Location.mkloc
     (Longident.( Lapply (Lident "F", Lident "X"))) loc
 let complex_record loc =
@@ -33,6 +34,13 @@ let pat mapper p =
       complex_record loc
   | _ -> super.M.pat mapper p
 
+let typ mapper ty =
+  match ty.ptyp_desc with
+  | Ptyp_extension ({txt="empty_poly_binder";loc},_) ->
+      empty_poly_binder loc
+  | _ -> super.M.typ mapper ty
+
+
 let structure_item mapper stri = match stri.pstr_desc with
   | Pstr_extension (({Location.txt="empty_let";loc},_),_) -> empty_let loc
   | Pstr_extension (({Location.txt="empty_type";loc},_),_) -> empty_type loc
@@ -44,5 +52,5 @@ let signature_item mapper stri = match stri.psig_desc with
 
 
 let () = M.register "illegal ppx" (fun _ ->
-    { super with expr; pat; structure_item; signature_item }
+    { super with expr; pat; structure_item; signature_item; typ }
   )

diff --git a/testsuite/tests/parsing/int_and_float_with_modifier.compilers.reference b/testsuite/tests/parsing/int_and_float_with_modifier.compilers.reference
index 9766998b93f24c23b1ff60a277d269477806cd9d..16f54efc176f20abe8381ff44b527c7e05122836 100644 (file)
--- a/testsuite/tests/parsing/int_and_float_with_modifier.compilers.reference
+++ b/testsuite/tests/parsing/int_and_float_with_modifier.compilers.reference
@@ -6,7 +6,9 @@
         pattern (int_and_float_with_modifier.ml[9,153+4]..[9,153+28])
           Ppat_var "int_with_custom_modifier" (int_and_float_with_modifier.ml[9,153+4]..[9,153+28])
         expression (int_and_float_with_modifier.ml[10,184+2]..[10,184+57])
-          Pexp_constant PConst_int (1234567890_1234567890_1234567890_1234567890_1234567890,Some z)
+          Pexp_constant
+          constant (int_and_float_with_modifier.ml[10,184+2]..[10,184+57])
+            PConst_int (1234567890_1234567890_1234567890_1234567890_1234567890,Some z)
     ]
   structure_item (int_and_float_with_modifier.ml[11,242+0]..[12,275+58])
     Pstr_value Nonrec
@@ -15,7 +17,9 @@
         pattern (int_and_float_with_modifier.ml[11,242+4]..[11,242+30])
           Ppat_var "float_with_custom_modifier" (int_and_float_with_modifier.ml[11,242+4]..[11,242+30])
         expression (int_and_float_with_modifier.ml[12,275+2]..[12,275+58])
-          Pexp_constant PConst_float (1234567890_1234567890_1234567890_1234567890_1234567890.,Some z)
+          Pexp_constant
+          constant (int_and_float_with_modifier.ml[12,275+2]..[12,275+58])
+            PConst_float (1234567890_1234567890_1234567890_1234567890_1234567890.,Some z)
     ]
   structure_item (int_and_float_with_modifier.ml[14,335+0]..[14,335+21])
     Pstr_value Nonrec
@@ -24,7 +28,9 @@
         pattern (int_and_float_with_modifier.ml[14,335+4]..[14,335+9])
           Ppat_var "int32" (int_and_float_with_modifier.ml[14,335+4]..[14,335+9])
         expression (int_and_float_with_modifier.ml[14,335+16]..[14,335+21])
-          Pexp_constant PConst_int (1234,Some l)
+          Pexp_constant
+          constant (int_and_float_with_modifier.ml[14,335+16]..[14,335+21])
+            PConst_int (1234,Some l)
     ]
   structure_item (int_and_float_with_modifier.ml[15,357+0]..[15,357+21])
     Pstr_value Nonrec
@@ -33,7 +39,9 @@
         pattern (int_and_float_with_modifier.ml[15,357+4]..[15,357+9])
           Ppat_var "int64" (int_and_float_with_modifier.ml[15,357+4]..[15,357+9])
         expression (int_and_float_with_modifier.ml[15,357+16]..[15,357+21])
-          Pexp_constant PConst_int (1234,Some L)
+          Pexp_constant
+          constant (int_and_float_with_modifier.ml[15,357+16]..[15,357+21])
+            PConst_int (1234,Some L)
     ]
   structure_item (int_and_float_with_modifier.ml[16,379+0]..[16,379+21])
     Pstr_value Nonrec
@@ -42,7 +50,9 @@
         pattern (int_and_float_with_modifier.ml[16,379+4]..[16,379+13])
           Ppat_var "nativeint" (int_and_float_with_modifier.ml[16,379+4]..[16,379+13])
         expression (int_and_float_with_modifier.ml[16,379+16]..[16,379+21])
-          Pexp_constant PConst_int (1234,Some n)
+          Pexp_constant
+          constant (int_and_float_with_modifier.ml[16,379+16]..[16,379+21])
+            PConst_int (1234,Some n)
     ]
   structure_item (int_and_float_with_modifier.ml[18,402+0]..[18,402+32])
     Pstr_value Nonrec
@@ -51,7 +61,9 @@
         pattern (int_and_float_with_modifier.ml[18,402+4]..[18,402+24])
           Ppat_var "hex_without_modifier" (int_and_float_with_modifier.ml[18,402+4]..[18,402+24])
         expression (int_and_float_with_modifier.ml[18,402+27]..[18,402+32])
-          Pexp_constant PConst_int (0x32f,None)
+          Pexp_constant
+          constant (int_and_float_with_modifier.ml[18,402+27]..[18,402+32])
+            PConst_int (0x32f,None)
     ]
   structure_item (int_and_float_with_modifier.ml[19,435+0]..[19,435+32])
     Pstr_value Nonrec
@@ -60,7 +72,9 @@
         pattern (int_and_float_with_modifier.ml[19,435+4]..[19,435+21])
           Ppat_var "hex_with_modifier" (int_and_float_with_modifier.ml[19,435+4]..[19,435+21])
         expression (int_and_float_with_modifier.ml[19,435+27]..[19,435+32])
-          Pexp_constant PConst_int (0x32,Some g)
+          Pexp_constant
+          constant (int_and_float_with_modifier.ml[19,435+27]..[19,435+32])
+            PConst_int (0x32,Some g)
     ]
   structure_item (int_and_float_with_modifier.ml[21,469+0]..[21,469+33])
     Pstr_value Nonrec
@@ -69,7 +83,9 @@
         pattern (int_and_float_with_modifier.ml[21,469+4]..[21,469+25])
           Ppat_var "float_without_modifer" (int_and_float_with_modifier.ml[21,469+4]..[21,469+25])
         expression (int_and_float_with_modifier.ml[21,469+28]..[21,469+33])
-          Pexp_constant PConst_float (1.2e3,None)
+          Pexp_constant
+          constant (int_and_float_with_modifier.ml[21,469+28]..[21,469+33])
+            PConst_float (1.2e3,None)
     ]
   structure_item (int_and_float_with_modifier.ml[22,503+0]..[22,503+32])
     Pstr_value Nonrec
@@ -78,7 +94,9 @@
         pattern (int_and_float_with_modifier.ml[22,503+4]..[22,503+22])
           Ppat_var "float_with_modifer" (int_and_float_with_modifier.ml[22,503+4]..[22,503+22])
         expression (int_and_float_with_modifier.ml[22,503+28]..[22,503+32])
-          Pexp_constant PConst_float (1.2,Some g)
+          Pexp_constant
+          constant (int_and_float_with_modifier.ml[22,503+28]..[22,503+32])
+            PConst_float (1.2,Some g)
     ]
 ]
 

diff --git a/testsuite/tests/parsing/latin9.compilers.reference b/testsuite/tests/parsing/latin9.compilers.reference
new file mode 100644 (file)
index 0000000..89a7195
--- /dev/null
+++ b/testsuite/tests/parsing/latin9.compilers.reference
@@ -0,0 +1,40 @@
+val _ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŠšŽžŒœŸ :
+  string = "ok"
+type t = Æsop | Âcre | Ça | Élégant | Öst | Œuvre
+val été : string = "summer"
+val ça : string = "that"
+val straße : string = "street"
+val øre : string = "ear"
+val f : t -> int = <fun>
+val l : string list = ["summer"; "that"; "street"; "ear"]
+val s : string = "ok"
+Line 3, characters 0-47:
+3 | module Élégant (* NFD encoded *) = struct end;;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Multiple definition of the module name "Élégant".
+       Names must be unique in a given structure or signature.
+val x : string = "x"
+Line 1, characters 9-14:
+1 | let ko = {Là|x|Là};;
+             ^^^^^
+Error: "Là" cannot be used as a quoted string delimiter,
+       it must contain only lowercase letters.
+Line 2, characters 10-20:
+2 | let x = {%âcre.name été|x|été};;
+              ^^^^^^^^^^
+Error: Uninterpreted extension 'âcre.name'.
+Line 1, characters 10-19:
+1 | let x = {%Âcre.sub été|x|été};;
+              ^^^^^^^^^
+Error: Uninterpreted extension 'Âcre.sub'.
+Line 2, characters 10-17:
+2 | let x = {%âcre.m|x|};;
+              ^^^^^^^
+Error: Uninterpreted extension 'âcre.m'.
+Line 2, characters 4-10:
+2 | let%À.ça x = ();;
+        ^^^^^^
+Error: Uninterpreted extension 'À.ça'.
+val x : unit = ()
+val y : unit = ()
+

diff --git a/testsuite/tests/parsing/latin9.ml b/testsuite/tests/parsing/latin9.ml
new file mode 100644 (file)
index 0000000..ddf9010
--- /dev/null
+++ b/testsuite/tests/parsing/latin9.ml
@@ -0,0 +1,51 @@
+(* TEST
+ toplevel;
+*)
+
+(* NFC representation *)
+
+let _ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŠšŽžŒœŸ
+    = "ok"
+
+type t = Æsop | Âcre | Ça | Élégant | Öst | Œuvre
+
+let été = "summer"
+let ça = "that"
+let straße = "street"
+let øre = "ear"
+
+(* NFD representation *)
+
+let f = function
+  | Æsop -> 1 | Âcre -> 2 | Ça -> 3 | Élégant -> 4 | Öst -> 5 | Œuvre -> 6
+
+let l = [été; ça; straße; øre]
+
+let s = _ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿŠšŽžŒœŸ
+
+let () = assert (f Élégant (* NFC encoded *) = 4)
+
+let () =
+  let called = ref false in
+  let élégant (* NFC encoded *) () = called := true in
+  élégant (* NFD encoded *) (); assert (!called)
+;;
+(* The following two defs should error with 'Multiple definition…' *)
+module Élégant (* NFC encoded *) = struct end
+module Élégant (* NFD encoded *) = struct end;;
+
+(** Quoted strings and extensions *)
+
+
+let x = {où|x|où};;
+let ko = {Là|x|Là};;
+
+let x = {%âcre.name été|x|été};;
+let x = {%Âcre.sub été|x|été};;
+
+let x = {%âcre.m|x|};;
+
+let%À.ça x = ();;
+
+let x = (* {été|*)|été}*) ();;
+let y = (* This is not a valid quoted string delimiter: {Été|*) ();;

diff --git a/testsuite/tests/parsing/pr6865.compilers.reference b/testsuite/tests/parsing/pr6865.compilers.reference
index 97017f96e0ac2037c2f9db23ec942ed5081d2684..39824e5eef0be38f5830b0acdab43fd27526a53b 100644 (file)
--- a/testsuite/tests/parsing/pr6865.compilers.reference
+++ b/testsuite/tests/parsing/pr6865.compilers.reference
@@ -9,7 +9,9 @@
             pattern (pr6865.ml[9,153+8]..[9,153+9])
               Ppat_var "x" (pr6865.ml[9,153+8]..[9,153+9])
             expression (pr6865.ml[9,153+12]..[9,153+14])
-              Pexp_constant PConst_int (42,None)
+              Pexp_constant
+              constant (pr6865.ml[9,153+12]..[9,153+14])
+                PConst_int (42,None)
         ]
     ]
   structure_item (pr6865.ml[10,168+0]..[10,168+25]) ghost

diff --git a/testsuite/tests/parsing/prefix_op.compilers.reference b/testsuite/tests/parsing/prefix_op.compilers.reference
new file mode 100644 (file)
index 0000000..06f62cd
--- /dev/null
+++ b/testsuite/tests/parsing/prefix_op.compilers.reference
@@ -0,0 +1,165 @@
+[
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_constant
+      constant 
+        PConst_int (-1,None)
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_constant
+      constant 
+        PConst_int (1,None)
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_constant
+      constant 
+        PConst_float (-1.0,None)
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_constant
+      constant 
+        PConst_float (1.0,None)
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_constant
+      constant 
+        PConst_float (-1.0,None)
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_constant
+      constant 
+        PConst_float (1.0,None)
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_apply
+      expression 
+        Pexp_ident "~+" 
+      [
+        <arg>
+        Nolabel
+          expression 
+            Pexp_constant
+            constant 
+              PConst_int (2,None)
+      ]
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_apply
+      expression 
+        Pexp_ident "~-" 
+      [
+        <arg>
+        Nolabel
+          expression 
+            attribute "foo"
+              []
+            Pexp_constant
+            constant 
+              PConst_int (1,None)
+      ]
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_apply
+      expression 
+        Pexp_ident "~+" 
+      [
+        <arg>
+        Nolabel
+          expression 
+            attribute "foo"
+              []
+            Pexp_constant
+            constant 
+              PConst_int (1,None)
+      ]
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_apply
+      expression 
+        Pexp_ident "~-" 
+      [
+        <arg>
+        Nolabel
+          expression 
+            attribute "foo"
+              []
+            Pexp_constant
+            constant 
+              PConst_float (1.0,None)
+      ]
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_apply
+      expression 
+        Pexp_ident "~+" 
+      [
+        <arg>
+        Nolabel
+          expression 
+            attribute "foo"
+              []
+            Pexp_constant
+            constant 
+              PConst_float (1.0,None)
+      ]
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_apply
+      expression 
+        Pexp_ident "~-." 
+      [
+        <arg>
+        Nolabel
+          expression 
+            attribute "foo"
+              []
+            Pexp_constant
+            constant 
+              PConst_float (1.0,None)
+      ]
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_apply
+      expression 
+        Pexp_ident "~+." 
+      [
+        <arg>
+        Nolabel
+          expression 
+            attribute "foo"
+              []
+            Pexp_constant
+            constant 
+              PConst_float (1.0,None)
+      ]
+  structure_item 
+    Pstr_eval
+    expression 
+      Pexp_apply
+      expression 
+        Pexp_ident "~+" 
+      [
+        <arg>
+        Nolabel
+          expression 
+            attribute "foo"
+              []
+            Pexp_constant
+            constant 
+              PConst_int (2,None)
+      ]
+]
+

diff --git a/testsuite/tests/parsing/prefix_op.ml b/testsuite/tests/parsing/prefix_op.ml
new file mode 100644 (file)
index 0000000..79a7374
--- /dev/null
+++ b/testsuite/tests/parsing/prefix_op.ml
@@ -0,0 +1,29 @@
+(* TEST_BELOW *)
+
+(* Int and float plus and minus operators *)
+-1;;
++1;;
+-1.0;;
++1.0;;
+-.1.0;;
++.1.0;;
+
+(* Prefix operator *)
+~+2;;
+
+(* With attributes attached to the argument *)
+-(1[@foo]);;
++(1[@foo]);;
+-(1.0[@foo]);;
++(1.0[@foo]);;
+-.(1.0[@foo]);;
++.(1.0[@foo]);;
+
+~+(2[@foo]);;
+
+(* TEST
+ flags = "-dparsetree -dno-locations -stop-after parsing";
+ setup-ocamlc.byte-build-env;
+ ocamlc.byte;
+ check-ocamlc.byte-output;
+*)

diff --git a/testsuite/tests/parsing/quotedextensions.compilers.reference b/testsuite/tests/parsing/quotedextensions.compilers.reference
index dc23bd113763cd7b0fab5860101a62812db0f621..15106d7e94e596ccdd176fb0ee64d02e41dda528 100644 (file)
--- a/testsuite/tests/parsing/quotedextensions.compilers.reference
+++ b/testsuite/tests/parsing/quotedextensions.compilers.reference
@@ -5,103 +5,170 @@
       structure_item (quotedextensions.ml[10,170+0]..[10,170+23]) ghost
         Pstr_eval
         expression (quotedextensions.ml[10,170+0]..[10,170+23]) ghost
-          Pexp_constant PConst_string (" <hello>{x} ",(quotedextensions.ml[10,170+9]..[10,170+21]),Some "")
+          Pexp_constant
+          constant (quotedextensions.ml[10,170+9]..[10,170+21])
+            PConst_string (" <hello>{x} ",(quotedextensions.ml[10,170+9]..[10,170+21]),Some "")
     ]
-  structure_item (quotedextensions.ml[11,194+0]..[11,194+32])
+  structure_item (quotedextensions.ml[11,194+0]..[11,194+25])
     Pstr_extension "M.foo"
     [
-      structure_item (quotedextensions.ml[11,194+0]..[11,194+32]) ghost
+      structure_item (quotedextensions.ml[11,194+0]..[11,194+25]) ghost
         Pstr_eval
-        expression (quotedextensions.ml[11,194+0]..[11,194+32]) ghost
-          Pexp_constant PConst_string (" <hello>{|x|} ",(quotedextensions.ml[11,194+13]..[11,194+27]),Some "bar")
+        expression (quotedextensions.ml[11,194+0]..[11,194+25]) ghost
+          Pexp_constant
+          constant (quotedextensions.ml[11,194+11]..[11,194+23])
+            PConst_string (" <hello>{x} ",(quotedextensions.ml[11,194+11]..[11,194+23]),Some "")
     ]
-  structure_item (quotedextensions.ml[14,245+0]..[17,326+3])
-    Pstr_modtype "S" (quotedextensions.ml[14,245+12]..[14,245+13])
-      module_type (quotedextensions.ml[14,245+16]..[17,326+3])
+  structure_item (quotedextensions.ml[12,220+0]..[12,220+32])
+    Pstr_extension "M.foo"
+    [
+      structure_item (quotedextensions.ml[12,220+0]..[12,220+32]) ghost
+        Pstr_eval
+        expression (quotedextensions.ml[12,220+0]..[12,220+32]) ghost
+          Pexp_constant
+          constant (quotedextensions.ml[12,220+13]..[12,220+27])
+            PConst_string (" <hello>{|x|} ",(quotedextensions.ml[12,220+13]..[12,220+27]),Some "bar")
+    ]
+  structure_item (quotedextensions.ml[15,271+0]..[18,352+3])
+    Pstr_modtype "S" (quotedextensions.ml[15,271+12]..[15,271+13])
+      module_type (quotedextensions.ml[15,271+16]..[18,352+3])
         Pmty_signature
         [
-          signature_item (quotedextensions.ml[15,265+2]..[15,265+25])
+          signature_item (quotedextensions.ml[16,291+2]..[16,291+25])
             Psig_extension "M.foo"
             [
-              structure_item (quotedextensions.ml[15,265+2]..[15,265+25]) ghost
+              structure_item (quotedextensions.ml[16,291+2]..[16,291+25]) ghost
                 Pstr_eval
-                expression (quotedextensions.ml[15,265+2]..[15,265+25]) ghost
-                  Pexp_constant PConst_string (" <hello>{x} ",(quotedextensions.ml[15,265+11]..[15,265+23]),Some "")
+                expression (quotedextensions.ml[16,291+2]..[16,291+25]) ghost
+                  Pexp_constant
+                  constant (quotedextensions.ml[16,291+11]..[16,291+23])
+                    PConst_string (" <hello>{x} ",(quotedextensions.ml[16,291+11]..[16,291+23]),Some "")
             ]
-          signature_item (quotedextensions.ml[16,291+2]..[16,291+34])
+          signature_item (quotedextensions.ml[17,317+2]..[17,317+34])
             Psig_extension "M.foo"
             [
-              structure_item (quotedextensions.ml[16,291+2]..[16,291+34]) ghost
+              structure_item (quotedextensions.ml[17,317+2]..[17,317+34]) ghost
                 Pstr_eval
-                expression (quotedextensions.ml[16,291+2]..[16,291+34]) ghost
-                  Pexp_constant PConst_string (" <hello>{|x|} ",(quotedextensions.ml[16,291+15]..[16,291+29]),Some "bar")
+                expression (quotedextensions.ml[17,317+2]..[17,317+34]) ghost
+                  Pexp_constant
+                  constant (quotedextensions.ml[17,317+15]..[17,317+29])
+                    PConst_string (" <hello>{|x|} ",(quotedextensions.ml[17,317+15]..[17,317+29]),Some "bar")
             ]
         ]
-  structure_item (quotedextensions.ml[20,363+0]..[22,417+26])
+  structure_item (quotedextensions.ml[21,389+0]..[23,443+26])
+    Pstr_value Nonrec
+    [
+      <def>
+        pattern (quotedextensions.ml[21,389+4]..[21,389+26])
+          Ppat_extension "M.foo"
+          [
+            structure_item (quotedextensions.ml[21,389+4]..[21,389+26]) ghost
+              Pstr_eval
+              expression (quotedextensions.ml[21,389+4]..[21,389+26]) ghost
+                Pexp_constant
+                constant (quotedextensions.ml[21,389+12]..[21,389+24])
+                  PConst_string (" <hello>{x} ",(quotedextensions.ml[21,389+12]..[21,389+24]),Some "")
+          ]
+        core_type (quotedextensions.ml[22,416+4]..[22,416+26])
+          Ptyp_extension "M.foo"
+          [
+            structure_item (quotedextensions.ml[22,416+4]..[22,416+26]) ghost
+              Pstr_eval
+              expression (quotedextensions.ml[22,416+4]..[22,416+26]) ghost
+                Pexp_constant
+                constant (quotedextensions.ml[22,416+12]..[22,416+24])
+                  PConst_string (" <hello>{x} ",(quotedextensions.ml[22,416+12]..[22,416+24]),Some "")
+          ]
+        expression (quotedextensions.ml[23,443+4]..[23,443+26])
+          Pexp_extension "M.foo"
+          [
+            structure_item (quotedextensions.ml[23,443+4]..[23,443+26]) ghost
+              Pstr_eval
+              expression (quotedextensions.ml[23,443+4]..[23,443+26]) ghost
+                Pexp_constant
+                constant (quotedextensions.ml[23,443+12]..[23,443+24])
+                  PConst_string (" <hello>{x} ",(quotedextensions.ml[23,443+12]..[23,443+24]),Some "")
+          ]
+    ]
+  structure_item (quotedextensions.ml[24,470+0]..[26,542+35])
     Pstr_value Nonrec
     [
       <def>
-        pattern (quotedextensions.ml[20,363+4]..[20,363+26])
+        pattern (quotedextensions.ml[24,470+4]..[24,470+35])
           Ppat_extension "M.foo"
           [
-            structure_item (quotedextensions.ml[20,363+4]..[20,363+26]) ghost
+            structure_item (quotedextensions.ml[24,470+4]..[24,470+35]) ghost
               Pstr_eval
-              expression (quotedextensions.ml[20,363+4]..[20,363+26]) ghost
-                Pexp_constant PConst_string (" <hello>{x} ",(quotedextensions.ml[20,363+12]..[20,363+24]),Some "")
+              expression (quotedextensions.ml[24,470+4]..[24,470+35]) ghost
+                Pexp_constant
+                constant (quotedextensions.ml[24,470+16]..[24,470+30])
+                  PConst_string (" <hello>{|x|} ",(quotedextensions.ml[24,470+16]..[24,470+30]),Some "bar")
           ]
-        core_type (quotedextensions.ml[21,390+4]..[21,390+26])
+        core_type (quotedextensions.ml[25,506+4]..[25,506+35])
           Ptyp_extension "M.foo"
           [
-            structure_item (quotedextensions.ml[21,390+4]..[21,390+26]) ghost
+            structure_item (quotedextensions.ml[25,506+4]..[25,506+35]) ghost
               Pstr_eval
-              expression (quotedextensions.ml[21,390+4]..[21,390+26]) ghost
-                Pexp_constant PConst_string (" <hello>{x} ",(quotedextensions.ml[21,390+12]..[21,390+24]),Some "")
+              expression (quotedextensions.ml[25,506+4]..[25,506+35]) ghost
+                Pexp_constant
+                constant (quotedextensions.ml[25,506+16]..[25,506+30])
+                  PConst_string (" <hello>{|x|} ",(quotedextensions.ml[25,506+16]..[25,506+30]),Some "bar")
           ]
-        expression (quotedextensions.ml[22,417+4]..[22,417+26])
+        expression (quotedextensions.ml[26,542+4]..[26,542+35])
           Pexp_extension "M.foo"
           [
-            structure_item (quotedextensions.ml[22,417+4]..[22,417+26]) ghost
+            structure_item (quotedextensions.ml[26,542+4]..[26,542+35]) ghost
               Pstr_eval
-              expression (quotedextensions.ml[22,417+4]..[22,417+26]) ghost
-                Pexp_constant PConst_string (" <hello>{x} ",(quotedextensions.ml[22,417+12]..[22,417+24]),Some "")
+              expression (quotedextensions.ml[26,542+4]..[26,542+35]) ghost
+                Pexp_constant
+                constant (quotedextensions.ml[26,542+16]..[26,542+30])
+                  PConst_string (" <hello>{|x|} ",(quotedextensions.ml[26,542+16]..[26,542+30]),Some "bar")
           ]
     ]
-  structure_item (quotedextensions.ml[23,444+0]..[25,516+35])
+  structure_item (quotedextensions.ml[28,579+0]..[30,643+31])
     Pstr_value Nonrec
     [
       <def>
-        pattern (quotedextensions.ml[23,444+4]..[23,444+35])
+        pattern (quotedextensions.ml[28,579+4]..[28,579+31])
           Ppat_extension "M.foo"
           [
-            structure_item (quotedextensions.ml[23,444+4]..[23,444+35]) ghost
+            structure_item (quotedextensions.ml[28,579+4]..[28,579+31]) ghost
               Pstr_eval
-              expression (quotedextensions.ml[23,444+4]..[23,444+35]) ghost
-                Pexp_constant PConst_string (" <hello>{|x|} ",(quotedextensions.ml[23,444+16]..[23,444+30]),Some "bar")
+              expression (quotedextensions.ml[28,579+4]..[28,579+31]) ghost
+                Pexp_constant
+                constant (quotedextensions.ml[28,579+13]..[28,579+29])
+                  PConst_string (" <hello>{u|x|u} ",(quotedextensions.ml[28,579+13]..[28,579+29]),Some "")
           ]
-        core_type (quotedextensions.ml[24,480+4]..[24,480+35])
+        core_type (quotedextensions.ml[29,611+4]..[29,611+31])
           Ptyp_extension "M.foo"
           [
-            structure_item (quotedextensions.ml[24,480+4]..[24,480+35]) ghost
+            structure_item (quotedextensions.ml[29,611+4]..[29,611+31]) ghost
               Pstr_eval
-              expression (quotedextensions.ml[24,480+4]..[24,480+35]) ghost
-                Pexp_constant PConst_string (" <hello>{|x|} ",(quotedextensions.ml[24,480+16]..[24,480+30]),Some "bar")
+              expression (quotedextensions.ml[29,611+4]..[29,611+31]) ghost
+                Pexp_constant
+                constant (quotedextensions.ml[29,611+13]..[29,611+29])
+                  PConst_string (" <hello>{u|x|u} ",(quotedextensions.ml[29,611+13]..[29,611+29]),Some "")
           ]
-        expression (quotedextensions.ml[25,516+4]..[25,516+35])
+        expression (quotedextensions.ml[30,643+4]..[30,643+31])
           Pexp_extension "M.foo"
           [
-            structure_item (quotedextensions.ml[25,516+4]..[25,516+35]) ghost
+            structure_item (quotedextensions.ml[30,643+4]..[30,643+31]) ghost
               Pstr_eval
-              expression (quotedextensions.ml[25,516+4]..[25,516+35]) ghost
-                Pexp_constant PConst_string (" <hello>{|x|} ",(quotedextensions.ml[25,516+16]..[25,516+30]),Some "bar")
+              expression (quotedextensions.ml[30,643+4]..[30,643+31]) ghost
+                Pexp_constant
+                constant (quotedextensions.ml[30,643+13]..[30,643+29])
+                  PConst_string (" <hello>{u|x|u} ",(quotedextensions.ml[30,643+13]..[30,643+29]),Some "")
           ]
     ]
-  structure_item (quotedextensions.ml[28,569+0]..[32,605+2])
+  structure_item (quotedextensions.ml[34,693+0]..[38,729+2])
     Pstr_extension "M.foo"
     [
-      structure_item (quotedextensions.ml[28,569+0]..[32,605+2]) ghost
+      structure_item (quotedextensions.ml[34,693+0]..[38,729+2]) ghost
         Pstr_eval
-        expression (quotedextensions.ml[28,569+0]..[32,605+2]) ghost
-          Pexp_constant PConst_string ("\n <hello>\n   {x}\n </hello>\n",(quotedextensions.ml[28,569+9]..[32,605+0]),Some "")
+        expression (quotedextensions.ml[34,693+0]..[38,729+2]) ghost
+          Pexp_constant
+          constant (quotedextensions.ml[34,693+9]..[38,729+0])
+            PConst_string ("\n <hello>\n   {x}\n </hello>\n",(quotedextensions.ml[34,693+9]..[38,729+0]),Some "")
     ]
 ]
 

diff --git a/testsuite/tests/parsing/quotedextensions.ml b/testsuite/tests/parsing/quotedextensions.ml
index 738928949143fa9b242b1f2ad14d4313cc98b08e..17137b15c1c37b6201d89d8df20a30f42a75e786 100644 (file)
--- a/testsuite/tests/parsing/quotedextensions.ml
+++ b/testsuite/tests/parsing/quotedextensions.ml
@@ -8,6 +8,7 @@ serve_locations_while_translati
 
 (* Structures *)
 {%%M.foo| <hello>{x} |}
+{%%M.foo  | <hello>{x} |}
 {%%M.foo bar| <hello>{|x|} |bar}
 
 (* Signatures *)
@@ -24,6 +25,11 @@ let {%M.foo bar| <hello>{|x|} |bar}
   : {%M.foo bar| <hello>{|x|} |bar}
   = {%M.foo bar| <hello>{|x|} |bar}
 
+let {%M.foo | <hello>{u|x|u} |}
+  : {%M.foo | <hello>{u|x|u} |}
+  = {%M.foo | <hello>{u|x|u} |}
+
+
 (* Multiline *)
 {%%M.foo|
  <hello>

diff --git a/testsuite/tests/parsing/rawidents.ml b/testsuite/tests/parsing/rawidents.ml
index bc1aea7223ea5616aa6123d4c2a177652b23df8e..b4bff45a5a12ebbf5bf30dd1b7f56b1d628b8574 100644 (file)
--- a/testsuite/tests/parsing/rawidents.ml
+++ b/testsuite/tests/parsing/rawidents.ml
@@ -98,3 +98,55 @@ let f ~\#let ?\#and () = 1
 [%%expect{|
 val f : \#let:'a -> ?\#and:'b -> unit -> int = <fun>
 |}]
+
+let x = (true:int)
+[%%expect {|
+Line 1, characters 9-13:
+1 | let x = (true:int)
+             ^^^^
+Error: The constructor "true" has type "bool"
+       but an expression was expected of type "int"
+|}]
+
+module M = struct type \#true = true end
+let x = M.(true)
+[%%expect {|
+module M : sig type \#true = true end
+val x : M.\#true = M.(true)
+|}]
+
+type t = { \#false:int; x:int }
+type u = { \#true:int }
+
+let f { \#false; \#true } = 0
+[%%expect {|
+type t = { \#false : int; x : int; }
+type u = { \#true : int; }
+Line 4, characters 17-23:
+4 | let f { \#false; \#true } = 0
+                     ^^^^^^
+Error: The record field "\#true" belongs to the type "u"
+       but is mixed here with fields of type "t"
+|}]
+
+
+module M = struct
+  type t = { \#true:int; y:int}
+  type r = { \#true:int; y:int}
+end
+type t = { \#false:int }
+let _ = ( { M.\#true=0 } : t );;
+[%%expect {|
+module M :
+  sig
+    type t = { \#true : int; y : int; }
+    type r = { \#true : int; y : int; }
+  end
+type t = { \#false : int; }
+Line 6, characters 12-20:
+6 | let _ = ( { M.\#true=0 } : t );;
+                ^^^^^^^^
+Error: The field "M.\#true" belongs to one of the following record types:
+         "M.r"  "M.t"
+       but a field was expected belonging to the record type "t"
+|}]

diff --git a/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference b/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference
index 1ed03fcbae55d64bf85595e4557f5ec66cfccfff..0aba11b94956d6e96ec673bd0d06a610b846cf3b 100644 (file)
--- a/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference
+++ b/testsuite/tests/parsing/shortcut_ext_attr.compilers.reference
@@ -20,14 +20,18 @@
                     pattern (shortcut_ext_attr.ml[10,179+16]..[10,179+17])
                       Ppat_var "x" (shortcut_ext_attr.ml[10,179+16]..[10,179+17])
                     expression (shortcut_ext_attr.ml[10,179+20]..[10,179+21])
-                      Pexp_constant PConst_int (3,None)
+                      Pexp_constant
+                      constant (shortcut_ext_attr.ml[10,179+20]..[10,179+21])
+                        PConst_int (3,None)
                   <def>
                       attribute "foo"
                         []
                     pattern (shortcut_ext_attr.ml[11,201+12]..[11,201+13])
                       Ppat_var "y" (shortcut_ext_attr.ml[11,201+12]..[11,201+13])
                     expression (shortcut_ext_attr.ml[11,201+16]..[11,201+17])
-                      Pexp_constant PConst_int (4,None)
+                      Pexp_constant
+                      constant (shortcut_ext_attr.ml[11,201+16]..[11,201+17])
+                        PConst_int (4,None)
                 ]
                 expression (shortcut_ext_attr.ml[12,222+2]..[30,721+31])
                   Pexp_sequence
@@ -266,7 +270,9 @@
                                                         expression (shortcut_ext_attr.ml[24,593+2]..[24,593+23])
                                                           attribute "foo"
                                                             []
-                                                          Pexp_constant PConst_int (3,None)
+                                                          Pexp_constant
+                                                          constant (shortcut_ext_attr.ml[24,593+18]..[24,593+19])
+                                                            PConst_int (3,None)
                                                     ]
                                                   expression (shortcut_ext_attr.ml[25,619+2]..[30,721+31])
                                                     Pexp_sequence
@@ -348,7 +354,9 @@
                   pattern (shortcut_ext_attr.ml[36,806+12]..[36,806+13])
                     Ppat_var "x" (shortcut_ext_attr.ml[36,806+12]..[36,806+13])
                   expression (shortcut_ext_attr.ml[36,806+16]..[36,806+17])
-                    Pexp_constant PConst_int (3,None)
+                    Pexp_constant
+                    constant (shortcut_ext_attr.ml[36,806+16]..[36,806+17])
+                      PConst_int (3,None)
               ]
               class_expr (shortcut_ext_attr.ml[37,827+2]..[46,1049+5])
                 attribute "foo"
@@ -373,7 +381,9 @@
                         "x" (shortcut_ext_attr.ml[39,862+14]..[39,862+15])
                         Concrete Fresh
                         expression (shortcut_ext_attr.ml[39,862+18]..[39,862+19])
-                          Pexp_constant PConst_int (3,None)
+                          Pexp_constant
+                          constant (shortcut_ext_attr.ml[39,862+18]..[39,862+19])
+                            PConst_int (3,None)
                     class_field (shortcut_ext_attr.ml[40,882+4]..[40,882+27])
                         attribute "foo"
                           []
@@ -390,7 +400,9 @@
                         "x" (shortcut_ext_attr.ml[41,910+23]..[41,910+24])
                         Concrete Override
                         expression (shortcut_ext_attr.ml[41,910+27]..[41,910+28])
-                          Pexp_constant PConst_int (3,None)
+                          Pexp_constant
+                          constant (shortcut_ext_attr.ml[41,910+27]..[41,910+28])
+                            PConst_int (3,None)
                     class_field (shortcut_ext_attr.ml[42,939+4]..[42,939+22])
                         attribute "foo"
                           []
@@ -400,7 +412,9 @@
                         expression (shortcut_ext_attr.ml[42,939+21]..[42,939+22]) ghost
                           Pexp_poly
                           expression (shortcut_ext_attr.ml[42,939+21]..[42,939+22])
-                            Pexp_constant PConst_int (3,None)
+                            Pexp_constant
+                            constant (shortcut_ext_attr.ml[42,939+21]..[42,939+22])
+                              PConst_int (3,None)
                           None
                     class_field (shortcut_ext_attr.ml[43,962+4]..[43,962+30])
                         attribute "foo"
@@ -420,7 +434,9 @@
                         expression (shortcut_ext_attr.ml[44,993+30]..[44,993+31]) ghost
                           Pexp_poly
                           expression (shortcut_ext_attr.ml[44,993+30]..[44,993+31])
-                            Pexp_constant PConst_int (3,None)
+                            Pexp_constant
+                            constant (shortcut_ext_attr.ml[44,993+30]..[44,993+31])
+                              PConst_int (3,None)
                           None
                     class_field (shortcut_ext_attr.ml[45,1025+4]..[45,1025+23])
                         attribute "foo"
@@ -570,7 +586,9 @@
             pattern (shortcut_ext_attr.ml[76,1578+14]..[76,1578+15])
               Ppat_var "x" (shortcut_ext_attr.ml[76,1578+14]..[76,1578+15])
             expression (shortcut_ext_attr.ml[76,1578+18]..[76,1578+19])
-              Pexp_constant PConst_int (4,None)
+              Pexp_constant
+              constant (shortcut_ext_attr.ml[76,1578+18]..[76,1578+19])
+                PConst_int (4,None)
           <def>
               attribute "foo"
                 []

diff --git a/testsuite/tests/printing-types/existentials.ml b/testsuite/tests/printing-types/existentials.ml
index 464881f6d7cc38c2276c935701289afcb3ba0e02..a90e19a8974ef7e597d1465a073a229b92611375 100644 (file)
--- a/testsuite/tests/printing-types/existentials.ml
+++ b/testsuite/tests/printing-types/existentials.ml
@@ -15,7 +15,7 @@ type foo1 = Foo : ('a * 'b * 'c * 'd * 'e * 'f) -> foo1
 Line 6, characters 13-14:
 6 |   | Foo a -> a + 1
                  ^
-Error: This expression has type "$a * $b * $c * $d * $e * $f"
+Error: The value "a" has type "$a * $b * $c * $d * $e * $f"
        but an expression was expected of type "int"
        Hint: "$a", "$b", "$c", "$d", "$e" and "$f" are existential types
          bound by the constructor "Foo".
@@ -48,7 +48,7 @@ type foo2 =
 Line 13, characters 46-47:
 13 |       let x = (a1, a2, a3, a4, a5, a6, a7) in x + 1
                                                    ^
-Error: This expression has type "$a * $a1 * $a2 * $a3 * $a4 * $a5 * $a6"
+Error: The value "x" has type "$a * $a1 * $a2 * $a3 * $a4 * $a5 * $a6"
        but an expression was expected of type "int"
        Hint: "$a" is an existential type bound by the constructor "Foo1".
        Hint: "$a1" is an existential type bound by the constructor "Foo2".
@@ -86,7 +86,7 @@ type foo3 =
 Line 13, characters 46-47:
 13 |       let x = (a1, a2, a3, a4, a5, a6, a7) in x + 1
                                                    ^
-Error: This expression has type
+Error: The value "x" has type
          "($a * $b * $c * $d * $e * $f) *
          ($a1 * $b1 * $c1 * $d1 * $e1 * $f1) *
          ($a2 * $b2 * $c2 * $d2 * $e2 * $f2) *

diff --git a/testsuite/tests/runtime-C-exceptions/stub_test.c b/testsuite/tests/runtime-C-exceptions/stub_test.c
index b7ffd242015243ef405d957b0ca3a22c7bed0c3a..1f0af3399a3d938315d24a4e7d755ee9fd6e1ae5 100644 (file)
--- a/testsuite/tests/runtime-C-exceptions/stub_test.c
+++ b/testsuite/tests/runtime-C-exceptions/stub_test.c
@@ -1,8 +1,9 @@
+#define _CRT_NONSTDC_NO_WARNINGS  /* for strdup */
 #include <string.h>
-#include "caml/memory.h"
-#include "caml/alloc.h"
-#include "caml/mlvalues.h"
-#include "caml/fail.h"
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
 
 char *some_dynamic_string_that_should_be_freed()
 {

diff --git a/testsuite/tests/runtime-objects/toplevel_lets.ml b/testsuite/tests/runtime-objects/toplevel_lets.ml
new file mode 100644 (file)
index 0000000..5e15a1e
--- /dev/null
+++ b/testsuite/tests/runtime-objects/toplevel_lets.ml
@@ -0,0 +1,71 @@
+(* TEST *)
+
+(* Evaluation order for class expressions *)
+
+(* Everything in a class definition is evaluated at object creation time,
+   except for any toplevel let-bindings which are lifted away and
+   evaluated at class creation time. *)
+let () = print_endline "M1:"
+module M1 = struct
+  let () = print_endline "Before class"
+  class c =
+    let () = print_endline "Class init" in
+    object end
+  let () = print_endline "After class"
+  let o1 = new c
+  let o2 = new c
+end
+
+(* PR 13179 *)
+let () = print_endline "M2:"
+module M2 = struct
+  let () = print_endline "Before class"
+  class c =
+    let open Unit in
+    let () = print_endline "Class init" in
+    object end
+  let () = print_endline "After class"
+  let o1 = new c
+  let o2 = new c
+end
+
+(* Applications: argument evaluated later *)
+let () = print_endline "M3:"
+module M3 = struct
+  class with_param p = object end
+  let () = print_endline "Before class"
+  class c =
+    let () = print_endline "Class init" in
+    with_param (print_endline "Class param")
+  let () = print_endline "After class"
+  let o1 = new c
+  let o2 = new c
+end
+
+(* Nested bindings are not toplevel *)
+(* Not testing for side effects in arguments, as bytecode and native compilers
+   produce different evaluation orders *)
+let () = print_endline "M4:"
+module M4 = struct
+  class with_param p = object end
+  let () = print_endline "Before class"
+  class c =
+    (let () = print_endline "Class init" in
+     with_param)
+      ()
+  let () = print_endline "After class"
+  let o1 = new c
+  let o2 = new c
+end
+
+(* Constraints prevent lifting *)
+let () = print_endline "M5:"
+module M5 = struct
+  let () = print_endline "Before class"
+  class c =
+    (let () = print_endline "Class init" in
+     object end : object end)
+  let () = print_endline "After class"
+  let o1 = new c
+  let o2 = new c
+end

diff --git a/testsuite/tests/runtime-objects/toplevel_lets.reference b/testsuite/tests/runtime-objects/toplevel_lets.reference
new file mode 100644 (file)
index 0000000..a81e1d8
--- /dev/null
+++ b/testsuite/tests/runtime-objects/toplevel_lets.reference
@@ -0,0 +1,24 @@
+M1:
+Before class
+Class init
+After class
+M2:
+Before class
+Class init
+After class
+M3:
+Before class
+Class init
+After class
+Class param
+Class param
+M4:
+Before class
+After class
+Class init
+Class init
+M5:
+Before class
+After class
+Class init
+Class init

diff --git a/testsuite/tests/shape-index/index.reference b/testsuite/tests/shape-index/index.reference
index ab08854ebe2c6cae94ecf71994e8bb64cd029bd9..e62b460632b1fe870a273ec621c80c02da9f4a2c 100644 (file)
--- a/testsuite/tests/shape-index/index.reference
+++ b/testsuite/tests/shape-index/index.reference
@@ -34,30 +34,30 @@ Resolved: Index.3 : t (File "index.ml", line 25, characters 11-12)
 Resolved: Index.0 : t (File "index.ml", line 20, characters 10-11)
 
 Uid of decls:
-Index.10: y (File "index.ml", line 40, characters 4-5)
-Index.21: MS (File "index.ml", line 51, characters 12-14)
-Index.5: A (File "index.ml", line 23, characters 7-8)
-Index.15: G (File "index.ml", line 48, characters 7-8)
 Index.0: t (File "index.ml", line 19, characters 7-8)
-Index.28: MSB (File "index.ml", line 65, characters 12-15)
-Index.3: t (File "index.ml", line 24, characters 7-8)
-Index.17: MT (File "index.ml", line 52, characters 14-16)
-Index.11: a (File "index.ml", line 44, characters 4-5)
-Index.25: u (File "index.ml", line 66, characters 7-8)
-Index.24: MSA (File "index.ml", line 57, characters 12-15)
 Index.1: x (File "index.ml", line 20, characters 6-7)
-Index.16: u (File "index.ml", line 49, characters 5-6)
+Index.2: AS (File "index.ml", line 18, characters 12-14)
+Index.3: t (File "index.ml", line 24, characters 7-8)
+Index.4: x (File "index.ml", line 25, characters 7-8)
+Index.5: A (File "index.ml", line 23, characters 7-8)
+Index.6: B (File "index.ml", line 28, characters 7-8)
+Index.7: c (File "index.ml", line 35, characters 6-7)
 Index.8: c (File "index.ml", line 32, characters 6-7)
 Index.9: C (File "index.ml", line 30, characters 7-8)
-Index.23: u (File "index.ml", line 60, characters 11-12)
-Index.14: F (File "index.ml", line 47, characters 7-8)
+Index.10: y (File "index.ml", line 40, characters 4-5)
+Index.11: a (File "index.ml", line 44, characters 4-5)
 Index.12: _ (File "index.ml", line 45, characters 7-8)
-Index.27: G (File "index.ml", line 68, characters 9-10)
+Index.14: F (File "index.ml", line 47, characters 7-8)
+Index.15: G (File "index.ml", line 48, characters 7-8)
+Index.16: u (File "index.ml", line 49, characters 5-6)
+Index.17: MT (File "index.ml", line 52, characters 14-16)
+Index.18: M (File "index.ml", line 53, characters 9-10)
+Index.19: X (File "index.ml", line 54, characters 9-10)
 Index.20: u (File "index.ml", line 55, characters 7-8)
+Index.21: MS (File "index.ml", line 51, characters 12-14)
+Index.23: u (File "index.ml", line 60, characters 11-12)
+Index.24: MSA (File "index.ml", line 57, characters 12-15)
+Index.25: u (File "index.ml", line 66, characters 7-8)
 Index.26: t (File "index.ml", line 67, characters 23-24)
-Index.19: X (File "index.ml", line 54, characters 9-10)
-Index.6: B (File "index.ml", line 28, characters 7-8)
-Index.4: x (File "index.ml", line 25, characters 7-8)
-Index.18: M (File "index.ml", line 53, characters 9-10)
-Index.7: c (File "index.ml", line 35, characters 6-7)
-Index.2: AS (File "index.ml", line 18, characters 12-14)
+Index.27: G (File "index.ml", line 68, characters 9-10)
+Index.28: MSB (File "index.ml", line 65, characters 12-15)

diff --git a/testsuite/tests/shape-index/index_aliases.reference b/testsuite/tests/shape-index/index_aliases.reference
index e433d55b2a89a33cf57e7175e1a5dfcb1a19172e..ca456ec6fb1efc72a8e610d21f4fed244b5075d1 100644 (file)
--- a/testsuite/tests/shape-index/index_aliases.reference
+++ b/testsuite/tests/shape-index/index_aliases.reference
@@ -38,29 +38,29 @@ Resolved: Index_aliases.1 :
   A (File "index_aliases.ml", line 19, characters 11-12)
 
 Uid of decls:
-Index_aliases.12: M (File "index_aliases.ml", line 32, characters 9-10)
+Index_aliases.0: t (File "index_aliases.ml", line 18, characters 23-24)
 Index_aliases.1: A (File "index_aliases.ml", line 18, characters 7-8)
 Index_aliases.2: B (File "index_aliases.ml", line 19, characters 7-8)
-Index_aliases.18: s (File "index_aliases.ml", line 36, characters 26-27)
-Index_aliases.17: x (File "index_aliases.ml", line 35, characters 4-5)
+Index_aliases.3: t (File "index_aliases.ml", line 21, characters 23-24)
 Index_aliases.5: F (File "index_aliases.ml", line 21, characters 7-8)
-Index_aliases.26: FArg (File "index_aliases.ml", line 48, characters 7-11)
+Index_aliases.6: F' (File "index_aliases.ml", line 22, characters 7-9)
 Index_aliases.7: C (File "index_aliases.ml", line 23, characters 7-8)
-Index_aliases.24: Z (File "index_aliases.ml", line 42, characters 7-8)
-Index_aliases.20: t (File "index_aliases.ml", line 37, characters 41-42)
+Index_aliases.8: C' (File "index_aliases.ml", line 25, characters 7-9)
 Index_aliases.9: D (File "index_aliases.ml", line 26, characters 7-8)
+Index_aliases.10: G (File "index_aliases.ml", line 28, characters 7-8)
+Index_aliases.11: s (File "index_aliases.ml", line 32, characters 21-22)
+Index_aliases.12: M (File "index_aliases.ml", line 32, characters 9-10)
+Index_aliases.14: t (File "index_aliases.ml", line 33, characters 48-49)
 Index_aliases.15: F (File "index_aliases.ml", line 33, characters 9-10)
+Index_aliases.16: S (File "index_aliases.ml", line 31, characters 12-13)
+Index_aliases.17: x (File "index_aliases.ml", line 35, characters 4-5)
+Index_aliases.18: s (File "index_aliases.ml", line 36, characters 26-27)
 Index_aliases.19: M (File "index_aliases.ml", line 36, characters 11-12)
-Index_aliases.8: C' (File "index_aliases.ml", line 25, characters 7-9)
-Index_aliases.23: Y (File "index_aliases.ml", line 41, characters 7-8)
-Index_aliases.14: t (File "index_aliases.ml", line 33, characters 48-49)
-Index_aliases.10: G (File "index_aliases.ml", line 28, characters 7-8)
-Index_aliases.27: u (File "index_aliases.ml", line 52, characters 5-6)
+Index_aliases.20: t (File "index_aliases.ml", line 37, characters 41-42)
+Index_aliases.21: F (File "index_aliases.ml", line 37, characters 11-12)
 Index_aliases.22: X (File "index_aliases.ml", line 40, characters 7-8)
-Index_aliases.16: S (File "index_aliases.ml", line 31, characters 12-13)
+Index_aliases.23: Y (File "index_aliases.ml", line 41, characters 7-8)
+Index_aliases.24: Z (File "index_aliases.ml", line 42, characters 7-8)
 Index_aliases.25: Arg (File "index_aliases.ml", line 47, characters 7-10)
-Index_aliases.21: F (File "index_aliases.ml", line 37, characters 11-12)
-Index_aliases.6: F' (File "index_aliases.ml", line 22, characters 7-9)
-Index_aliases.3: t (File "index_aliases.ml", line 21, characters 23-24)
-Index_aliases.11: s (File "index_aliases.ml", line 32, characters 21-22)
-Index_aliases.0: t (File "index_aliases.ml", line 18, characters 23-24)
+Index_aliases.26: FArg (File "index_aliases.ml", line 48, characters 7-11)
+Index_aliases.27: u (File "index_aliases.ml", line 52, characters 5-6)

diff --git a/testsuite/tests/shape-index/index_bindingops.reference b/testsuite/tests/shape-index/index_bindingops.reference
index 38c4f70b4d158672de1b7e2bdd98babfca3d8ee2..8892fd4ecf819dd0c6769a9d9dd6957284f1ce6a 100644 (file)
--- a/testsuite/tests/shape-index/index_bindingops.reference
+++ b/testsuite/tests/shape-index/index_bindingops.reference
@@ -39,9 +39,9 @@ Unresolved: CU Stdlib . "Option"[module] . "map"[value]  :
   Option.map (File "index_bindingops.ml", line 17, characters 17-27)
 
 Uid of decls:
-Index_bindingops.8:
-  minus_three (File "index_bindingops.ml", line 23, characters 4-15)
 Index_bindingops.0:
   let+ (File "index_bindingops.ml", line 17, characters 4-10)
 Index_bindingops.3:
   and+ (File "index_bindingops.ml", line 19, characters 4-10)
+Index_bindingops.8:
+  minus_three (File "index_bindingops.ml", line 23, characters 4-15)

diff --git a/testsuite/tests/shape-index/index_constrs.reference b/testsuite/tests/shape-index/index_constrs.reference
index 3fe533e8b6ba612193ad698545bf249885b8dc04..c8cec48038540c719f80d04f54ec7cb379700576 100644 (file)
--- a/testsuite/tests/shape-index/index_constrs.reference
+++ b/testsuite/tests/shape-index/index_constrs.reference
@@ -17,10 +17,10 @@ Resolved: Index_constrs.0 :
   E (File "index_constrs.ml", line 20, characters 16-17)
 
 Uid of decls:
-Index_constrs.6: f (File "index_constrs.ml", line 27, characters 4-5)
-Index_constrs.5: x_ (File "index_constrs.ml", line 25, characters 4-6)
 Index_constrs.0: E (File "index_constrs.ml", line 18, characters 10-11)
-Index_constrs.2: M (File "index_constrs.ml", line 19, characters 7-8)
 Index_constrs.1: F (File "index_constrs.ml", line 20, characters 12-13)
+Index_constrs.2: M (File "index_constrs.ml", line 19, characters 7-8)
 Index_constrs.3: t (File "index_constrs.ml", line 23, characters 5-6)
 Index_constrs.4: E (File "index_constrs.ml", line 23, characters 9-10)
+Index_constrs.5: x_ (File "index_constrs.ml", line 25, characters 4-6)
+Index_constrs.6: f (File "index_constrs.ml", line 27, characters 4-5)

diff --git a/testsuite/tests/shape-index/index_constrs_records.reference b/testsuite/tests/shape-index/index_constrs_records.reference
index 14dfbeade320176fda3e65496186169b1b19671f..7a6f003d4b1617642068d647e333cbec29f22bc6 100644 (file)
--- a/testsuite/tests/shape-index/index_constrs_records.reference
+++ b/testsuite/tests/shape-index/index_constrs_records.reference
@@ -57,37 +57,37 @@ Resolved: Index_constrs_records.4 :
   A (File "index_constrs_records.ml", line 22, characters 10-11)
 
 Uid of decls:
+Index_constrs_records.0:
+  l (File "index_constrs_records.ml", line 17, characters 5-6)
+Index_constrs_records.1:
+  lbl (File "index_constrs_records.ml", line 17, characters 11-14)
+Index_constrs_records.2:
+  t (File "index_constrs_records.ml", line 21, characters 7-8)
+Index_constrs_records.3:
+  l_c (File "index_constrs_records.ml", line 21, characters 18-21)
 Index_constrs_records.4:
   A (File "index_constrs_records.ml", line 21, characters 11-12)
-Index_constrs_records.19:
-  M (File "index_constrs_records.ml", line 18, characters 7-8)
-Index_constrs_records.33:
-  Exn (File "index_constrs_records.ml", line 39, characters 10-13)
-Index_constrs_records.12:
-  A (File "index_constrs_records.ml", line 19, characters 11-12)
 Index_constrs_records.10:
   t (File "index_constrs_records.ml", line 19, characters 7-8)
-Index_constrs_records.2:
-  t (File "index_constrs_records.ml", line 21, characters 7-8)
-Index_constrs_records.29:
-  f (File "index_constrs_records.ml", line 35, characters 4-5)
-Index_constrs_records.25:
-  u (File "index_constrs_records.ml", line 32, characters 5-6)
+Index_constrs_records.11:
+  l_c (File "index_constrs_records.ml", line 19, characters 18-21)
+Index_constrs_records.12:
+  A (File "index_constrs_records.ml", line 19, characters 11-12)
+Index_constrs_records.19:
+  M (File "index_constrs_records.ml", line 18, characters 7-8)
 Index_constrs_records.21:
   f (File "index_constrs_records.ml", line 30, characters 4-5)
-Index_constrs_records.3:
-  l_c (File "index_constrs_records.ml", line 21, characters 18-21)
-Index_constrs_records.35:
-  e (File "index_constrs_records.ml", line 41, characters 4-5)
+Index_constrs_records.25:
+  u (File "index_constrs_records.ml", line 32, characters 5-6)
 Index_constrs_records.26:
   l_ext (File "index_constrs_records.ml", line 33, characters 19-24)
-Index_constrs_records.11:
-  l_c (File "index_constrs_records.ml", line 19, characters 18-21)
 Index_constrs_records.27:
   Ext (File "index_constrs_records.ml", line 33, characters 10-13)
-Index_constrs_records.0:
-  l (File "index_constrs_records.ml", line 17, characters 5-6)
+Index_constrs_records.29:
+  f (File "index_constrs_records.ml", line 35, characters 4-5)
 Index_constrs_records.32:
   l_exn (File "index_constrs_records.ml", line 39, characters 18-23)
-Index_constrs_records.1:
-  lbl (File "index_constrs_records.ml", line 17, characters 11-14)
+Index_constrs_records.33:
+  Exn (File "index_constrs_records.ml", line 39, characters 10-13)
+Index_constrs_records.35:
+  e (File "index_constrs_records.ml", line 41, characters 4-5)

diff --git a/testsuite/tests/shape-index/index_functor.reference b/testsuite/tests/shape-index/index_functor.reference
index 89867f0bafecc2d403796cf2690f390c88f6a14a..04746c8d5555fa4223737370b72746410ad65b50 100644 (file)
--- a/testsuite/tests/shape-index/index_functor.reference
+++ b/testsuite/tests/shape-index/index_functor.reference
@@ -11,7 +11,7 @@ Resolved: Index_functor.0 :
   X (File "index_functor.ml", line 18, characters 43-44)
 
 Uid of decls:
+Index_functor.1: M (File "index_functor.ml", line 18, characters 39-40)
+Index_functor.2: F (File "index_functor.ml", line 18, characters 7-8)
 Index_functor.3: N (File "index_functor.ml", line 19, characters 7-8)
 Index_functor.4: O (File "index_functor.ml", line 20, characters 7-8)
-Index_functor.2: F (File "index_functor.ml", line 18, characters 7-8)
-Index_functor.1: M (File "index_functor.ml", line 18, characters 39-40)

diff --git a/testsuite/tests/shape-index/index_labels.reference b/testsuite/tests/shape-index/index_labels.reference
index 797744dfe314c2001c2252bdff6c16edf04b0112..ae84539a8ef6a44b91f7d5d0ebc775f2fd8f9bfe 100644 (file)
--- a/testsuite/tests/shape-index/index_labels.reference
+++ b/testsuite/tests/shape-index/index_labels.reference
@@ -17,9 +17,9 @@ Resolved: Index_labels.1 :
   a (File "index_labels.ml", line 20, characters 10-11)
 
 Uid of decls:
-Index_labels.5: f (File "index_labels.ml", line 25, characters 4-5)
+Index_labels.0: t (File "index_labels.ml", line 18, characters 5-6)
+Index_labels.1: a (File "index_labels.ml", line 18, characters 19-20)
 Index_labels.2: b (File "index_labels.ml", line 18, characters 27-28)
 Index_labels.3: x (File "index_labels.ml", line 20, characters 4-5)
-Index_labels.1: a (File "index_labels.ml", line 18, characters 19-20)
 Index_labels.4: _y (File "index_labels.ml", line 21, characters 4-6)
-Index_labels.0: t (File "index_labels.ml", line 18, characters 5-6)
+Index_labels.5: f (File "index_labels.ml", line 25, characters 4-5)

diff --git a/testsuite/tests/shape-index/index_objects.reference b/testsuite/tests/shape-index/index_objects.reference
index 1a0b3a3ab25c42b1aa560e2cd30f4c033a948b66..4d44a65655824e4e09add547d642d25c9852b4b8 100644 (file)
--- a/testsuite/tests/shape-index/index_objects.reference
+++ b/testsuite/tests/shape-index/index_objects.reference
@@ -23,10 +23,10 @@ Resolved: Index_objects.0 :
   o (File "index_objects.ml", line 23, characters 9-10)
 
 Uid of decls:
+Index_objects.0: o (File "index_objects.ml", line 18, characters 4-5)
+Index_objects.5: c (File "index_objects.ml", line 25, characters 6-7)
 Index_objects.10: d (File "index_objects.ml", line 31, characters 6-7)
-Index_objects.15: M (File "index_objects.ml", line 35, characters 12-13)
+Index_objects.13: ct (File "index_objects.ml", line 36, characters 8-10)
 Index_objects.14: dt (File "index_objects.ml", line 40, characters 8-10)
-Index_objects.5: c (File "index_objects.ml", line 25, characters 6-7)
-Index_objects.0: o (File "index_objects.ml", line 18, characters 4-5)
+Index_objects.15: M (File "index_objects.ml", line 35, characters 12-13)
 Index_objects.16: ins_var (File "index_objects.ml", line 43, characters 6-13)
-Index_objects.13: ct (File "index_objects.ml", line 36, characters 8-10)

diff --git a/testsuite/tests/shape-index/index_types.reference b/testsuite/tests/shape-index/index_types.reference
index 330c8e29244daf7969d49dbd051de3b17f7eb3c7..b7887fa3be3e276d647070b473b65e3cfac9a04c 100644 (file)
--- a/testsuite/tests/shape-index/index_types.reference
+++ b/testsuite/tests/shape-index/index_types.reference
@@ -12,15 +12,15 @@ Resolved: Index_types.0 : t (File "index_types.ml", line 20, characters 8-9)
 Resolved: Index_types.0 : t (File "index_types.ml", line 20, characters 8-9)
 
 Uid of decls:
-Index_types.11: u (File "index_types.ml", line 41, characters 5-6)
-Index_types.3: poly (File "index_types.ml", line 27, characters 5-9)
+Index_types.0: t (File "index_types.ml", line 18, characters 5-6)
+Index_types.1: x (File "index_types.ml", line 20, characters 4-5)
 Index_types.2: M (File "index_types.ml", line 22, characters 7-8)
-Index_types.6: S (File "index_types.ml", line 31, characters 12-13)
-Index_types.10: N (File "index_types.ml", line 40, characters 7-8)
-Index_types.5: B (File "index_types.ml", line 33, characters 13-14)
-Index_types.9: t (File "index_types.ml", line 40, characters 23-24)
+Index_types.3: poly (File "index_types.ml", line 27, characters 5-9)
 Index_types.4: t2 (File "index_types.ml", line 32, characters 7-9)
-Index_types.1: x (File "index_types.ml", line 20, characters 4-5)
-Index_types.8: B (File "index_types.ml", line 37, characters 11-12)
-Index_types.0: t (File "index_types.ml", line 18, characters 5-6)
+Index_types.5: B (File "index_types.ml", line 33, characters 13-14)
+Index_types.6: S (File "index_types.ml", line 31, characters 12-13)
 Index_types.7: t1 (File "index_types.ml", line 36, characters 5-7)
+Index_types.8: B (File "index_types.ml", line 37, characters 11-12)
+Index_types.9: t (File "index_types.ml", line 40, characters 23-24)
+Index_types.10: N (File "index_types.ml", line 40, characters 7-8)
+Index_types.11: u (File "index_types.ml", line 41, characters 5-6)

diff --git a/testsuite/tests/shape-index/index_vb.reference b/testsuite/tests/shape-index/index_vb.reference
index a48f72fff6489fdbb677f1c1fd16516c6094c68a..cb96c56c3d405debdc802cfe83ba2cdf957e6684 100644 (file)
--- a/testsuite/tests/shape-index/index_vb.reference
+++ b/testsuite/tests/shape-index/index_vb.reference
@@ -16,9 +16,9 @@ Resolved: Index_vb.2 : b (File "index_vb.ml", line 20, characters 9-10)
 Resolved: Index_vb.1 : a (File "index_vb.ml", line 20, characters 6-7)
 
 Uid of decls:
-Index_vb.3: a (File "index_vb.ml", line 20, characters 6-7)
-Index_vb.1: a (File "index_vb.ml", line 18, characters 11-12)
 Index_vb.0: t (File "index_vb.ml", line 18, characters 5-6)
+Index_vb.1: a (File "index_vb.ml", line 18, characters 11-12)
 Index_vb.2: b (File "index_vb.ml", line 18, characters 20-21)
-Index_vb.5: a (File "index_vb.ml", line 20, characters 6-7)
+Index_vb.3: a (File "index_vb.ml", line 20, characters 6-7)
 Index_vb.4: a (File "index_vb.ml", line 20, characters 6-7)
+Index_vb.5: a (File "index_vb.ml", line 20, characters 6-7)

diff --git a/testsuite/tests/shapes/aliases.ml b/testsuite/tests/shapes/aliases.ml
index a95c7e4da734948380aea969bddca9cf2ac5c4ac..4bb0dc7cb878ad835e70cc5fc78e82aae50feb47 100644 (file)
--- a/testsuite/tests/shapes/aliases.ml
+++ b/testsuite/tests/shapes/aliases.ml
@@ -36,7 +36,7 @@ module F' = F
 {
  "F"[module] -> Abs<.6>(X, X<.5>);
  }
-module F : functor (X : sig type t end) -> sig type t = X.t end
+module F : (X : sig type t end) -> sig type t = X.t end
 {
  "F'"[module] -> Alias(<.7>
                        Abs<.6>(X, X<.5>));
@@ -87,7 +87,7 @@ module G (X : sig type t end) = struct include X end
                              "t"[type] -> X<.12> . "t"[type];
                              });
  }
-module G : functor (X : sig type t end) -> sig type t = X.t end
+module G : (X : sig type t end) -> sig type t = X.t end
 |}]
 
 module E = G(B)

diff --git a/testsuite/tests/shapes/comp_units.ml b/testsuite/tests/shapes/comp_units.ml
index 98b146f5e3417c3e502f65ae6c642a42102026da..e690a60c0ce2f272d4ddcac4cc5d2e2704acb0c6 100644 (file)
--- a/testsuite/tests/shapes/comp_units.ml
+++ b/testsuite/tests/shapes/comp_units.ml
@@ -29,7 +29,7 @@ module F (X : sig type t end) = X
 {
  "F"[module] -> Abs<.4>(X, X<.3>);
  }
-module F : functor (X : sig type t end) -> sig type t = X.t end
+module F : (X : sig type t end) -> sig type t = X.t end
 |}]
 
 module App_direct = F (Stdlib__Unit)

diff --git a/testsuite/tests/shapes/functors.ml b/testsuite/tests/shapes/functors.ml
index 33b6c43284c8eb1919a9551ea57e7de96205ac8e..5b10263144f12a2ff94bd2143f58c83220d127ff 100644 (file)
--- a/testsuite/tests/shapes/functors.ml
+++ b/testsuite/tests/shapes/functors.ml
@@ -19,7 +19,7 @@ module Falias (X : S) = X
 {
  "Falias"[module] -> Abs<.4>(X, X<.3>);
  }
-module Falias : functor (X : S) -> sig type t = X.t val x : t end
+module Falias : (X : S) -> sig type t = X.t val x : t end
 |}]
 
 module Finclude (X : S) = struct
@@ -34,7 +34,7 @@ end
            "x"[value] -> X<.5> . "x"[value];
            });
  }
-module Finclude : functor (X : S) -> sig type t = X.t val x : t end
+module Finclude : (X : S) -> sig type t = X.t val x : t end
 |}]
 
 module Fredef (X : S) = struct
@@ -48,7 +48,7 @@ end
                                   "x"[value] -> <.9>;
                                   });
  }
-module Fredef : functor (X : S) -> sig type t = X.t val x : X.t end
+module Fredef : (X : S) -> sig type t = X.t val x : X.t end
 |}]
 
 module Fignore (_ : S) = struct
@@ -191,7 +191,7 @@ end
         "x"[value] -> <.29>;
         });
  }
-module Fgen : functor () -> sig type t = Fresher val x : t end
+module Fgen : () -> sig type t = Fresher val x : t end
 |}]
 
 include Fgen ()
@@ -236,7 +236,7 @@ module type B2S = functor (X : Big) -> Small with type t = X.t
 {
  "B2S"[module type] -> <.38>;
  }
-module type B2S = functor (X : Big) -> sig type t = X.t end
+module type B2S = (X : Big) -> sig type t = X.t end
 |}]
 
 module Big_to_small1 : B2S = functor (X : Big) -> X

diff --git a/testsuite/tests/shapes/more_func.ml b/testsuite/tests/shapes/more_func.ml
index ce10c5a5d7f6d5b93d84aa1abbce7711ccae0c49..b8eda9ed720c30deef391718115327f67e0349e3 100644 (file)
--- a/testsuite/tests/shapes/more_func.ml
+++ b/testsuite/tests/shapes/more_func.ml
@@ -14,7 +14,7 @@ module M : sig end
 {
  "F"[module] -> Abs<.2>(X, {<.0>});
  }
-module F : functor (X : sig end) -> sig end
+module F : (X : sig end) -> sig end
 {
  "App"[module] -> {<.3>};
  }
@@ -35,7 +35,7 @@ module M : sig end
                             "t"[type] -> <.6>;
                             });
  }
-module F : functor (X : sig end) -> sig type t end
+module F : (X : sig end) -> sig type t end
 {
  "App"[module] -> {<.8>
                    "t"[type] -> <.6>;
@@ -55,7 +55,7 @@ module M : sig end
 {
  "F"[module] -> Abs<.11>(X, X<.10>);
  }
-module F : functor (X : sig end) -> sig end
+module F : (X : sig end) -> sig end
 {
  "App"[module] -> {<.12>};
  }
@@ -70,7 +70,7 @@ end
 {
  "Id"[module] -> Abs<.14>(X, X<.13>);
  }
-module Id : functor (X : sig end) -> sig end
+module Id : (X : sig end) -> sig end
 {
  "Struct"[module] ->
    {<.16>
@@ -106,7 +106,7 @@ module O = N.M
                              "M"[module] -> X<.19>;
                              });
  }
-module F : functor (X : sig end) -> sig module M : sig end end
+module F : (X : sig end) -> sig module M : sig end end
 {
  "N"[module] -> {<.22>
                  "M"[module] -> {<.19>};

diff --git a/testsuite/tests/shapes/open_arg.ml b/testsuite/tests/shapes/open_arg.ml
index e25a3f4edc420c63323ac697c77871456d8cbd9a..17fd24cd224a3e5832235ec6edde100c43b882f1 100644 (file)
--- a/testsuite/tests/shapes/open_arg.ml
+++ b/testsuite/tests/shapes/open_arg.ml
@@ -12,7 +12,7 @@ end
 {
  "Make"[module type] -> <.1>;
  }
-module type Make = functor (I : sig end) -> sig end
+module type Make = (I : sig end) -> sig end
 |}]
 
 module Make (I : sig end) : sig
@@ -24,7 +24,7 @@ end = struct end
 {
  "Make"[module] -> Abs<.3>(I, {});
  }
-module Make : functor (I : sig end) -> sig end
+module Make : (I : sig end) -> sig end
 |}]
 
 module type Make = functor (I : sig end) ->
@@ -36,5 +36,5 @@ end
 {
  "Make"[module type] -> <.5>;
  }
-module type Make = functor (I : sig end) -> sig end
+module type Make = (I : sig end) -> sig end
 |}]

diff --git a/testsuite/tests/shapes/rotor_example.ml b/testsuite/tests/shapes/rotor_example.ml
index bb35d701dabacc2fa6c8b1ee5f415faa43bbd0c0..36e4cda6506a4414468a6a8957a24cce49fa94ef 100644 (file)
--- a/testsuite/tests/shapes/rotor_example.ml
+++ b/testsuite/tests/shapes/rotor_example.ml
@@ -31,7 +31,7 @@ end
                   });
  }
 module Pair :
-  functor (X : Stringable) (Y : Stringable) ->
+  (X : Stringable) (Y : Stringable) ->
     sig type t = X.t * Y.t val to_string : X.t * Y.t -> string end
 |}]
 

diff --git a/testsuite/tests/statmemprof/alloc_counts.ml b/testsuite/tests/statmemprof/alloc_counts.ml
index ce8a90fc043c5870ebe3e134e9cc922de783d116..7f7c85bba876259289b095b1827c84fe1b81a62e 100644 (file)
--- a/testsuite/tests/statmemprof/alloc_counts.ml
+++ b/testsuite/tests/statmemprof/alloc_counts.ml
@@ -1,9 +1,14 @@
-(* TEST
- reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
- skip;
-*)
+(* TEST *)
+
+(* Checks that the allocated words counted by statmemprof
+   (with sampling rate of 1) match the numbers reported by
+   Gc.counters(). *)
+
 module MP = Gc.Memprof
 
+(* Returns the number of words allocated on the minor and major heaps
+   when f is called, as counted by statmemprof *)
+
 let allocs_by_memprof f =
   let minor = ref 0 in
   let major = ref 0 in
@@ -13,11 +18,15 @@ let allocs_by_memprof f =
   let alloc_major (info : MP.allocation) =
     major := !major + info.n_samples;
     None in
-  MP.start ~sampling_rate:1. ({MP.null_tracker with alloc_minor; alloc_major});
+  let _:MP.t = MP.start ~sampling_rate:1.
+          ({MP.null_tracker with alloc_minor; alloc_major}) in
   match Sys.opaque_identity f () with
   | _ -> MP.stop (); (!minor, !major)
   | exception e -> MP.stop (); raise e
 
+(* Returns the number of words allocated on the minor and major heaps
+   when f is called, as counted by Gc.counters() *)
+
 let allocs_by_counters f =
   let minor1, prom1, major1 = Gc.counters () in
   let minor2, prom2, major2 = Gc.counters () in
@@ -34,6 +43,8 @@ let allocs_by_counters f =
   int_of_float minor,
   int_of_float (major -. prom)
 
+(* Compares memprof results with Gc.counters() results *)
+
 let compare name f =
   let mp_minor, mp_major = allocs_by_memprof f in
   let ct_minor, ct_major = allocs_by_counters f in
@@ -47,6 +58,9 @@ let many f =
     ignore (Sys.opaque_identity f ())
   done
 
+(* Compare allocated word counts for repetitions of various functions
+   which allocate large or small objects of different kinds. *)
+
 let () =
   compare "ref" (many (fun () -> ref (ref (ref 42))));
   compare "short array" (many (fun () -> Array.make 10 'a'));

diff --git a/testsuite/tests/statmemprof/arrays_in_major.ml b/testsuite/tests/statmemprof/arrays_in_major.ml
index 1dd253dcd671fe09f06dba463e1d3fd21eac3d81..cb3d5edbad826e6a95b2060d4ebc3e4eedc20f1a 100644 (file)
--- a/testsuite/tests/statmemprof/arrays_in_major.ml
+++ b/testsuite/tests/statmemprof/arrays_in_major.ml
@@ -1,10 +1,12 @@
-(* TEST
- flags = "-g";
- reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
- skip;
-*)
+(* TEST *)
 
-open Gc.Memprof
+module MP = Gc.Memprof
+
+(* Tests that array allocation in the major heap is properly counted
+   and managed by statmemprof. *)
+
+(* Allocate arrays of all sizes from `lo` to `hi`, `cnt` times. If
+  `keep`, then keep all the arrays, otherwise discard them all. *)
 
 let root = ref []
 let[@inline never] allocate_arrays lo hi cnt keep =
@@ -16,67 +18,80 @@ let[@inline never] allocate_arrays lo hi cnt keep =
     if not keep then root := []
   done
 
+(* Check that no allocation callbacks are called if the sampling rate
+   is zero. *)
+
 let check_nosample () =
   Printf.printf "check_nosample\n%!";
   let alloc _ =
     Printf.printf "Callback called with sampling_rate = 0\n";
-    assert(false)
+    assert(false) in
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:0.
+    { MP.null_tracker with alloc_minor = alloc; alloc_major = alloc; }
   in
-  start ~callstack_size:10 ~sampling_rate:0.
-    { null_tracker with alloc_minor = alloc; alloc_major = alloc; };
   allocate_arrays 300 3000 1 false;
-  stop ()
+  MP.stop ()
 
 let () = check_nosample ()
 
+(* Cross-check counts of allocations, promotions, and deallocations,
+   and check that they change appropriately at major collections
+   depending on reachability *)
+
 let check_counts_full_major force_promote =
   Printf.printf "check_counts_full_major\n%!";
+  let enable = ref true in
   let nalloc_minor = ref 0 in
   let nalloc_major = ref 0 in
-  let enable = ref true in
   let npromote = ref 0 in
   let ndealloc_minor = ref 0 in
   let ndealloc_major = ref 0 in
-  start ~callstack_size:10 ~sampling_rate:0.01
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:0.01
     {
       alloc_minor = (fun _ ->
         if not !enable then None
-        else Some (incr nalloc_minor)
-      );
+        else Some (incr nalloc_minor));
       alloc_major = (fun _ ->
         if not !enable then None
-        else Some (incr nalloc_major)
-      );
-      promote = (fun _ ->
-        Some (incr npromote)
-      );
-      dealloc_minor = (fun _ ->
-        incr ndealloc_minor
-      );
-      dealloc_major = (fun _ ->
-        incr ndealloc_major
-      );
-    };
+        else Some (incr nalloc_major));
+      promote = (fun _ -> Some (incr npromote));
+      dealloc_minor = (fun _ -> incr ndealloc_minor);
+      dealloc_major = (fun _ -> incr ndealloc_major);
+    }
+  in
   allocate_arrays 300 3000 1 true;
-  enable := false;
+  enable := false; (* stop sampling *)
+  (* everything is still reachable from root *)
   assert (!ndealloc_minor = 0 && !ndealloc_major = 0);
+
   if force_promote then begin
     Gc.full_major ();
+    (* everything is still reachable from root, and
+       everything allocated in the minor heap has now
+       been promoted *)
     assert (!ndealloc_minor = 0 && !ndealloc_major = 0 &&
             !npromote = !nalloc_minor);
+
     root := [];
     Gc.full_major ();
+    (* nothing is reachable from root, so everything (which was
+       promoted) has now been deallocated in the major heap *)
     assert (!ndealloc_minor = 0 &&
             !ndealloc_major = !nalloc_minor + !nalloc_major);
+
   end else begin
     root := [];
     Gc.minor ();
     Gc.full_major ();
     Gc.full_major ();
+    (* everything allocated in the minor heap has either
+       been deallocated in the minor heap or promoted,
+       and everything deallocated in the major heap had
+       either been allocated in the major heap or promoted *)
     assert (!nalloc_minor = !ndealloc_minor + !npromote &&
             !ndealloc_major = !npromote + !nalloc_major)
   end;
-  stop ()
+  MP.stop ()
 
 let () =
   check_counts_full_major false;
@@ -90,27 +105,27 @@ let check_no_nested () =
     in_callback := true;
     allocate_arrays 300 300 100 false;
     in_callback := false;
-    ()
-  in
+    () in
   let cb' _ = cb (); Some () in
-  start ~callstack_size:10 ~sampling_rate:1.
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:1.
     {
       alloc_minor = cb';
       alloc_major = cb';
       promote = cb';
       dealloc_minor = cb;
       dealloc_major = cb;
-    };
+    }
+  in
   allocate_arrays 300 300 100 false;
-  stop ()
+  MP.stop ()
 
 let () = check_no_nested ()
 
 let check_distrib lo hi cnt rate =
   Printf.printf "check_distrib %d %d %d %f\n%!" lo hi cnt rate;
   let smp = ref 0 in
-  start ~callstack_size:10 ~sampling_rate:rate
-    { null_tracker with
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:rate
+    { MP.null_tracker with
       alloc_major = (fun info ->
         assert (info.size >= lo && info.size <= hi);
         assert (info.n_samples > 0);
@@ -118,9 +133,10 @@ let check_distrib lo hi cnt rate =
         smp := !smp + info.n_samples;
         None
       );
-    };
+    }
+  in
   allocate_arrays lo hi cnt false;
-  stop ();
+  MP.stop ();
 
   (* The probability distribution of the number of samples follows a
      binomial distribution of parameters tot_alloc and rate. Given
@@ -134,7 +150,7 @@ let check_distrib lo hi cnt rate =
           float tot_alloc *. (1. -. rate) > 100.);
   let mean = float tot_alloc *. rate in
   let stddev = sqrt (float tot_alloc *. rate *. (1. -. rate)) in
-  (* This assertion has probability to fail close to 1e-8. *)
+  (* This should fail approximately one time in 100,000,000 *)
   assert (abs_float (mean -. float !smp) <= stddev *. 5.7)
 
 let () =

diff --git a/testsuite/tests/statmemprof/arrays_in_major.reference b/testsuite/tests/statmemprof/arrays_in_major.reference
new file mode 100644 (file)
index 0000000..1f34ad8
--- /dev/null
+++ b/testsuite/tests/statmemprof/arrays_in_major.reference
@@ -0,0 +1,11 @@
+check_nosample
+check_counts_full_major
+check_counts_full_major
+check_no_nested
+check_distrib 300 3000 3 0.000010
+check_distrib 300 3000 1 0.000100
+check_distrib 300 3000 1 0.010000
+check_distrib 300 3000 1 0.900000
+check_distrib 300 300 100000 0.100000
+check_distrib 300000 300000 30 0.100000
+OK !

diff --git a/testsuite/tests/statmemprof/arrays_in_minor.ml b/testsuite/tests/statmemprof/arrays_in_minor.ml
index 2ef78549021e4530ea0cb5a8995be64156b1b4ce..5abee616d744ad4b075335e9dcec973d814aefbf 100644 (file)
--- a/testsuite/tests/statmemprof/arrays_in_minor.ml
+++ b/testsuite/tests/statmemprof/arrays_in_minor.ml
@@ -1,10 +1,11 @@
-(* TEST
- flags = "-g";
- reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
- skip;
-*)
+(* TEST *)
 
-open Gc.Memprof
+module MP = Gc.Memprof
+
+(* Tests that array allocation in the minor heap is properly counted
+   and managed by statmemprof. *)
+
+(* Use a big array as a GC root, to keep allocated arrays alive. *)
 
 let roots = Array.make 1000000 [||]
 let roots_pos = ref 0
@@ -15,6 +16,9 @@ let clear_roots () =
   Array.fill roots 0 !roots_pos [||];
   roots_pos := 0
 
+(* Allocate arrays of all sizes from `lo` to `hi`, `cnt` times. If
+   `keep`, then keep all the arrays, otherwise discard them all. *)
+
 let[@inline never] allocate_arrays lo hi cnt keep =
   assert (0 < lo && hi <= 250);  (* Fits in minor heap. *)
   for j = 0 to cnt-1 do
@@ -24,19 +28,30 @@ let[@inline never] allocate_arrays lo hi cnt keep =
     if not keep then clear_roots ()
   done
 
+(* Check that no allocation callbacks are called if the sampling rate
+   is zero. *)
+
 let check_nosample () =
   Printf.printf "check_nosample\n%!";
   let alloc _ =
     Printf.printf "Callback called with sampling_rate = 0\n";
-    assert(false)
+    assert(false) in
+  let _ = MP.start ~callstack_size:10 ~sampling_rate:0.
+    { MP.null_tracker with alloc_minor = alloc; alloc_major = alloc }
   in
-  start ~callstack_size:10 ~sampling_rate:0.
-    { null_tracker with alloc_minor = alloc; alloc_major = alloc };
   allocate_arrays 1 250 100 false;
-  stop ()
+  MP.stop ()
 
 let () = check_nosample ()
 
+(* Cross-check counts of allocations, promotions, and deallocations,
+   and check that they change appropriately at major collections
+   depending on reachability. Occasionally trigger minor
+   collections. Check that every dealloc callback from the major heap
+   is for a block which has been promoted from the minor heap, and
+   every dealloc callback from the minor heap is for a block which was
+   allocated on the minor heap and has not been promoted. *)
+
 let check_counts_full_major force_promote =
   Printf.printf "check_counts_full_major\n%!";
   let nalloc_minor = ref 0 in
@@ -45,7 +60,7 @@ let check_counts_full_major force_promote =
   let npromote = ref 0 in
   let ndealloc_minor = ref 0 in
   let ndealloc_major = ref 0 in
-  start ~callstack_size:10 ~sampling_rate:0.01
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:0.01
     {
       alloc_minor = (fun info ->
         if !enable then begin
@@ -66,13 +81,19 @@ let check_counts_full_major force_promote =
       dealloc_major = (fun r ->
         assert (!r = 17);
         incr ndealloc_major);
-    };
+    }
+  in
   allocate_arrays 1 250 100 true;
-  enable := false;
+  enable := false; (* stop sampling *)
+  (* everything is still reachable from root, no deallocs *)
   assert (!ndealloc_minor = 0 && !ndealloc_major = 0);
+
   if force_promote then begin
     Gc.full_major ();
     promotes_allowed := false;
+    (* everything is still reachable from root, and
+       everything allocated in the minor heap has now been
+       promoted *)
     allocate_arrays 1 250 10 true;
     Gc.full_major ();
     assert (!ndealloc_minor = 0 && !ndealloc_major = 0 &&
@@ -88,7 +109,7 @@ let check_counts_full_major force_promote =
     assert (!nalloc_minor = !ndealloc_minor + !npromote &&
             !ndealloc_major = !npromote)
   end;
-  stop ()
+  MP.stop ()
 
 let () =
   check_counts_full_major false;
@@ -103,27 +124,27 @@ let check_no_nested () =
     allocate_arrays 1 100 10 false;
     ignore (Array.to_list (Array.make 1000 0));
     in_callback := false;
-    ()
-  in
+    () in
   let cb' _ = cb (); Some () in
-  start ~callstack_size:10 ~sampling_rate:1.
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:1.
     {
       alloc_minor = cb';
       alloc_major = cb';
       promote = cb';
       dealloc_minor = cb;
       dealloc_major = cb;
-    };
+    }
+  in
   allocate_arrays 1 250 5 false;
-  stop ()
+  MP.stop ()
 
 let () = check_no_nested ()
 
 let check_distrib lo hi cnt rate =
   Printf.printf "check_distrib %d %d %d %f\n%!" lo hi cnt rate;
   let smp = ref 0 in
-  start ~callstack_size:10 ~sampling_rate:rate
-    { null_tracker with
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:rate
+    { MP.null_tracker with
       alloc_major = (fun _ -> assert false);
       alloc_minor = (fun info ->
         assert (info.size >= lo && info.size <= hi);
@@ -132,9 +153,10 @@ let check_distrib lo hi cnt rate =
         smp := !smp + info.n_samples;
         None
       );
-    };
+    }
+  in
   allocate_arrays lo hi cnt false;
-  stop ();
+  MP.stop ();
 
   (* The probability distribution of the number of samples follows a
      binomial distribution of parameters tot_alloc and rate. Given

diff --git a/testsuite/tests/statmemprof/arrays_in_minor.reference b/testsuite/tests/statmemprof/arrays_in_minor.reference
new file mode 100644 (file)
index 0000000..1dad919
--- /dev/null
+++ b/testsuite/tests/statmemprof/arrays_in_minor.reference
@@ -0,0 +1,11 @@
+check_nosample
+check_counts_full_major
+check_counts_full_major
+check_no_nested
+check_distrib 1 250 1000 0.000010
+check_distrib 1 250 1000 0.000100
+check_distrib 1 250 1000 0.010000
+check_distrib 1 250 1000 0.900000
+check_distrib 1 1 10000000 0.010000
+check_distrib 250 250 100000 0.100000
+OK !

diff --git a/testsuite/tests/statmemprof/blocking_in_callback.ml b/testsuite/tests/statmemprof/blocking_in_callback.ml
index 72d59e4f3207a21842585d51b9edbe05096ca8e4..f648dae69dcb44794c3c117812d2c69d1db47fa5 100644 (file)
--- a/testsuite/tests/statmemprof/blocking_in_callback.ml
+++ b/testsuite/tests/statmemprof/blocking_in_callback.ml
@@ -1,16 +1,11 @@
 (* TEST
- {
    include systhreads;
    hassysthreads;
- }{
-   reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
-   skip;
    {
      bytecode;
    }{
      native;
    }
- }
 *)
 
 let cnt = ref 0
@@ -72,10 +67,11 @@ let rec go alloc_num tid =
 
 let () =
   let t = Thread.create (fun () -> go 0 1) () in
-  Gc.Memprof.(start ~callstack_size:10 ~sampling_rate:1.
-    { null_tracker with
-      alloc_minor = alloc_callback;
-      alloc_major = alloc_callback });
+  let _:Gc.Memprof.t =
+    Gc.Memprof.(start ~callstack_size:10 ~sampling_rate:1.
+      { null_tracker with
+        alloc_minor = alloc_callback;
+        alloc_major = alloc_callback }) in
   Mutex.unlock mut;
   go 0 0;
   Thread.join t;

diff --git a/testsuite/tests/statmemprof/callstacks.ml b/testsuite/tests/statmemprof/callstacks.ml
index 41263578f42a72bd42030c358e6bc2f5282369df..b7ddfe647f8f5e648b91b3a961ce7a75897f4336 100644 (file)
--- a/testsuite/tests/statmemprof/callstacks.ml
+++ b/testsuite/tests/statmemprof/callstacks.ml
@@ -1,31 +1,15 @@
 (* TEST
- flags = "-g -w -5";
+ flags = "-g";
  {
    reference = "${test_source_directory}/callstacks.flat-float-array.reference";
    flat-float-array;
- }{
-   reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
-   skip;
-   {
-     native;
-   }{
-     bytecode;
-   }
  }{
    reference = "${test_source_directory}/callstacks.no-flat-float-array.reference";
    no-flat-float-array;
- }{
-   reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
-   skip;
-   {
-     native;
-   }{
-     bytecode;
-   }
  }
 *)
 
-open Gc.Memprof
+module MP = Gc.Memprof
 
 let alloc_list_literal () =
   ignore (Sys.opaque_identity [Sys.opaque_identity 1])
@@ -91,8 +75,8 @@ let allocators =
 let test alloc =
   Printf.printf "-----------\n%!";
   let callstack = ref None in
-  start ~callstack_size:10 ~sampling_rate:1.
-    { null_tracker with
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:1.
+    { MP.null_tracker with
       alloc_minor = (fun info ->
          callstack := Some info.callstack;
          None
@@ -101,9 +85,10 @@ let test alloc =
          callstack := Some info.callstack;
          None
       );
-    };
+    }
+  in
   alloc ();
-  stop ();
+  MP.stop ();
   match !callstack with
   | None -> Printf.printf "No callstack\n%!";
   | Some cs -> Printexc.print_raw_backtrace stdout cs

diff --git a/testsuite/tests/statmemprof/comballoc.byte.reference b/testsuite/tests/statmemprof/comballoc.byte.reference
index 4db26f1c993ebaf6f0547b7e3b556f95b6893627..9bed835f9a401f490443e9fe5d520bf743bb87e0 100644 (file)
--- a/testsuite/tests/statmemprof/comballoc.byte.reference
+++ b/testsuite/tests/statmemprof/comballoc.byte.reference
@@ -1,49 +1,40 @@
 2: 0.42 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 3: 0.42 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 4: 0.42 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 11, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
+Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 2: 0.01 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 3: 0.01 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 4: 0.01 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 11, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
+Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 2: 0.83 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 3: 0.83 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 4: 0.83 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 11, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
+Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 OK

diff --git a/testsuite/tests/statmemprof/comballoc.ml b/testsuite/tests/statmemprof/comballoc.ml
index ae35807ba5c86c26aba4581df945442f384e69cb..885b021cf5ff6c14ddf2a12e85ddb5c1f14a16b3 100644 (file)
--- a/testsuite/tests/statmemprof/comballoc.ml
+++ b/testsuite/tests/statmemprof/comballoc.ml
@@ -1,7 +1,5 @@
 (* TEST
  flags = "-g";
- reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
- skip;
  {
    reference = "${test_source_directory}/comballoc.byte.reference";
    bytecode;
@@ -11,20 +9,27 @@
  }
 *)
 
-open Gc.Memprof
+(* Tests that combined allocations are counted correctly by statmemprof *)
 
-let f4 n = (n,n,n,n)
+module MP = Gc.Memprof
 
-let[@inline never] f n =
-  (n, (n, n, f4 n))
+(* A single 5-word allocation - header plus 4 content words *)
+
+let[@inline never] f5 n = (n,n,n,n)
+
+(* A combined 12-word allocation: 5 words, 4 words, and 3 words *)
+
+let[@inline never] f12 n =
+  (n, (n, n, f5 n))
 
 let test sampling_rate =
-  let allocs = Array.make 257 0 in
-  let deallocs = Array.make 257 0 in
-  let promotes = Array.make 257 0 in
-  let callstacks = Array.make 257 None in
-  start ~callstack_size:10  ~sampling_rate
-    { null_tracker with
+  let allocs = Array.make 257 0 in   (* block size -> allocated samples *)
+  let deallocs = Array.make 257 0 in (* block size -> minor-dealloc samples *)
+  let promotes = Array.make 257 0 in (* block size -> promoted samples *)
+  let callstacks = Array.make 257 None in (* block size -> callstack option *)
+  let _:MP.t  = MP.start ~callstack_size:10  ~sampling_rate
+    { MP.null_tracker with
+      (* checks all allocations with a given block size have the same callstack *)
       alloc_minor = (fun info ->
         allocs.(info.size) <- allocs.(info.size) + info.n_samples;
         begin match callstacks.(info.size) with
@@ -37,15 +42,17 @@ let test sampling_rate =
       promote = (fun (sz,n) ->
         promotes.(sz) <- promotes.(sz) + n;
         None);
-    };
+    } in
   let iter = 100_000 in
   let arr = Array.make iter (0,0,0,0) in
   for i = 0 to Array.length arr - 1 do
-    let (_, (_, _, x)) = Sys.opaque_identity f i in
+    (* extract the 5-word alloc from a 12-word comballoc *)
+    let (_, (_, _, x)) = Sys.opaque_identity f12 i in
     arr.(i) <- x;
   done;
   Gc.minor ();
-  stop ();
+  MP.stop ();
+  (* use arr, so it's still alive here and is not collected *)
   ignore (Sys.opaque_identity arr);
   for i = 0 to 256 do
     assert (deallocs.(i) + promotes.(i) = allocs.(i));
@@ -71,24 +78,26 @@ let test sampling_rate =
   done
 
 let () =
-  List.iter test [0.42; 0.01; 0.83]
+  test 0.42;
+  test 0.01;
+  test 0.83
 
 
 let no_callback_after_stop trigger =
   let stopped = ref false in
   let cnt = ref 0 in
-  start ~callstack_size:0 ~sampling_rate:1.
-    { null_tracker with
+  let _:MP.t = MP.start ~callstack_size:0 ~sampling_rate:1.
+    { MP.null_tracker with
       alloc_minor = (fun info ->
         assert(not !stopped);
         incr cnt;
         if !cnt > trigger then begin
-          stop ();
+          MP.stop ();
           stopped := true
         end;
         None);
-    };
-  for i = 0 to 1000 do ignore (Sys.opaque_identity f i) done;
+    } in
+  for i = 0 to 1000 do ignore (Sys.opaque_identity f12 i) done;
   assert !stopped
 
 let () =

diff --git a/testsuite/tests/statmemprof/comballoc.opt.reference b/testsuite/tests/statmemprof/comballoc.opt.reference
index 3afd163aa8dd11c0508ca425d4ecaad1f019e688..9bed835f9a401f490443e9fe5d520bf743bb87e0 100644 (file)
--- a/testsuite/tests/statmemprof/comballoc.opt.reference
+++ b/testsuite/tests/statmemprof/comballoc.opt.reference
@@ -1,49 +1,40 @@
 2: 0.42 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 3: 0.42 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 4: 0.42 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 11, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
+Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 81, characters 2-11
 2: 0.01 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 3: 0.01 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 4: 0.01 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 11, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
+Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 82, characters 2-11
 2: 0.83 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 2-19
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 3: 0.83 false
-Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f12 in file "comballoc.ml", line 23, characters 6-18
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 4: 0.83 true
-Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 11, characters 11-20
-Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
-Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
-Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
+Raised by primitive operation at Comballoc.f5 in file "comballoc.ml", line 18, characters 26-35
+Called from Comballoc.f12 in file "comballoc.ml", line 23, characters 13-17
+Called from Comballoc.test in file "comballoc.ml", line 50, characters 25-50
+Called from Comballoc in file "comballoc.ml", line 83, characters 2-11
 OK

diff --git a/testsuite/tests/statmemprof/custom.ml b/testsuite/tests/statmemprof/custom.ml
index 71e96d36d7030671a3e24267ccbae68e41337b29..2a22dd77b49f1ef70487eec9a1f0d14f5186affa 100644 (file)
--- a/testsuite/tests/statmemprof/custom.ml
+++ b/testsuite/tests/statmemprof/custom.ml
@@ -1,9 +1,7 @@
-(* TEST
- reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
- skip;
-*)
+(* TEST *)
 
-open Gc.Memprof
+module MP = Gc.Memprof
+let () = Gc.set { (Gc.get ()) with minor_heap_size = 262144 }
 
 let bigstring_create sz =
   Bigarray.Array1.create Bigarray.char Bigarray.c_layout sz
@@ -16,7 +14,7 @@ let test sampling_rate =
   let size_words = size / (Sys.word_size / 8) in
   let alloc = ref 0 and collect = ref 0 and promote = ref 0 in
   let tracker =
-    { null_tracker with
+    { MP.null_tracker with
       alloc_minor = (fun info ->
         if info.source <> Custom then None
         else begin
@@ -27,14 +25,14 @@ let test sampling_rate =
         promote := !promote + ns; None);
       dealloc_minor = (fun ns ->
         collect := !collect + ns) } in
-  start ~sampling_rate tracker;
+  let _:MP.t = MP.start ~sampling_rate tracker in
   for i = 1 to iters do
     let str = Sys.opaque_identity bigstring_create size in
     if i mod 10 = 0 then keep := str :: !keep
   done;
   keep := [];
   Gc.full_major ();
-  stop ();
+  MP.stop ();
   assert (!alloc = !promote + !collect);
   let iters = float_of_int iters and size_words = float_of_int size_words in
   (* see comballoc.ml for notes on precision *)

diff --git a/testsuite/tests/statmemprof/discard_in_callback.ml b/testsuite/tests/statmemprof/discard_in_callback.ml
new file mode 100644 (file)
index 0000000..a3b2e16
--- /dev/null
+++ b/testsuite/tests/statmemprof/discard_in_callback.ml
@@ -0,0 +1,131 @@
+(* TEST *)
+
+(* Tests the effects of stopping and discarding the current profile
+   in an allocation callback, particularly in a combined allocation.
+
+   This test is mainly intended to exercise the handling of tracking
+   entries inside statmemprof around profile discarding. Testing that
+   we count the right number of samples etc is of secondary
+   importance. *)
+
+module MP = Gc.Memprof
+
+(* A combined 7-block 33-word allocation *)
+
+let[@inline never] f33 n =
+  ((n, n, (n, n, n, (n,n,n,n,n))), (n, n, (n, n, n, (n,n,n,n,n))))
+
+(* Repeatedly stop sampling and discard the profile in an allocation
+   callback. If `restart` is `true, start a fresh profile in the same
+   callback. Otherwise, start a fresh profile subsequently (not from
+   an allocation callback).
+
+   Because the profile is discarded, even deallocation/promotion
+   callbacks are not called.
+
+   In the native code backend, we have combined allocations. If a
+   single allocation callback from a combined allocation stops
+   sampling and discards the profile, no further allocation callbacks
+   from that combined allocation are called (and none of the blocks
+   are subsequently traced).
+
+   In the bytecode backend, there are no combined allocations, so
+   that special case doesn't apply.
+ *)
+
+let discard_in_alloc restart =
+  let n_prof = ref 0 in (* number of profiles *)
+  let n_alloc = ref 0 in (* allocations in current profile *)
+  let allocs = ref 0 in  (* number of sampled allocations *)
+  let words = ref 0 in (* total size of sampled allocations *)
+
+  let tref = ref MP.null_tracker in
+  let pref = ref (MP.start ~sampling_rate:0.0 MP.null_tracker) in
+  let _ = MP.stop() in
+  let start () = (incr n_prof;
+                  n_alloc := 0;
+                  pref := (MP.start ~sampling_rate:1.0 !tref)) in
+  let stop () = (MP.stop ();
+                 MP.discard (!pref)) in
+
+  let alloc_minor (info:MP.allocation) =
+      (incr allocs;
+       incr n_alloc;
+       words := !words + info.size + 1; (* add 1 for header word *)
+       (* stop/discard profile N after N allocations *)
+       if (!n_alloc) >= (!n_prof) then (stop(); if restart then start());
+       Some (!words)) in (* return a tracker value so entry survives *)
+
+ (* We don't expect any other callbacks *)
+  let promote minor = (assert false) in
+  let dealloc_minor minor = (assert false) in
+  let dealloc_major major = (assert false) in
+  let alloc_major info = (assert false) in
+
+  let tracker = { MP.alloc_minor ;
+                  dealloc_minor ;
+                  promote ;
+                  alloc_major ;
+                  dealloc_major } in
+
+  let res = ref [] in
+
+  tref := tracker;
+  start ();
+  res := (f33 42) :: (!res);
+  if not restart then start ();
+  res := (f33 42) :: (!res);
+  if not restart then start ();
+  res := (f33 42) :: (!res);
+  if not restart then start ();
+  res := (f33 42) :: (!res);
+  if restart then stop();
+  Gc.minor();
+  res := [];
+  Gc.full_major();
+
+  let bytecode = Sys.(backend_type == Bytecode) in
+
+  (* Computations. Each call to f33 allocates 7 blocks of 33 words,
+     (sizes 6, 5, 4, 6, 5, 4, 3) plus the 3 words for the cons cell to
+     add the result to !res, making 8 blocks of 36 words. We do it 4
+     times, so the true total allocation is 32 blocks of 144 words.
+
+     In the bytecode backend, when restarting profiles, we see all these
+     allocations.
+
+     In the bytecode backend, without restarting, we see the first
+     allocation of the first call to f33, the first 2 of the next call,
+     the first 3 of the third call, and the first 4 of the last
+     call. That makes 10 allocations, total size 53 words.
+
+     In the native code backend, without restarting, we see the same
+     allocations as in the bytecode backend.
+
+     In the native code backend, when restarting, we can also see the
+     cons cell allocations, and these account for some of the
+     allocations before each profile is stopped. So we see the first
+     allocation of the first call to f33, the first cons cell and the
+     first allocation of the next f33, the second cons cell and the
+     first 2 allocs of the third call, the third cons cell and the first
+     3 allocs of the last call, and the fourth cons cell. That makes 11
+     allocations, total size 50 words.
+
+     If this were a better test, it would automatically incorporate
+     these calculations, rather than hard-wiring them here. But at least
+     I've shown my working. *)
+
+  assert (!allocs = (if restart then (if bytecode then 4 * (7 + 1)
+                                         else 1 + 2 + 3 + 4 + 1)
+                        else (1 + 2 + 3 + 4)));
+
+  assert (!words = (if restart then (if bytecode
+                                        then (4 * (6 + 5 + 4 +
+                                                     6 + 5 + 4 + 3 + 3))
+                                        else (6 + (3 + 6) + (3 + 6 + 5)
+                                                + (3 + 6 + 5 + 4) + 3))
+                       else (6 + (6 + 5) + (6 + 5 + 4) + (6 + 5 + 4 + 6))));
+  res
+
+let _ = discard_in_alloc true
+let _ = discard_in_alloc false

diff --git a/testsuite/tests/statmemprof/exception_callback.ml b/testsuite/tests/statmemprof/exception_callback.ml
index fb0cedf87b2f5e2896d4e4855e0badfc8285dc3a..b7f32e60ee48c335ce2186d8f12834fb73cab11c 100644 (file)
--- a/testsuite/tests/statmemprof/exception_callback.ml
+++ b/testsuite/tests/statmemprof/exception_callback.ml
@@ -1,30 +1,36 @@
-(* TEST
- exit_status = "2";
- reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
- skip;
-*)
+(* TEST *)
 
-open Gc.Memprof
+(* Tests that an exception in the alloc_major callback propagates
+   correctly to the top level. *)
 
-let alloc_tracker on_alloc =
-  { null_tracker with
-    alloc_minor = (fun info -> on_alloc info; None);
+exception MyExc of string
+
+module MP = Gc.Memprof
+
+let alloc_major_tracker on_alloc =
+  { MP.null_tracker with
     alloc_major = (fun info -> on_alloc info; None);
   }
 
-(* We don't want to print the backtrace. We just want to make sure the
-   exception is printed.
-   This also makes sure [Printexc] is loaded, otherwise we don't use
-   its uncaught exception handler. *)
-let _ = Printexc.record_backtrace false
+(* Run without exception, as the null test *)
 
 let () =
-  start ~callstack_size:10 ~sampling_rate:1.
-    (alloc_tracker (fun _ -> stop ()));
-  ignore (Sys.opaque_identity (Array.make 200 0))
+  ignore (MP.start ~callstack_size:10 ~sampling_rate:1.
+                   (alloc_major_tracker (fun _ -> ())));
+  ignore (Sys.opaque_identity (Array.make 500 0));
+  MP.stop();
+  print_endline "Run without exception."
+
+
+(* Run with an exception *)
 
 let _ =
-  start ~callstack_size:10 ~sampling_rate:1.
-    (alloc_tracker (fun _ -> failwith "callback failed"));
-  ignore (Sys.opaque_identity (Array.make 200 0));
-  stop ()
+try
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:1.
+                   (alloc_major_tracker
+                     (fun _ -> raise (MyExc "major allocation callback"))) in
+   (ignore (Sys.opaque_identity (Array.make 500 0));
+    MP.stop ())
+with
+  MyExc s -> (MP.stop();
+              Printf.printf "Exception from %s.\n" s)

diff --git a/testsuite/tests/statmemprof/exception_callback.reference b/testsuite/tests/statmemprof/exception_callback.reference
index 6371f8249e29d6208f77ed519fd8f902e78b8192..ba185f7c7431253ed328ec828c189fcca0c854a1 100644 (file)
--- a/testsuite/tests/statmemprof/exception_callback.reference
+++ b/testsuite/tests/statmemprof/exception_callback.reference
@@ -1 +1,2 @@
-Fatal error: exception Failure("callback failed")
+Run without exception.
+Exception from major allocation callback.

diff --git a/testsuite/tests/statmemprof/exception_callback_minor.ml b/testsuite/tests/statmemprof/exception_callback_minor.ml
index d389bc5ceb4c83de6870b2e5c15c309317df97a3..33dbc64eda8bd154071ace9d5d665dd50a7e7a8f 100644 (file)
--- a/testsuite/tests/statmemprof/exception_callback_minor.ml
+++ b/testsuite/tests/statmemprof/exception_callback_minor.ml
@@ -1,22 +1,21 @@
-(* TEST
- exit_status = "2";
- reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
- skip;
-*)
+(* TEST *)
 
-open Gc.Memprof
+(* Tests that an exception in the alloc_minor callback propagates
+   correctly to the top level. *)
 
-(* We don't want to print the backtrace. We just want to make sure the
-   exception is printed.
-   This also makes sure [Printexc] is loaded, otherwise we don't use
-   its uncaught exception handler. *)
-let _ = Printexc.record_backtrace false
+exception MyExc of string
+
+module MP = Gc.Memprof
 
 let _ =
-  start ~callstack_size:10 ~sampling_rate:1.
-    { null_tracker with
-      alloc_minor = (fun _ -> assert false);
-      alloc_major = (fun _ -> assert false);
-    };
-  ignore (Sys.opaque_identity (ref (ref 42)));
-  stop ()
+
+try
+   let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:1.
+                  { MP.null_tracker with
+                      alloc_minor =
+                        fun _ -> raise (MyExc "alloc_minor callback") } in
+     (ignore (Sys.opaque_identity (ref (ref 42)));
+      MP.stop ())
+with
+  MyExc s -> (MP.stop();
+              Printf.printf "Exception from %s.\n" s)

diff --git a/testsuite/tests/statmemprof/exception_callback_minor.reference b/testsuite/tests/statmemprof/exception_callback_minor.reference
index af75fbbe9b2be6de46a0701f5fb9b2cbb9543fe9..522c40c44af389648a2e0b90db0ac07a13105a24 100644 (file)
--- a/testsuite/tests/statmemprof/exception_callback_minor.reference
+++ b/testsuite/tests/statmemprof/exception_callback_minor.reference
@@ -1 +1 @@
-Fatal error: exception File "exception_callback_minor.ml", line 16, characters 30-36: Assertion failed
+Exception from alloc_minor callback.

diff --git a/testsuite/tests/statmemprof/exception_comballoc.ml b/testsuite/tests/statmemprof/exception_comballoc.ml
new file mode 100644 (file)
index 0000000..4a8841f
--- /dev/null
+++ b/testsuite/tests/statmemprof/exception_comballoc.ml
@@ -0,0 +1,158 @@
+(* TEST *)
+
+(* Tests that an exception in the alloc_minor callback, during a
+   combined allocation, causes already-run allocation callbacks to
+   be reflected by deallocation callbacks. *)
+
+exception MyExc of string
+
+module MP = Gc.Memprof
+
+(* Similar infrastructure to stop_start_in_callback test *)
+
+(* We need sets of 3-tuples of integers *)
+
+module Int3Tuples =
+struct
+  type t = int * int * int
+  let compare (x0,y0,z0) (x1,y1,z1) =
+    match Stdlib.compare x0 x1 with
+    | 0 -> (match Stdlib.compare y0 y1 with
+            | 0 -> Stdlib.compare z0 z1
+            | c -> c)
+    | c -> c
+end
+
+module AllocSet = Set.Make(Int3Tuples)
+
+(* A combined 7-block 33-word allocation *)
+
+let[@inline never] f33 n =
+  ((n, n, (n, n, n, (n,n,n,n,n))), (n, n, (n, n, n, (n,n,n,n,0))))
+
+(* Raise exceptions from allocation callbacks.
+
+   In the native code backend, we have combined allocations. If a
+   single allocation callback from a combined allocation raises an
+   exception, none of the blocks in that combined allocation are
+   actually allocated. However, some allocation callbacks may have
+   already been called, before the exception is raised, so statmemprof
+   causes their deallocation callbacks also to be called, so that
+   allocation and deallocation callbacks can be matched up.
+
+   In the bytecode backend, there are no combined allocations, so
+   these special cases don't apply: allocation callbacks called before
+   the one which raises an exception reflect actual allocations which
+   happened at that time, so statmemprof doesn't have to fake
+   corresponding deallocations. *)
+
+let raise_in_alloc () =
+  let n_alloc = ref 0 in  (* number of allocations in current profile *)
+  let n_prof = ref 0 in   (* number of profiles *)
+  let n_exc = ref 0 in    (* number of exceptions handled *)
+  let excs = ref AllocSet.empty in
+
+  (* sets of (profile count, allocation count, size), for each operation *)
+  let allocs = ref AllocSet.empty in
+  let deallocs = ref AllocSet.empty in
+
+  let record s (p, a, sz) = s := AllocSet.add (p,a,sz) (!s) in
+  let dealloc_minor minor = (record deallocs minor; ()) in
+  let dealloc_major major = (record deallocs major; ()) in
+
+  let alloc_minor (info:MP.allocation) =
+      (incr n_alloc;
+       let p = !n_prof in
+       let a = !n_alloc in
+       let sz = info.size + 1 in (* add 1 for header word *)
+       record allocs (p,a,sz);
+       (* stop profile N after N allocations *)
+       if a >= p then
+       (record excs (p,a,sz);
+        raise (MyExc "from allocation callback"));
+       Some (p, a, sz)) in
+
+  let promote minor = Some minor in
+  let alloc_major info = (assert false) in   (* We don't expect any *)
+
+  let tracker = { MP.alloc_minor ;
+                  dealloc_minor ;
+                  promote ;
+                  alloc_major ;
+                  dealloc_major } in
+
+  let start () = (incr n_prof;
+                  n_alloc := 0;
+                  ignore (MP.start ~sampling_rate:1.0 tracker)) in
+
+  let arr = ref [] in
+
+  for i = 1 to 10 do
+    start ();
+    (try
+      arr := (f33 42) :: (!arr);
+    with
+      MyExc s -> (incr n_exc));
+    MP.stop();
+    Gc.minor();
+  done;
+  arr := [];
+  Gc.full_major();
+
+  let alloc_size =
+      AllocSet.fold (fun (p,a,sz) tot -> tot + sz) (!allocs) 0 in
+  let alloc_count = AllocSet.cardinal (!allocs) in
+  let dealloc_size =
+      AllocSet.fold (fun (p,a,sz) tot -> tot + sz) (!deallocs) 0 in
+  let dealloc_count = AllocSet.cardinal (!deallocs) in
+
+  (* Every allocation callback is either raised or deallocated *)
+  assert (AllocSet.disjoint (!deallocs) (!excs));
+  assert (AllocSet.equal (AllocSet.union (!deallocs) (!excs)) (!allocs));
+
+  (* Each call to f33 would allocates 7 blocks of 33 words,
+     (sizes 6, 5, 4, 6, 5, 4, 3) plus the 3 words for the cons cell to
+     add the result to !arr, making 8 blocks of 36 words.
+
+     So we see this behaviour, as we iterate through the loop:
+       i allocs exn words
+       1      1   1     6   6
+       2      2   1    11   6+5
+       3      3   1    15   6+5+4
+       4      4   1    21   6+5+4+6
+       5      5   1    26   6+5+4+6+5
+       6      6   1    30   6+5+4+6+5+4
+       7      7   1    33   6+5+4+6+5+4+3
+       8      8   1    36   6+5+4+6+5+4+3+3
+       9      8   0    36   6+5+4+6+5+4+3+3
+      10      8   0    36   6+5+4+6+5+4+3+3
+
+             52   8   250   total
+
+     and of those "allocations" (most of which never actually take
+     place with the native code backend), the profile sees
+     deallocations for all except 8 (the ones for which the callbacks
+     raise exceptions), which add up to 36 words.
+
+   *)
+
+  assert (dealloc_count = 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 8);
+  assert (alloc_count = dealloc_count + !n_exc);
+
+  assert (dealloc_size = (0 +
+                          6 +
+                          6 + 5 +
+                          6 + 5 + 4 +
+                          6 + 5 + 4 + 6 +
+                          6 + 5 + 4 + 6 + 5 +
+                          6 + 5 + 4 + 6 + 5 + 4 +
+                          6 + 5 + 4 + 6 + 5 + 4 + 3 +
+                          6 + 5 + 4 + 6 + 5 + 4 + 3 + 3 +
+                          6 + 5 + 4 + 6 + 5 + 4 + 3 + 3));
+
+  assert (alloc_size = dealloc_size +
+                       (6 + 5 + 4 + 6 + 5 + 4 + 3 + 3));
+  arr
+
+
+let _ = raise_in_alloc ()

diff --git a/testsuite/tests/statmemprof/intern.ml b/testsuite/tests/statmemprof/intern.ml
index f3508261374abaf19e95f2380e481965bcd5ba6a..008d445a478d1e43093e7f92dbd5612bebe67cb0 100644 (file)
--- a/testsuite/tests/statmemprof/intern.ml
+++ b/testsuite/tests/statmemprof/intern.ml
@@ -1,23 +1,25 @@
-(* TEST
- flags = "-g";
- reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
- skip;
-*)
+(* TEST *)
 
-open Gc.Memprof
+module MP = Gc.Memprof
 
 let alloc_tracker on_alloc =
-  { null_tracker with
+  { MP.null_tracker with
     alloc_minor = (fun info -> on_alloc info; None);
     alloc_major = (fun info -> on_alloc info; None);
   }
 
-type t = I of int | II of int * int | Cons of t
-let rec t_of_len = function
-  | len when len <= 1 -> assert false
-  | 2 -> I 1
-  | 3 -> II (2, 3)
-  | len -> Cons (t_of_len (len - 2))
+(* avoiding constant folding, make a value tree consisting of n words *)
+
+type t = O | IIi of int | IIt of t | IIIi of int * int | IIIt of t * t
+let rec t_tree k n = match n with
+   | len when len <= 1 -> O
+   | 2 -> IIi k
+   | 3 -> IIIi (k,k)
+   | 4 -> IIt (IIi k)
+   | 5 -> IIIt (IIi k, O)
+   | 6 -> IIIt (IIIi (k,k), O)
+   | len -> IIIt (t_tree k ((len-3)/2), t_tree k (len - 3 - (len-3)/2));;
+let t_of_len n = t_tree 7 n;;
 
 let marshalled_data = Hashtbl.create 17
 let[@inline never] get_marshalled_data len : t =
@@ -37,6 +39,10 @@ let[@inline never] do_intern lo hi cnt keep =
     if not keep then root := []
   done
 
+(* `get_marshalled_data i` should allocate `i` words with source
+ * `Marshal`, in blocks of size 1 or 2. So `do_intern lo hi cnt _`
+ * should allocate (hi+lo)(hi-lo+1)/2 words. *)
+
 let check_nosample () =
   Printf.printf "check_nosample\n%!";
   precompute_marshalled_data 2 3000;
@@ -44,9 +50,12 @@ let check_nosample () =
     Printf.printf "Callback called with sampling_rate = 0\n";
     assert(false)
   in
-  start ~callstack_size:10 ~sampling_rate:0. (alloc_tracker fail_on_alloc);
+  let _:MP.t =
+    MP.start ~callstack_size:10 ~sampling_rate:0.
+                 (alloc_tracker fail_on_alloc)
+  in
   do_intern 2 3000 1 false;
-  stop ()
+  MP.stop ()
 
 let () = check_nosample ()
 
@@ -59,7 +68,7 @@ let check_counts_full_major force_promote =
   let npromote = ref 0 in
   let ndealloc_minor = ref 0 in
   let ndealloc_major = ref 0 in
-  start ~callstack_size:10 ~sampling_rate:0.01
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:0.01
     {
       alloc_minor = (fun _ ->
         if not !enable then None
@@ -78,7 +87,8 @@ let check_counts_full_major force_promote =
       dealloc_major = (fun _ ->
         incr ndealloc_major
       );
-    };
+    }
+  in
   do_intern 2 3000 1 true;
   enable := false;
   assert (!ndealloc_minor = 0 && !ndealloc_major = 0);
@@ -98,7 +108,7 @@ let check_counts_full_major force_promote =
     assert (!nalloc_minor = !ndealloc_minor + !npromote &&
             !ndealloc_major = !npromote + !nalloc_major)
   end;
-  stop ()
+  MP.stop ()
 
 let () =
   check_counts_full_major false;
@@ -116,16 +126,17 @@ let check_no_nested () =
     ()
   in
   let cb' _ = cb (); Some () in
-  start ~callstack_size:10 ~sampling_rate:1.
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:1.
     {
       alloc_minor = cb';
       alloc_major = cb';
       promote = cb';
       dealloc_minor = cb;
       dealloc_major = cb;
-    };
+    }
+  in
   do_intern 100 200 1 false;
-  stop ()
+  MP.stop ()
 
 let () = check_no_nested ()
 
@@ -133,18 +144,21 @@ let check_distrib lo hi cnt rate =
   Printf.printf "check_distrib %d %d %d %f\n%!" lo hi cnt rate;
   precompute_marshalled_data lo hi;
   let smp = ref 0 in
-  let alloc info =
+  let alloc (info:MP.allocation) =
     (* We also allocate the list constructor in the minor heap,
        so we filter that out. *)
     if info.source = Marshal then begin
       assert (info.size = 1 || info.size = 2);
       assert (info.n_samples > 0);
       smp := !smp + info.n_samples
-    end;
+    end
+  in
+  let _:MP.t =
+    MP.start ~callstack_size:10 ~sampling_rate:rate
+      (alloc_tracker alloc)
   in
-  start ~callstack_size:10 ~sampling_rate:rate (alloc_tracker alloc);
   do_intern lo hi cnt false;
-  stop ();
+  MP.stop ();
 
   (* The probability distribution of the number of samples follows a
      binomial distribution of parameters tot_alloc and rate. Given
@@ -158,7 +172,7 @@ let check_distrib lo hi cnt rate =
           float tot_alloc *. (1. -. rate) > 100.);
   let mean = float tot_alloc *. rate in
   let stddev = sqrt (float tot_alloc *. rate *. (1. -. rate)) in
-  (* This assertion has probability to fail close to 1e-8. *)
+  (* This should fail approximately one time in 100,000,000 *)
   assert (abs_float (mean -. float !smp) <= stddev *. 5.7)
 
 let () =

diff --git a/testsuite/tests/statmemprof/intern.reference b/testsuite/tests/statmemprof/intern.reference
new file mode 100644 (file)
index 0000000..d83e8d6
--- /dev/null
+++ b/testsuite/tests/statmemprof/intern.reference
@@ -0,0 +1,10 @@
+check_nosample
+check_counts_full_major
+check_counts_full_major
+check_no_nested
+check_distrib 2 3000 3 0.000010
+check_distrib 2 3000 1 0.000100
+check_distrib 2 2000 1 0.010000
+check_distrib 2 2000 1 0.900000
+check_distrib 300000 300000 20 0.100000
+OK !

diff --git a/testsuite/tests/statmemprof/lists_in_minor.ml b/testsuite/tests/statmemprof/lists_in_minor.ml
index 24ad6316f9d01a53bfe12951086e0f33a1802bc8..c65d693755c112e792f4740666879f90be67223d 100644 (file)
--- a/testsuite/tests/statmemprof/lists_in_minor.ml
+++ b/testsuite/tests/statmemprof/lists_in_minor.ml
@@ -1,10 +1,9 @@
 (* TEST
  flags = "-g";
  reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
- skip;
 *)
 
-open Gc.Memprof
+module MP = Gc.Memprof
 
 let rec allocate_list accu = function
   | 0 -> accu
@@ -12,24 +11,26 @@ let rec allocate_list accu = function
 
 let[@inline never] allocate_lists len cnt =
   for j = 0 to cnt-1 do
-    ignore (allocate_list [] len)
+    ignore (Sys.opaque_identity (allocate_list [] len))
   done
 
 let check_distrib len cnt rate =
   Printf.printf "check_distrib %d %d %f\n%!" len cnt rate;
+  let tracked = ref 0 in
   let smp = ref 0 in
-  start ~callstack_size:10 ~sampling_rate:rate
-    { null_tracker with
+  let _:MP.t = MP.start ~callstack_size:10 ~sampling_rate:rate
+    { MP.null_tracker with
       alloc_major = (fun _ -> assert false);
       alloc_minor = (fun info ->
         assert (info.size = 2);
         assert (info.n_samples > 0);
         assert (info.source = Normal);
+        incr tracked;
         smp := !smp + info.n_samples;
         None);
-    };
+    } in
   allocate_lists len cnt;
-  stop ();
+  MP.stop ();
 
   (* The probability distribution of the number of samples follows a
      binomial distribution of parameters tot_alloc and rate. Given
@@ -38,13 +39,13 @@ let check_distrib len cnt rate =
      distribution. We compute a 1e-8 confidence interval for !smp
      using quantiles of the normal distribution, and check that we are
      in this confidence interval. *)
-  let tot_alloc = cnt*len*3 in
-  assert (float tot_alloc *. rate > 100. &&
-          float tot_alloc *. (1. -. rate) > 100.);
-  let mean = float tot_alloc *. rate in
-  let stddev = sqrt (float tot_alloc *. rate *. (1. -. rate)) in
-  (* This assertion has probability to fail close to 1e-8. *)
-  assert (abs_float (mean -. float !smp) <= stddev *. 5.7)
+  let tot_alloc = float (cnt*len*3) in
+  assert (tot_alloc *. rate > 100. &&
+          tot_alloc *. (1. -. rate) > 100.);
+  let mean = tot_alloc *. rate in
+  let stddev = sqrt (tot_alloc *. rate *. (1. -. rate)) in
+   (* This should fail approximately one time in 100,000,000 *)
+   assert (abs_float (mean -. float !smp) <= stddev *. 5.7)
 
 let () =
   check_distrib 10 1000000 0.01;

diff --git a/testsuite/tests/statmemprof/lists_in_minor.reference b/testsuite/tests/statmemprof/lists_in_minor.reference
new file mode 100644 (file)
index 0000000..11cfe0c
--- /dev/null
+++ b/testsuite/tests/statmemprof/lists_in_minor.reference
@@ -0,0 +1,8 @@
+check_distrib 10 1000000 0.010000
+check_distrib 1000000 10 0.000010
+check_distrib 1000000 10 0.000100
+check_distrib 1000000 10 0.001000
+check_distrib 1000000 10 0.010000
+check_distrib 100000 10 0.100000
+check_distrib 100000 10 0.900000
+OK !

diff --git a/testsuite/tests/statmemprof/minor_heap_edge.ml b/testsuite/tests/statmemprof/minor_heap_edge.ml
new file mode 100644 (file)
index 0000000..c402a0f
--- /dev/null
+++ b/testsuite/tests/statmemprof/minor_heap_edge.ml
@@ -0,0 +1,56 @@
+(* TEST *)
+
+module MP = Gc.Memprof
+
+(* This is a stress-test for weird behaviour when the minor heap is just about to
+   overflow, which is easier to trigger when the minor heap is small *)
+let () =
+  Gc.set { (Gc.get ()) with minor_heap_size = 2000 }
+
+let f () =
+  let n_allocated = ref 0 in
+  let n_promoted = ref 0 in
+  let n_deallocated = ref 0 in
+  let _:MP.t =
+    let alloc_minor _info =
+      incr n_allocated;
+      for i = 1 to Random.int 500 do
+        ignore (Sys.opaque_identity (ref 42))
+      done;
+      Some ()
+    in
+    let promote () =
+      incr n_promoted;
+      None
+    in
+    let dealloc_minor () =
+      incr n_deallocated;
+      ()
+    in
+    MP.start ~callstack_size:0 ~sampling_rate:1.
+      { MP.null_tracker with alloc_minor; promote; dealloc_minor }
+  in
+  let r = ref 42 in
+  let s = ref [] in
+  for i = 1 to 10_000 do
+    incr r;
+    (* This is a largeish, combined, non-constant allocation,
+       so goes through caml_memprof_track_young *)
+    s := [| 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
+            0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
+            0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
+            0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
+            0; 0; 0; 0; 0; 0; 0; 0; 0; !r; |] :: !s;
+  done;
+  (* make sure all values are promoted *)
+  Gc.full_major ();
+  ignore (Sys.opaque_identity !s);
+  (* make sure all values are collected *)
+  s := [];
+  Gc.full_major ();
+  ignore (Sys.opaque_identity !s);
+  MP.stop ();
+  Printf.printf "%d %d %d\n" !n_allocated !n_promoted !n_deallocated;
+  ()
+
+let () = f ()

diff --git a/testsuite/tests/statmemprof/minor_heap_edge.reference b/testsuite/tests/statmemprof/minor_heap_edge.reference
new file mode 100644 (file)
index 0000000..0633557
--- /dev/null
+++ b/testsuite/tests/statmemprof/minor_heap_edge.reference
@@ -0,0 +1 @@
+20000 20000 0

diff --git a/testsuite/tests/statmemprof/minor_no_postpone.ml b/testsuite/tests/statmemprof/minor_no_postpone.ml
index 395070a2c8d2550a4b636660d3d2470ccd236720..0c7eaf003a64c3b4405baafa0d76d5fc112a4775 100644 (file)
--- a/testsuite/tests/statmemprof/minor_no_postpone.ml
+++ b/testsuite/tests/statmemprof/minor_no_postpone.ml
@@ -1,39 +1,36 @@
 (* TEST
  modules = "minor_no_postpone_stub.c";
- reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
- skip;
 *)
 
-open Gc.Memprof
+module MP = Gc.Memprof
 
-let notify_minor ref_ok ref_done =
-  { null_tracker with
+let profile ref_ok ref_done =
+  MP.start ~callstack_size:0 ~sampling_rate:1.
+   { MP.null_tracker with
     alloc_minor = (fun _ ->
       assert !ref_ok;
       ref_done := true;
       None);
-  }
+    }
 
 let () =
   let callback_ok = ref true in
   let callback_done = ref false in
-  start ~callstack_size:0 ~sampling_rate:1.
-    (notify_minor callback_ok callback_done);
+  let _:MP.t = profile callback_ok callback_done in
   ignore (Sys.opaque_identity (ref 0));
   assert(!callback_done);
   callback_ok := false;
-  stop ()
+  MP.stop ()
 
 external alloc_stub : unit -> unit ref = "alloc_stub"
 
 let () =
   let callback_ok = ref false in
   let callback_done = ref false in
-  start ~callstack_size:0 ~sampling_rate:1.
-    (notify_minor callback_ok callback_done);
+  let _:MP.t = profile callback_ok callback_done in
   ignore (Sys.opaque_identity (alloc_stub ()));
   assert(not !callback_done);
   callback_ok := true;
   ignore (Sys.opaque_identity (ref ()));
   assert(!callback_done);
-  stop ()
+  MP.stop ()

diff --git a/testsuite/tests/statmemprof/minor_no_postpone_stub.c b/testsuite/tests/statmemprof/minor_no_postpone_stub.c
index 5df6cc5144b2f842b70d391bbbf0b21d7803a8aa..778d06808cb01634db4d733463f91c71295c208f 100644 (file)
--- a/testsuite/tests/statmemprof/minor_no_postpone_stub.c
+++ b/testsuite/tests/statmemprof/minor_no_postpone_stub.c
@@ -1,4 +1,4 @@
-#include "caml/alloc.h"
+#include <caml/alloc.h>
 
 value alloc_stub(value v) {
   return caml_alloc(1, 0);

diff --git a/testsuite/tests/statmemprof/moved_while_blocking.ml b/testsuite/tests/statmemprof/moved_while_blocking.ml
index 197c84b153345bf3d312cad28fa2c00314c505b0..523624eae2f693bd837f4ff9e8ef828deca288a5 100644 (file)
--- a/testsuite/tests/statmemprof/moved_while_blocking.ml
+++ b/testsuite/tests/statmemprof/moved_while_blocking.ml
@@ -1,39 +1,90 @@
 (* TEST
+ include systhreads;
+ hassysthreads;
  {
-   include systhreads;
-   hassysthreads;
+   bytecode;
  }{
-   reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
-   skip;
-   {
-     bytecode;
-   }{
-     native;
-   }
+   native;
  }
 *)
 
+(* A few triggers, to control timing of events between threads.
+   `await a` will wait until after `set a` has been called. *)
+
 let t2_begin = Atomic.make false
 let t2_promoting = Atomic.make false
 let t2_finish_promote = Atomic.make false
 let t2_done = Atomic.make false
 let t2_quit = Atomic.make false
+
+(* `await a` waits for the trigger `a` *)
 let await a =
   while not (Atomic.get a) do Thread.yield () done
+
+(* `set a` pulls the trigger `a` *)
 let set a =
   Atomic.set a true
 
 (* no-alloc printing to stdout *)
 let say msg =
-  Unix.write Unix.stdout (Bytes.unsafe_of_string msg) 0 (String.length msg) |> ignore
+  Unix.write_substring Unix.stdout msg 0 (String.length msg)
+  |> ignore
+
+(*
+
+The intended sequence of events in this test is as follows:
+
+- thread 1 spawns thread 2 to run thread_fn.
+
+- thread 2 starts thread_fn, waits for t2_begin.
+
+- thread 1 starts a profile, sampling at 100%, which logs allocations and
+  has a complex "promote" callback which hands control flow back and
+  forth between threads.
+- thread 1 allocates a large object (creating tracking entry 0), then
+  sets t2_begin and awaits t2_promoting. The alloc_major callback is run at
+  some point here, so tracking entry 0 now has no pending callbacks.
+
+- thread 2 wakes on t2_begin.
+- thread 2 allocates a small object, a ref cell, on the minor heap. This
+  creates tracking entry 1, and runs the alloc_minor callback.
+- thread 2 commands a minor collection.
+- In the minor collection, the small object is promoted. Tracking entry 1 is
+  now marked as promoted and having a runnable callback.
+- The promotion callback runs (thread 2 runs this, because thread 1
+  is still waiting for t2_promoting). In the promotion callback, t2_promoting
+  is set, and then t2_finish_promote is awaited.
+
+- thread 1 wakes on t2_promoting, clears its root, and sets off a full
+  major collection which should collect thread 1's large block. The
+  after-major-GC function runs, marking tracking entry 0 as deallocated.
+- thread 1 then sets t2_finish_promote and awaits t2_done.
+
+- thread 2 wakes on t2_finish_promote, finishes its promotion callback, then
+  returns to its main flow of control, clearing the reference to its small
+  block, setting t2_done and awaiting t2_quit.
+
+- thread 1 wakes on t2:done, does another full collection, which should
+  free the small block from thread 2 and mark its tracking entry for a dealloc
+  callback. Then it stops the profile, sets t2_quit, and joins thread 2.
+
+- thread 2 wakes on t2_quit and exits.
+
+- thread 1 joins thread 2 and exits.
+
+Note that the implementation of threads in the bytecode backend
+performs some allocations of its own. TODO: update these to use
+CAML_DONT_TRACK to avoid statmemprof. For now, I have tweaked the test
+so that it doesn't track minor allocations of sizes larger than 1.
+
+*)
 
 let static_ref = ref 0
 let global = ref static_ref
 let thread_fn () =
   await t2_begin;
   say "T2: alloc\n";
-  let r = ref 0 in
-  global := r;
+  global := ref 0;
   say "T2: minor GC\n";
   Gc.minor ();
   global := static_ref;
@@ -51,14 +102,10 @@ let empty_big () = big := [| |]
 
 let () =
   let th = Thread.create thread_fn () in
-  Gc.Memprof.(start ~sampling_rate:1.
+  let _:Gc.Memprof.t = Gc.Memprof.(start ~sampling_rate:1.
     { null_tracker with
-      alloc_minor = (fun _ ->
-        say "    minor alloc\n";
-        Some ());
-      alloc_major = (fun _ ->
-        say "    major alloc\n";
-        Some "major block\n");
+      alloc_minor = (fun info -> say "    minor alloc\n"; Some ());
+      alloc_major = (fun _ -> say "    major alloc\n"; Some "major block\n");
       promote = (fun () ->
         say "    promoting...\n";
         set t2_promoting;
@@ -66,7 +113,8 @@ let () =
         say "    ...done promoting\n";
         Some "promoted block\n");
       dealloc_major = (fun msg ->
-        say "    major dealloc: "; say msg) });
+        say "    major dealloc: "; say msg)})
+  in
   say "T1: alloc\n";
   fill_big ();
   set t2_begin;

diff --git a/testsuite/tests/statmemprof/start_stop.ml b/testsuite/tests/statmemprof/start_stop.ml
new file mode 100644 (file)
index 0000000..ddee570
--- /dev/null
+++ b/testsuite/tests/statmemprof/start_stop.ml
@@ -0,0 +1,106 @@
+(* TEST *)
+
+(* Tests various valid and invalid orderings of start/stop/discard
+statmemprof calls. Doesn't test any callbacks or count any allocations,
+etc.*)
+
+module MP = Gc.Memprof
+
+let prof () = MP.start  ~sampling_rate:1. MP.null_tracker
+
+(* Null test: start/stop/discard *)
+let _ =
+  let profile = prof () in
+  MP.stop ();
+  MP.discard profile;
+  print_endline "Null test."
+
+(* Stop without starting *)
+let _ = try
+  MP.stop ()
+with
+  Failure s -> Printf.printf "Stop without starting fails with \"%s\"\n" s
+
+(* Second start without stopping. *)
+let _ =
+  try
+    Fun.protect ~finally:MP.stop
+      (fun () -> (ignore (prof ());
+                  ignore (prof ())))
+  with
+    Failure s -> Printf.printf "Start without stopping fails with \"%s\"\n" s
+
+(* Discard without stopping. *)
+let _ =
+  try
+    Fun.protect ~finally:MP.stop
+      (fun () -> MP.discard (prof()))
+  with
+    Failure s -> Printf.printf "Discard without stopping fails with \"%s\"\n" s
+
+(* Discard same profile twice. *)
+let _ =
+  let profile = prof () in
+  MP.stop ();
+  MP.discard profile;
+  try
+      MP.discard profile;
+  with
+    Failure s -> Printf.printf "Second discard fails with \"%s\"\n" s
+
+(* Double profile *)
+let _ =
+  ignore (prof ());
+  MP.stop ();
+  ignore (prof ());
+  MP.stop ();
+  print_endline "Double profile."
+
+(* Double profile with intervening discard *)
+let _ =
+  let prof1 = prof () in
+  MP.stop ();
+  MP.discard prof1;
+  ignore (prof ());
+  MP.stop ();
+  print_endline "Double profile with single discard."
+
+(* Double profile, both discarded *)
+let _ =
+  let prof1 = prof () in
+  MP.stop ();
+  MP.discard prof1;
+  let prof2 = prof () in
+  MP.stop ();
+  MP.discard prof2;
+  print_endline "Double profile, discarding both."
+
+(* Double profile, discard both at end *)
+let _ =
+  let prof1 = prof () in
+  MP.stop ();
+  let prof2 = prof () in
+  MP.stop ();
+  MP.discard prof1;
+  MP.discard prof2;
+  print_endline "Double profile, discarding both at end."
+
+(* Double profile, discard in reverse order *)
+let _ =
+  let prof1 = prof () in
+  MP.stop ();
+  let prof2 = prof () in
+  MP.stop ();
+  MP.discard prof2;
+  MP.discard prof1;
+  print_endline "Double profile, discarding in reverse order."
+
+(* Double profile, discard first while second is sampling *)
+let _ =
+  let prof1 = prof () in
+  MP.stop ();
+  let prof2 = prof () in
+  MP.discard prof1;
+  MP.stop ();
+  MP.discard prof2;
+  print_endline "Discarding old profile while sampling."

diff --git a/testsuite/tests/statmemprof/start_stop.reference b/testsuite/tests/statmemprof/start_stop.reference
new file mode 100644 (file)
index 0000000..cd51e19
--- /dev/null
+++ b/testsuite/tests/statmemprof/start_stop.reference
@@ -0,0 +1,11 @@
+Null test.
+Stop without starting fails with "Gc.Memprof.stop: no profile running."
+Start without stopping fails with "Gc.Memprof.start: already started."
+Discard without stopping fails with "Gc.Memprof.discard: profile not stopped."
+Second discard fails with "Gc.Memprof.discard: profile already discarded."
+Double profile.
+Double profile with single discard.
+Double profile, discarding both.
+Double profile, discarding both at end.
+Double profile, discarding in reverse order.
+Discarding old profile while sampling.

diff --git a/testsuite/tests/statmemprof/stop_start_in_callback.ml b/testsuite/tests/statmemprof/stop_start_in_callback.ml
new file mode 100644 (file)
index 0000000..80f10f6
--- /dev/null
+++ b/testsuite/tests/statmemprof/stop_start_in_callback.ml
@@ -0,0 +1,174 @@
+(* TEST *)
+
+(* Tests the effects of stopping and starting profiles in allocation
+   callbacks, particularly in combined allocations.
+
+   This also tests that promotion and deallocation callbacks from old
+   profiles get called correctly even after the profile has stopped
+   sampling. *)
+
+module MP = Gc.Memprof
+
+(* We need sets of 3-tuples of integers *)
+
+module Int3Tuples =
+struct
+  type t = int * int * int
+  let compare (x0,y0,z0) (x1,y1,z1) =
+    match Stdlib.compare x0 x1 with
+    | 0 -> (match Stdlib.compare y0 y1 with
+            | 0 -> Stdlib.compare z0 z1
+            | c -> c)
+    | c -> c
+end
+
+module AllocSet = Set.Make(Int3Tuples)
+
+(* A combined 7-block 33-word allocation *)
+
+let[@inline never] f33 n =
+  ((n, n, (n, n, n, (n,n,n,n,n))), (n, n, (n, n, n, (n,n,n,n,n))))
+
+(* Repeatedly stop sampling from an allocation callback. If `restart`
+   is `true, start a fresh profile in the same callback. Otherwise,
+   start a fresh profile subsequently (not from an allocation
+   callback).
+
+   In the native code backend, we have combined allocations. If a
+   single allocation callback from a combined allocation stops
+   sampling and starts a new profile, blocks from that combined
+   allocation are not subsequently traced.
+
+   However, blocks whose allocation callbacks have already been called
+   do have deallocation callbacks also called, so that allocation and
+   deallocation callbacks can be matched up.
+
+   If an allocation callback from a combined allocation stops
+   sampling, but doesn't start a new profile, the behaviour is much
+   simpler: blocks whose allocation callbacks have already been called
+   are tracked as usual.
+
+   In the bytecode backend, there are no combined allocations, so
+   these special cases don't apply.
+ *)
+
+let stop_in_alloc restart =
+  let n_alloc = ref 0 in  (* number of allocations in current profile *)
+  let n_prof = ref 0 in   (* number of profiles *)
+
+  (* sets of (profile count, allocation count, size), for each operation *)
+  let allocs = ref AllocSet.empty in
+  let promotes = ref AllocSet.empty in
+  let deallocs_minor = ref AllocSet.empty in
+  let deallocs_major = ref AllocSet.empty in
+
+  let record s (p, a, sz) = s := AllocSet.add (p,a,sz) (!s) in
+  let promote minor = (record promotes minor; Some minor) in
+  let dealloc_minor minor = (record deallocs_minor minor; ()) in
+  let dealloc_major major = (record deallocs_major major; ()) in
+
+  let tref = ref MP.null_tracker in
+  let start () = (incr n_prof;
+                  n_alloc := 0;
+                  ignore (MP.start ~sampling_rate:1.0 !tref)) in
+
+  let alloc_minor (info:MP.allocation) =
+      (incr n_alloc;
+       let p = !n_prof in
+       let a = !n_alloc in
+       let sz = info.size + 1 in (* add 1 for header word *)
+       record allocs (p,a,sz);
+       (* stop profile N after N allocations *)
+       if a >= p then
+           (MP.stop ();
+            if restart then start())
+       else ();
+       Some (p, a, sz)) in
+
+  let alloc_major info = (assert false) in (* We don't expect any *)
+
+  let tracker = { MP.alloc_minor ;
+                  dealloc_minor ;
+                  promote ;
+                  alloc_major ;
+                  dealloc_major } in
+  let arr = ref [] in
+
+  tref := tracker;
+  start ();
+
+  arr := (f33 42) :: (!arr);
+  if not restart then start ();
+  arr := (f33 42) :: (!arr);
+  if not restart then start ();
+  arr := (f33 42) :: (!arr);
+  if not restart then start ();
+  arr := (f33 42) :: (!arr);
+  if restart then MP.stop();
+  Gc.minor();
+  arr := [];
+  Gc.full_major();
+
+  let alloc_size =
+      AllocSet.fold (fun (p,a,sz) tot -> tot + sz) (!allocs) 0 in
+  let alloc_count = AllocSet.cardinal (!allocs) in
+  let bytecode = Sys.(backend_type == Bytecode) in
+
+  (* Everything promoted is then dealloc'ed from the major heap *)
+  assert (AllocSet.subset (!promotes) (!deallocs_major));
+
+  (* Everything deallocated was previously allocated *)
+  assert (AllocSet.subset (!deallocs_minor) (!allocs));
+  assert (AllocSet.subset (!deallocs_major) (!allocs));
+
+  (* Each block is only deallocated from one heap *)
+  assert (AllocSet.disjoint (!deallocs_minor) (!deallocs_major));
+
+  (* Every allocated block is deallocated somewhere *)
+  assert (AllocSet.equal (AllocSet.union (!deallocs_minor) (!deallocs_major))
+                         (!allocs));
+
+  (* Computations. Each call to f33 allocates 7 blocks of 33 words,
+     (sizes 6, 5, 4, 6, 5, 4, 3) plus the 3 words for the cons cell to
+     add the result to !arr, making 8 blocks of 36 words. We do it 4
+     times, so the true total allocation is 32 blocks of 144 words.
+
+   In the bytecode backend, when restarting profiles, we see all these
+   allocations.
+
+   In the bytecode backend, without restarting, we see the first
+   allocation of the first call to f33, the first 2 of the next call,
+   the first 3 of the third call, and the first 4 of the last
+   call. That makes 10 allocations, total size 53 words.
+
+   In the native code backend, without restarting, we see the same
+   allocations as in the bytecode backend.
+
+   In the native code backend, when restarting, we can also see the
+   cons cell allocations, and these account for some of the
+   allocations before each profile is stopped. So we see the first
+   allocation of the first call to f33, the first cons cell and the
+   first allocation of the next f33, the second cons cell and the
+   first 2 allocs of the third call, the third cons cell and the first
+   3 allocs of the last call, and the fourth cons cell. That makes 11
+   allocations, total size 50 words.
+
+   If this were a better test, it would automatically incorporate
+   these calculations, rather than hard-wiring them here. But at least
+   I've shown my working. *)
+
+  assert (alloc_count = (if restart then (if bytecode then 4 * (7 + 1)
+                                             else 1 + 2 + 3 + 4 + 1)
+                            else (1 + 2 + 3 + 4)));
+
+  assert (alloc_size = (if restart then (if bytecode
+                                         then (4 * (6 + 5 + 4 +
+                                                       6 + 5 + 4 + 3 + 3))
+                                            else (6 + (3 + 6) + (3 + 6 + 5)
+                                                    + (3 + 6 + 5 + 4) + 3))
+                           else (6 + (6 + 5) + (6 + 5 + 4) + (6 + 5 + 4 + 6))));
+  arr
+
+
+let _ = stop_in_alloc true
+let _ = stop_in_alloc false

diff --git a/testsuite/tests/statmemprof/thread_exit_in_callback.ml b/testsuite/tests/statmemprof/thread_exit_in_callback.ml
index 66d7c601837d910e318aa7785c6dfecaea181dc1..ceeecdf0aa2e7922a8278485cc84dd99f4c237ca 100644 (file)
--- a/testsuite/tests/statmemprof/thread_exit_in_callback.ml
+++ b/testsuite/tests/statmemprof/thread_exit_in_callback.ml
@@ -1,34 +1,29 @@
 (* TEST
+ include systhreads;
+ hassysthreads;
  {
-   include systhreads;
-   hassysthreads;
+   bytecode;
  }{
-   reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634";
-   skip;
-   {
-     bytecode;
-   }{
-     native;
-   }
+   native;
  }
 *)
 
+(* Tests statmemprof behaviour when a callback terminates its thread.
+   The expected behaviour is that the thread exits, but sampling
+   continues in other threads of the same domain. Note that this test
+   doesn't currently test that sampling continues!  *)
+
 let _ =
   let main_thread = Thread.id (Thread.self ()) in
-  Gc.Memprof.(start ~callstack_size:10 ~sampling_rate:1.
+  let _:Gc.Memprof.t = Gc.Memprof.(start ~callstack_size:10 ~sampling_rate:1.
                 { null_tracker with alloc_minor = fun _ ->
                       if Thread.id (Thread.self ()) <> main_thread then
-                        Thread.exit ();
-                      None });
+                      raise Thread.Exit;
+                      None })
+  in
   let t = Thread.create (fun () ->
       ignore (Sys.opaque_identity (ref 1));
       assert false) ()
   in
   Thread.join t;
   Gc.Memprof.stop ()
-
-let _ =
-  Gc.Memprof.(start ~callstack_size:10 ~sampling_rate:1.
-    { null_tracker with alloc_minor = fun _ -> Thread.exit (); None });
-  ignore (Sys.opaque_identity (ref 1));
-  assert false

diff --git a/testsuite/tests/tool-caml-tex/redirections.reference b/testsuite/tests/tool-caml-tex/redirections.reference
index 529520fe2db18704f05cb832d67e7485aca8d458..f1fa54c0da452dbff82a5077212947f638950c33 100644 (file)
--- a/testsuite/tests/tool-caml-tex/redirections.reference
+++ b/testsuite/tests/tool-caml-tex/redirections.reference
@@ -9,7 +9,7 @@ $\?$ [@@@warning "+A"];;
 $\?$ 1 + <<2.>> ;;
 \end{camlinput}
 \begin{camlerror}
-Error: This expression has type float but an expression was expected of type
+Error: The constant 2. has type float but an expression was expected of type
          int
 \end{camlerror}
 \end{caml}

diff --git a/testsuite/tests/tool-expect-test/clean_typer.ml b/testsuite/tests/tool-expect-test/clean_typer.ml
index b4b023f029f1a846fdcae93e4574bff99c821cd9..29796ce97ad4e53a1f6529189efdd2a720daf4f7 100644 (file)
--- a/testsuite/tests/tool-expect-test/clean_typer.ml
+++ b/testsuite/tests/tool-expect-test/clean_typer.ml
@@ -64,7 +64,7 @@ let f2 = ffoo bar;;
 Line 1, characters 14-17:
 1 | let f2 = ffoo bar;;
                   ^^^
-Error: This expression has type "Variants.bar M.t"
+Error: The value "bar" has type "Variants.bar M.t"
        but an expression was expected of type "Variants.foo M.t"
        Type "Variants.bar" = "[ `Bar ]" is not compatible with type "Variants.foo"
        The first variant type does not allow tag(s) "`Foo"
@@ -75,7 +75,7 @@ let f3 = fbar foo;;
 Line 1, characters 14-17:
 1 | let f3 = fbar foo;;
                   ^^^
-Error: This expression has type "Variants.foo M.t"
+Error: The value "foo" has type "Variants.foo M.t"
        but an expression was expected of type "Variants.bar M.t"
        Type "Variants.foo" is not compatible with type "Variants.bar" = "[ `Bar ]"
        The second variant type does not allow tag(s) "`Foo"

diff --git a/testsuite/tests/tool-lexyacc/csets.mll b/testsuite/tests/tool-lexyacc/csets.mll
index a1aefeee43816319a49d9c1578cec091db833d09..5af555b38f8f14d63e2e37eef817920be5351c7a 100644 (file)
--- a/testsuite/tests/tool-lexyacc/csets.mll
+++ b/testsuite/tests/tool-lexyacc/csets.mll
@@ -7,7 +7,7 @@ let alpha = ['a'-'z']
 let alpha' = (digit | alpha) # digit
 
 rule read = parse
-| alpha'+ as lxm { Some lxm }
+| alpha'+ as lxm { (Some lxm) }
 | digit+ as lxm { Some lxm }
 | eof { None }
 

diff --git a/testsuite/tests/tool-ocaml/gpr12887.compilers.reference b/testsuite/tests/tool-ocaml/gpr12887.compilers.reference
new file mode 100644 (file)
index 0000000..f89bd1c
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/gpr12887.compilers.reference
@@ -0,0 +1 @@
+Exception: Failure "Print me".

diff --git a/testsuite/tests/tool-ocaml/gpr12887.ml b/testsuite/tests/tool-ocaml/gpr12887.ml
new file mode 100644 (file)
index 0000000..0455755
--- /dev/null
+++ b/testsuite/tests/tool-ocaml/gpr12887.ml
@@ -0,0 +1,12 @@
+(* TEST
+   setup-ocamlc.byte-build-env;
+   compile_only = "true";
+   ocamlc.byte;
+   flags = "gpr12887.cmo";
+   ocaml_exit_status = "2";
+   ocamlrunparam = "b=0,v=0x0";
+   ocaml;
+   check-ocaml-output;
+*)
+
+let () = failwith "Print me"

diff --git a/testsuite/tests/tool-ocamlc-locations/marshalled.compilers.reference b/testsuite/tests/tool-ocamlc-locations/marshalled.compilers.reference
index 770d3bfc37c871a29026693dd1496fe90d57c093..73740d4e5d2848da35c0566fd4646050dcb8aae5 100644 (file)
--- a/testsuite/tests/tool-ocamlc-locations/marshalled.compilers.reference
+++ b/testsuite/tests/tool-ocamlc-locations/marshalled.compilers.reference
@@ -1,5 +1,5 @@
 File "foo.ml", line 1, characters 14-18:
 1 | let x : int = true
                   ^^^^
-Error: This expression has type "bool" but an expression was expected of type
-         "int"
+Error: The constructor "true" has type "bool"
+       but an expression was expected of type "int"

diff --git a/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.compilers.reference b/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.compilers.reference
index 0e9c1703ed24cd53005af27df63d8922cdfe5c7a..1590b6994e66b46a2d4495fe79565d3cebc1e430 100644 (file)
--- a/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.compilers.reference
+++ b/testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.compilers.reference
@@ -20,11 +20,15 @@
                   <arg>
                   Nolabel
                     expression (stop_after_parsing_impl.ml[12,306+9]..[12,306+10])
-                      Pexp_constant PConst_int (1,None)
+                      Pexp_constant
+                      constant (stop_after_parsing_impl.ml[12,306+9]..[12,306+10])
+                        PConst_int (1,None)
                   <arg>
                   Nolabel
                     expression (stop_after_parsing_impl.ml[12,306+13]..[12,306+19])
-                      Pexp_constant PConst_string("true",(stop_after_parsing_impl.ml[12,306+14]..[12,306+18]),None)
+                      Pexp_constant
+                      constant (stop_after_parsing_impl.ml[12,306+13]..[12,306+19])
+                        PConst_string("true",(stop_after_parsing_impl.ml[12,306+14]..[12,306+18]),None)
                 ]
             <arg>
             Nolabel

diff --git a/testsuite/tests/tool-ocamldoc/Alert_toplevel.html.reference b/testsuite/tests/tool-ocamldoc/Alert_toplevel.html.reference
index 5c040507226116d1a03569e98745cc4ab3988165..d3e5c6b17e000ed6aefcf3e363eb1f0f375c8441 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Alert_toplevel.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Alert_toplevel.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Alert_toplevel2.html.reference b/testsuite/tests/tool-ocamldoc/Alert_toplevel2.html.reference
index ae9af6b0252d00317a670bde7db20eea1b71d86c..e8537fc814f890e9cd149640657befc5e61d38bd 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Alert_toplevel2.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Alert_toplevel2.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Alerts.html.reference b/testsuite/tests/tool-ocamldoc/Alerts.html.reference
index 8441b6dd30e8a6b8efb55601c22f8516753ef6d9..4d656108226e9ee72953a48ff42707b5f27a91dd 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Alerts.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Alerts.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Alerts_impl.html.reference b/testsuite/tests/tool-ocamldoc/Alerts_impl.html.reference
index 8f7c33bed46b3f3a09ba8481cb6c9251945a4f68..611b043c9b48d438868ac64d54775fbcd079848f 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Alerts_impl.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Alerts_impl.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Documentation_tags.html.reference b/testsuite/tests/tool-ocamldoc/Documentation_tags.html.reference
index 90955fe369ce3d4639a1fe351dc724107e547961..b8ba553e0e2fc5d7b4aa9ed7e6aea0c991937a69 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Documentation_tags.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Documentation_tags.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Entities.html.reference b/testsuite/tests/tool-ocamldoc/Entities.html.reference
index dde148dd107ec154eecd843cccb6ef0b0f59d92b..fd33dd1bd236806bd0ac8068f41861a12f882769 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Entities.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Entities.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Functions.html.reference b/testsuite/tests/tool-ocamldoc/Functions.html.reference
index eabae30d4b19f2ece78e8e2acc70d08381790073..7f18d3e0f606221accffc0d7627411e80b0397c3 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Functions.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Functions.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Include_module_type_of.html.reference b/testsuite/tests/tool-ocamldoc/Include_module_type_of.html.reference
index b0b9089f90f5a537a082a689c6e85df65d2c37f1..276b48057e0ed68201bc9ea3adf6958980a52a91 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Include_module_type_of.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Include_module_type_of.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Inline_records.html.reference b/testsuite/tests/tool-ocamldoc/Inline_records.html.reference
index 2a53b4673bbb8f85298e7e73a8a6009a21779a83..21f2a6f20063d022c28c60c704d593f174b9a75f 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Inline_records.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Inline_records.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Item_ids.html.reference b/testsuite/tests/tool-ocamldoc/Item_ids.html.reference
index 460831c2a9b7cba07c3564576d5b64e9b973ddfe..7b6948fdf7afc1aea3df384e073b77566aeb324b 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Item_ids.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Item_ids.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Latin9.html.reference b/testsuite/tests/tool-ocamldoc/Latin9.html.reference
new file mode 100644 (file)
index 0000000..50ecbbc
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Latin9.html.reference
@@ -0,0 +1,37 @@
+<!DOCTYPE html>
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
+<meta name="viewport" content="width=device-width, initial-scale=1">
+<link rel="Start" href="index.html">
+<link rel="Up" href="index.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Latin9" rel="Chapter" href="Latin9.html"><title>Latin9</title>
+</head>
+<body>
+<div class="navbar">&nbsp;<a class="up" href="index.html" title="Index">Up</a>
+&nbsp;</div>
+<h1>Module <a href="type_Latin9.html">Latin9</a></h1>
+
+<pre><span id="MODULELatin9"><span class="keyword">module</span> Latin9</span>: <code class="code"><span class="keyword">sig</span></code> <a href="Latin9.html">..</a> <code class="code"><span class="keyword">end</span></code></pre><hr width="100%">
+
+<pre><span id="MODULEÉté"><span class="keyword">module</span> <a href="Latin9.Été-c.html">Été</a></span>: <code class="code"><span class="keyword">sig</span></code> <a href="Latin9.Été-c.html">..</a> <code class="code"><span class="keyword">end</span></code></pre>
+<pre><span id="EXCEPTIONLà"><span class="keyword">exception</span> Là</span></pre>
+
+<pre><span id="VALf"><span class="keyword">val</span> f</span> : <code class="type">int -&gt; 'a</code></pre><div class="info ">
+<div class="info-desc">
+<p>Exceptions and parameters must be in latin-9 subset of unicode.
+    In the @since version and in the description any character (e.g 字) is accepted:</p>
+</div>
+<ul class="info-attributes">
+<li><b>Since</b> λ1</li>
+<li><b>Raises</b><ul><li><code>Là</code> स्तनति</li>
+<li><code>Été.Éclair</code> þunor</li>
+</ul></li>
+</ul>
+</div>
+<div class="param_info"><code class="code">éponyme</code> : ?</div>
+</body></html>

diff --git a/testsuite/tests/tool-ocamldoc/Latin9.ml b/testsuite/tests/tool-ocamldoc/Latin9.ml
new file mode 100644 (file)
index 0000000..9a30a5d
--- /dev/null
+++ b/testsuite/tests/tool-ocamldoc/Latin9.ml
@@ -0,0 +1,18 @@
+(* TEST
+  ocamldoc with html;
+*)
+
+module Été = struct
+ exception Éclair
+end
+
+exception Là
+
+(** Exceptions and parameters must be in latin-9 subset of unicode.
+    In the \@since version and in the description any character (e.g 字) is accepted:
+   @since λ1
+   @raise Là स्तनति
+   @raise Été.Éclair þunor
+   @param éponyme ?
+*)
+let f éponyme = if Random.int 2 > éponyme then raise Été.Éclair else raise Là

diff --git a/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference b/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference
index 66b0dd9df2186fdbbdc2d5484be885523d7de8c6..c55da42b7505214e53b5ce256d8729d240415aba 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Linebreaks.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Loop.html.reference b/testsuite/tests/tool-ocamldoc/Loop.html.reference
index 30c2864f0381e72d001984c545c6ad6ef9b2cebb..395d39e9a8ff76852527a3a752bc573ed0af94ea 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Loop.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Loop.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference b/testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference
index 2f5252e27c1fd6e29ff3ce35cc06f9a29eb10277..244d0bfb4d6def7c930f7743e5345b725e569487 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/No_preamble.html.reference b/testsuite/tests/tool-ocamldoc/No_preamble.html.reference
index 3125b08df456f7214a7213670043d09a5fe8a918..df04ed5952dfc0cdfed00fb9dc03ffdc1f7a37c6 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/No_preamble.html.reference
+++ b/testsuite/tests/tool-ocamldoc/No_preamble.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Paragraph.html.reference b/testsuite/tests/tool-ocamldoc/Paragraph.html.reference
index b132f065ad7ba4451e7b090a2d1525e1ef3211cf..5e527f0c0e044f68bf11518dcc42d2d11404e350 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Paragraph.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Paragraph.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/Variants.html.reference b/testsuite/tests/tool-ocamldoc/Variants.html.reference
index 35733fe8a418e96680183c09fa896dc643f47f1b..7c7a4e56fc717ce8561e2dde416ab957610bd97d 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/Variants.html.reference
+++ b/testsuite/tests/tool-ocamldoc/Variants.html.reference
@@ -2,7 +2,7 @@
 <html>
 <head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link rel="Up" href="index.html">

diff --git a/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference b/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference
index 86bd864601dc50572f7e0a19000f440ad560d9a5..2e924f81a08edd0f8b23059aa42813e3d0d594c6 100644 (file)
--- a/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference
+++ b/testsuite/tests/tool-ocamldoc/type_Linebreaks.reference
@@ -1,6 +1,6 @@
 <html><head>
 <link rel="stylesheet" href="style.css" type="text/css">
-<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta content="text/html; charset=UTF-8" http-equiv="Content-Type">
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="Start" href="index.html">
 <link title="Index of types" rel=Appendix href="index_types.html">

diff --git a/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference b/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference
index e24f26006af9ccc404034113d7794d1ea33f1b86..fe9f728779dbcde3e7df79ea5562269ca325a5f9 100644 (file)
--- a/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference
+++ b/testsuite/tests/tool-toplevel/error_highlighting.compilers.reference
@@ -22,7 +22,7 @@ Line 2, characters 8-9:
 Line 3, characters 8-9:
 3 | let y = 1 +. 2. in
             ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "1" has type "int" but an expression was expected of type
          "float"
   Hint: Did you mean "1."?
 Line 4, characters 2-4:
@@ -42,7 +42,7 @@ Error: This expression has type "int" but an expression was expected of type
 Line 2, characters 12-17:
 2 | let x = 1 + "abc" in
                 ^^^^^
-Error: This expression has type "string" but an expression was expected of type
+Error: This constant has type "string" but an expression was expected of type
          "int"
 File "error_highlighting_use1.ml", line 1, characters 8-15:
 1 | let x = (1 + 2) +. 3. in ();;

diff --git a/testsuite/tests/tool-toplevel/exotic_lists.compilers.reference b/testsuite/tests/tool-toplevel/exotic_lists.compilers.reference
index 957052bafbf50cbe231e265fbe97ec1d4cf1ece4..e7885856f2df84dabcf9e6b8f5eb5fbc3838f1bb 100644 (file)
--- a/testsuite/tests/tool-toplevel/exotic_lists.compilers.reference
+++ b/testsuite/tests/tool-toplevel/exotic_lists.compilers.reference
@@ -5,10 +5,6 @@ L.(::) ([1; 2],
 - : (int, string) L.t =
 (::) (1, (::) ("2", (::) (3, (::) ("4", (::) (5, [])))))
 module L : sig type 'a t = 'a list = [] | (::) of 'a * 'a t end
-- : int L.t L.t =
-L.(::) (L.(::) (1, L.[]),
- L.(::) (L.(::) (2, L.[]),
-  L.(::) (L.(::) (3, L.[]),
-   L.(::) (L.(::) (4, L.[]), L.(::) (L.(::) (5, L.[]), L.[])))))
-- : int L.t = (::) (1, (::) (2, (::) (3, (::) (4, (::) (5, [])))))
+- : int L.t L.t = [[1]; [2]; [3]; [4]; [5]]
+- : int L.t = [1; 2; 3; 4; 5]
 

diff --git a/testsuite/tests/tool-toplevel/multi_phrase_line.compilers.reference b/testsuite/tests/tool-toplevel/multi_phrase_line.compilers.reference
index d02a6629bb40cfc3a41b2472f3df1c6124e3baeb..edb97986d096f11a9e68736deecb6cace158a12d 100644 (file)
--- a/testsuite/tests/tool-toplevel/multi_phrase_line.compilers.reference
+++ b/testsuite/tests/tool-toplevel/multi_phrase_line.compilers.reference
@@ -21,8 +21,8 @@ Error: Syntax error
 Line 2, characters 16-20:
 2 | 11;; let x = 12+true;; 13;; (* Type error in second phrase. *)
                     ^^^^
-Error: This expression has type "bool" but an expression was expected of type
-         "int"
+Error: The constructor "true" has type "bool"
+       but an expression was expected of type "int"
 #   Line 2, characters 0-22:
 2 | match 14 with 15 -> ();; 16;; 17;; (* Warning + run-time error in 1st phrase. *)
     ^^^^^^^^^^^^^^^^^^^^^^

diff --git a/testsuite/tests/tool-toplevel/pr7751.compilers.reference b/testsuite/tests/tool-toplevel/pr7751.compilers.reference
index 5cdf1246f51f9f9453f9e3bc276a8a1f3fe7d5d4..0642a606e17646fa743c18b0c0b2767520551078 100644 (file)
--- a/testsuite/tests/tool-toplevel/pr7751.compilers.reference
+++ b/testsuite/tests/tool-toplevel/pr7751.compilers.reference
@@ -1,6 +1,13 @@
 - : Parsetree.expression =
 {Parsetree.pexp_desc =
-  Parsetree.Pexp_constant (Parsetree.Pconst_integer ("1", None));
+  Parsetree.Pexp_constant
+   {Parsetree.pconst_desc = Parsetree.Pconst_integer ("1", None);
+    pconst_loc =
+     {Location.loc_start =
+       {Lexing.pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 0};
+      loc_end =
+       {Lexing.pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 1};
+      loc_ghost = false}};
  pexp_loc =
   {Location.loc_start =
     {Lexing.pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 0};

diff --git a/testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference b/testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference
index 92223d7aac57c00592cb4bf2301e27ad6cf8028c..e24fde646b706232158784442b3c60b0777124d4 100644 (file)
--- a/testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference
+++ b/testsuite/tests/tool-toplevel/redefinition_hints.compilers.reference
@@ -14,7 +14,7 @@ val y : (u * v * (module S)) M.t = M.X (A, B, <module>)
 Line 2, characters 4-5:
 2 | x = y;;
         ^
-Error: This expression has type "(u * v * (module S)) M.t"
+Error: The value "y" has type "(u * v * (module S)) M.t"
        but an expression was expected of type
          "(u/2 * v/2 * (module S/2)) M/2.t"
        Hint: The types "v" and "u" have been defined multiple times in this
@@ -35,22 +35,21 @@ val c : a = A
 Line 2, characters 4-5:
 2 | a = b;;
         ^
-Error: This expression has type "a/2" but an expression was expected of type
-         "a/3"
+Error: The value "b" has type "a/2" but an expression was expected of type "a/3"
        Hint: The type "a" has been defined multiple times in this toplevel
          session. Some toplevel values still refer to old versions of this
          type. Did you try to redefine them?
 Line 1, characters 4-5:
 1 | a = c;;
         ^
-Error: This expression has type "a" but an expression was expected of type "a/3"
+Error: The value "c" has type "a" but an expression was expected of type "a/3"
        Hint: The type "a" has been defined multiple times in this toplevel
          session. Some toplevel values still refer to old versions of this
          type. Did you try to redefine them?
 Line 1, characters 4-5:
 1 | b = c;;
         ^
-Error: This expression has type "a" but an expression was expected of type "a/2"
+Error: The value "c" has type "a" but an expression was expected of type "a/2"
        Hint: The type "a" has been defined multiple times in this toplevel
          session. Some toplevel values still refer to old versions of this
          type. Did you try to redefine them?

diff --git a/testsuite/tests/tool-toplevel/use_command.ml b/testsuite/tests/tool-toplevel/use_command.ml
index ca5066532081df8acf15fcfb5a579e22eef4b82d..c97c877b13472454ea0ab5526c8c4cfdd6fee0ed 100644 (file)
--- a/testsuite/tests/tool-toplevel/use_command.ml
+++ b/testsuite/tests/tool-toplevel/use_command.ml
@@ -20,6 +20,6 @@ Command exited with code 1.
 File "(command-output)", line 1, characters 5-6:
 1 | 1 :: x
          ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The value "x" has type "int" but an expression was expected of type
          "int list"
 |}];;

diff --git a/testsuite/tests/tsan/callbacks.c b/testsuite/tests/tsan/callbacks.c
index 59aa998fbc784a8a957144f13b29492b4c43a5e5..304ceb12e87dcaf7615fc891ecdd1de963ebb243 100644 (file)
--- a/testsuite/tests/tsan/callbacks.c
+++ b/testsuite/tests/tsan/callbacks.c
@@ -2,10 +2,10 @@
 #include <time.h>
 
 #define CAML_NAME_SPACE
-#include "caml/mlvalues.h"
-#include "caml/fail.h"
-#include "caml/memory.h"
-#include "caml/callback.h"
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/callback.h>
 
 value print_and_call_ocaml_h(value unit)
 {

diff --git a/testsuite/tests/typing-core-bugs/const_int_hint.ml b/testsuite/tests/typing-core-bugs/const_int_hint.ml
index 4af05359a1ff9c9bc8556b93efcdfd025098a044..8ebe7fd3100ff7c6bc7a94eb607cfb154966c56f 100644 (file)
--- a/testsuite/tests/typing-core-bugs/const_int_hint.ml
+++ b/testsuite/tests/typing-core-bugs/const_int_hint.ml
@@ -7,7 +7,7 @@ let _ = Int32.(add 1 2l);;
 Line 1, characters 19-20:
 1 | let _ = Int32.(add 1 2l);;
                        ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "1" has type "int" but an expression was expected of type
          "int32"
   Hint: Did you mean "1l"?
 |}]
@@ -17,7 +17,7 @@ let _ : int32 * int32 = 42l, 43;;
 Line 1, characters 29-31:
 1 | let _ : int32 * int32 = 42l, 43;;
                                  ^^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "43" has type "int" but an expression was expected of type
          "int32"
   Hint: Did you mean "43l"?
 |}]
@@ -27,7 +27,7 @@ let _ : int32 * nativeint = 42l, 43;;
 Line 1, characters 33-35:
 1 | let _ : int32 * nativeint = 42l, 43;;
                                      ^^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "43" has type "int" but an expression was expected of type
          "nativeint"
   Hint: Did you mean "43n"?
 |}]
@@ -37,7 +37,7 @@ let _ = min 6L 7;;
 Line 1, characters 15-16:
 1 | let _ = min 6L 7;;
                    ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "7" has type "int" but an expression was expected of type
          "int64"
   Hint: Did you mean "7L"?
 |}]
@@ -47,7 +47,7 @@ let _ : float = 123;;
 Line 1, characters 16-19:
 1 | let _ : float = 123;;
                     ^^^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "123" has type "int" but an expression was expected of type
          "float"
   Hint: Did you mean "123."?
 |}]
@@ -60,8 +60,7 @@ val x : int = 0
 Line 2, characters 19-20:
 2 | let _ = Int32.(add x 2l);;
                        ^
-Error: This expression has type "int" but an expression was expected of type
-         "int32"
+Error: The value "x" has type "int" but an expression was expected of type "int32"
 |}]
 
 (* pattern *)
@@ -95,7 +94,7 @@ let _ : int32 = 1L;;
 Line 1, characters 16-18:
 1 | let _ : int32 = 1L;;
                     ^^
-Error: This expression has type "int64" but an expression was expected of type
+Error: The constant "1L" has type "int64" but an expression was expected of type
          "int32"
   Hint: Did you mean "1l"?
 |}]
@@ -104,7 +103,7 @@ let _ : float = 1L;;
 Line 1, characters 16-18:
 1 | let _ : float = 1L;;
                     ^^
-Error: This expression has type "int64" but an expression was expected of type
+Error: The constant "1L" has type "int64" but an expression was expected of type
          "float"
   Hint: Did you mean "1."?
 |}]
@@ -113,7 +112,7 @@ let _ : int64 = 1n;;
 Line 1, characters 16-18:
 1 | let _ : int64 = 1n;;
                     ^^
-Error: This expression has type "nativeint"
+Error: The constant "1n" has type "nativeint"
        but an expression was expected of type "int64"
   Hint: Did you mean "1L"?
 |}]
@@ -122,7 +121,7 @@ let _ : nativeint = 1l;;
 Line 1, characters 20-22:
 1 | let _ : nativeint = 1l;;
                         ^^
-Error: This expression has type "int32" but an expression was expected of type
+Error: The constant "1l" has type "int32" but an expression was expected of type
          "nativeint"
   Hint: Did you mean "1n"?
 |}]
@@ -133,7 +132,7 @@ let _ : int64 = 0.;;
 Line 1, characters 16-18:
 1 | let _ : int64 = 0.;;
                     ^^
-Error: This expression has type "float" but an expression was expected of type
+Error: The constant "0." has type "float" but an expression was expected of type
          "int64"
 |}]
 let _ : int = 1L;;
@@ -141,7 +140,7 @@ let _ : int = 1L;;
 Line 1, characters 14-16:
 1 | let _ : int = 1L;;
                   ^^
-Error: This expression has type "int64" but an expression was expected of type
+Error: The constant "1L" has type "int64" but an expression was expected of type
          "int"
 |}]
 
@@ -152,7 +151,7 @@ let _ : int64 = min 0L 1_000;;
 Line 1, characters 23-28:
 1 | let _ : int64 = min 0L 1_000;;
                            ^^^^^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "1_000" has type "int" but an expression was expected of type
          "int64"
   Hint: Did you mean "1_000L"?
 |}]
@@ -161,8 +160,8 @@ let _ : nativeint * nativeint = 0n, 0xAA_BBL;;
 Line 1, characters 36-44:
 1 | let _ : nativeint * nativeint = 0n, 0xAA_BBL;;
                                         ^^^^^^^^
-Error: This expression has type "int64" but an expression was expected of type
-         "nativeint"
+Error: The constant "0xAA_BBL" has type "int64"
+       but an expression was expected of type "nativeint"
   Hint: Did you mean "0xAA_BBn"?
 |}]
 let _ : int32 -> int32 = function
@@ -193,7 +192,7 @@ type t1 = { f1 : int32; }
 Line 1, characters 49-55:
 1 | type t1 = {f1: int32};; let _ = fun x -> x.f1 <- 1_000n;;
                                                      ^^^^^^
-Error: This expression has type "nativeint"
+Error: The constant "1_000n" has type "nativeint"
        but an expression was expected of type "int32"
   Hint: Did you mean "1_000l"?
 |}]

diff --git a/testsuite/tests/typing-core-bugs/type_expected_explanation.ml b/testsuite/tests/typing-core-bugs/type_expected_explanation.ml
index c34a060d4901b62d1e5d2dbdbaf92879466d5747..7e904aed4d77cfece59dcd2ea611ca179d08ad55 100644 (file)
--- a/testsuite/tests/typing-core-bugs/type_expected_explanation.ml
+++ b/testsuite/tests/typing-core-bugs/type_expected_explanation.ml
@@ -9,7 +9,7 @@ if 3 then ();;
 Line 1, characters 3-4:
 1 | if 3 then ();;
        ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "3" has type "int" but an expression was expected of type
          "bool"
        because it is in the condition of an if-statement
 |}];;
@@ -20,9 +20,8 @@ fun b -> if true then (print_int b) else (if b then ());;
 Line 1, characters 45-46:
 1 | fun b -> if true then (print_int b) else (if b then ());;
                                                  ^
-Error: This expression has type "int" but an expression was expected of type
-         "bool"
-       because it is in the condition of an if-statement
+Error: The value "b" has type "int" but an expression was expected of type "
+       bool" because it is in the condition of an if-statement
 |}];;
 
 (* Left-to-right bias is still there: if we swap the branches, the new error
@@ -33,8 +32,7 @@ fun b -> if true then (if b then ()) else (print_int b);;
 Line 1, characters 53-54:
 1 | fun b -> if true then (if b then ()) else (print_int b);;
                                                          ^
-Error: This expression has type "bool" but an expression was expected of type
-         "int"
+Error: The value "b" has type "bool" but an expression was expected of type "int"
 |}];;
 
 if (let x = 3 in x) then ();;
@@ -43,9 +41,8 @@ if (let x = 3 in x) then ();;
 Line 1, characters 17-18:
 1 | if (let x = 3 in x) then ();;
                      ^
-Error: This expression has type "int" but an expression was expected of type
-         "bool"
-       because it is in the condition of an if-statement
+Error: The value "x" has type "int" but an expression was expected of type "
+       bool" because it is in the condition of an if-statement
 |}];;
 
 if (if true then 3 else 4) then ();;
@@ -54,7 +51,7 @@ if (if true then 3 else 4) then ();;
 Line 1, characters 17-18:
 1 | if (if true then 3 else 4) then ();;
                      ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "3" has type "int" but an expression was expected of type
          "bool"
        because it is in the condition of an if-statement
 |}];;
@@ -65,7 +62,7 @@ if true then 3;;
 Line 1, characters 13-14:
 1 | if true then 3;;
                  ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "3" has type "int" but an expression was expected of type
          "unit"
        because it is in the result of a conditional with no else branch
 |}];;
@@ -86,7 +83,7 @@ while 42 do () done;;
 Line 1, characters 6-8:
 1 | while 42 do () done;;
           ^^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "42" has type "int" but an expression was expected of type
          "bool"
        because it is in the condition of a while-loop
 |}];;
@@ -99,8 +96,8 @@ while true do (if true then 3 else 4) done;;
 Line 1, characters 14-37:
 1 | while true do (if true then 3 else 4) done;;
                   ^^^^^^^^^^^^^^^^^^^^^^^
-Error: This expression has type "int" but an expression was expected of type
-         "unit"
+Error: This "if-then-else" expression has type "int"
+       but an expression was expected of type "unit"
        because it is in the body of a while-loop
 |}];;
 
@@ -110,7 +107,7 @@ for i = 3. to 4 do () done;;
 Line 1, characters 8-10:
 1 | for i = 3. to 4 do () done;;
             ^^
-Error: This expression has type "float" but an expression was expected of type
+Error: The constant "3." has type "float" but an expression was expected of type
          "int"
        because it is in a for-loop start index
 |}];;
@@ -121,7 +118,7 @@ for i = 3 to 4. do () done;;
 Line 1, characters 13-15:
 1 | for i = 3 to 4. do () done;;
                  ^^
-Error: This expression has type "float" but an expression was expected of type
+Error: The constant "4." has type "float" but an expression was expected of type
          "int"
        because it is in a for-loop stop index
 |}];;
@@ -134,8 +131,8 @@ for i = 0 to 0 do (if true then 3 else 4) done;;
 Line 1, characters 18-41:
 1 | for i = 0 to 0 do (if true then 3 else 4) done;;
                       ^^^^^^^^^^^^^^^^^^^^^^^
-Error: This expression has type "int" but an expression was expected of type
-         "unit"
+Error: This "if-then-else" expression has type "int"
+       but an expression was expected of type "unit"
        because it is in the body of a for-loop
 |}];;
 
@@ -145,7 +142,7 @@ assert 12;;
 Line 1, characters 7-9:
 1 | assert 12;;
            ^^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "12" has type "int" but an expression was expected of type
          "bool"
        because it is in the condition of an assertion
 |}];;

diff --git a/testsuite/tests/typing-core-bugs/unit_fun_hints.ml b/testsuite/tests/typing-core-bugs/unit_fun_hints.ml
index 7373e5741e0289cd70b903f8206e9748e62df572..78d8900485cc8e64e433f41ec2cea005403f1680 100644 (file)
--- a/testsuite/tests/typing-core-bugs/unit_fun_hints.ml
+++ b/testsuite/tests/typing-core-bugs/unit_fun_hints.ml
@@ -11,7 +11,7 @@ val g : (unit -> 'a) -> 'a = <fun>
 Line 2, characters 10-11:
 2 | let _ = g 3;;       (* missing `fun () ->' *)
               ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "3" has type "int" but an expression was expected of type
          "unit -> 'a"
        Hint: Did you forget to wrap the expression using "fun () ->"?
 |}];;
@@ -28,7 +28,7 @@ let _ =
 Line 3, characters 3-16:
 3 |    print_newline;    (* missing unit argument *)
        ^^^^^^^^^^^^^
-Error: This expression has type "unit -> unit"
+Error: The value "print_newline" has type "unit -> unit"
        but an expression was expected of type "unit"
        because it is in the left-hand side of a sequence
        Hint: Did you forget to provide "()" as argument?
@@ -41,7 +41,7 @@ print_int x;;
 Line 2, characters 10-11:
 2 | print_int x;;
               ^
-Error: This expression has type "unit -> int"
+Error: The value "x" has type "unit -> int"
        but an expression was expected of type "int"
        Hint: Did you forget to provide "()" as argument?
 |}];;
@@ -54,7 +54,7 @@ let g f =
 Line 3, characters 6-7:
 3 |   f = 3;;
           ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "3" has type "int" but an expression was expected of type
          "unit -> 'a"
        Hint: Did you forget to wrap the expression using "fun () ->"?
 |}];;
@@ -67,7 +67,7 @@ let g f =
 Line 3, characters 6-7:
 3 |   3 = f;;
           ^
-Error: This expression has type "unit -> 'a"
-       but an expression was expected of type "int"
+Error: The value "f" has type "unit -> 'a" but an expression was expected of type
+         "int"
        Hint: Did you forget to provide "()" as argument?
 |}]

diff --git a/testsuite/tests/typing-extensions/disambiguation.ml b/testsuite/tests/typing-extensions/disambiguation.ml
index f74935ff105936ed8f9fcf84b71b85f847c90d05..b4c40f8d54c67fe64e8bb69630acd11eca02637e 100644 (file)
--- a/testsuite/tests/typing-extensions/disambiguation.ml
+++ b/testsuite/tests/typing-extensions/disambiguation.ml
@@ -19,8 +19,7 @@ type t = ..
 type t += Alpha | Aleph
 module M : sig type w = .. type w += Alpha | Beta type t += Beth end
 module F :
-  functor (X : sig end) ->
-    sig type u = .. type t += Gamma type u += Gamme end
+  (X : sig end) -> sig type u = .. type t += Gamma type u += Gamme end
 module X : sig end
 |}]
 
@@ -134,7 +133,7 @@ module FX = F(X) open FX
 type exn += Beth;;
 let x : X.t = Beth;;
 [%%expect {|
-module F : functor (X : sig type t = .. end) -> sig type X.t += Beth end
+module F : (X : sig type t = .. end) -> sig type X.t += Beth end
 module X : sig type t = .. end
 module FX : sig type X.t += Beth end
 type exn += Beth

diff --git a/testsuite/tests/typing-extensions/extensions.ml b/testsuite/tests/typing-extensions/extensions.ml
index 195fbcf9f06b843921c91f20ebd26fab63e24dfb..e423aa79543cc8a99f6e2d9c982a0cdbcd788b3c 100644 (file)
--- a/testsuite/tests/typing-extensions/extensions.ml
+++ b/testsuite/tests/typing-extensions/extensions.ml
@@ -231,7 +231,7 @@ let a = A 9
 Line 1, characters 10-11:
 1 | let a = A 9
               ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "9" has type "int" but an expression was expected of type
          "[> `Var ]"
 |}]
 
@@ -714,7 +714,7 @@ end
 let x = let open F(Empty) in (A:F(Empty).t) (* A is not printed *)
 [%%expect {|
 module Empty : sig end
-module F : functor (X : sig end) -> sig type t = .. type t += A end
+module F : (X : sig end) -> sig type t = .. type t += A end
 val x : F(Empty).t = <extension>
 |}]
 

diff --git a/testsuite/tests/typing-extensions/msg.ocaml.reference b/testsuite/tests/typing-extensions/msg.ocaml.reference
index c5ed56b32e2b3a75343e670e76c9ca2d39b5572a..d7d6e37de7a0a04e9d35a9e47be9fde57ea4311e 100644 (file)
--- a/testsuite/tests/typing-extensions/msg.ocaml.reference
+++ b/testsuite/tests/typing-extensions/msg.ocaml.reference
@@ -12,7 +12,7 @@ module Msg :
         val write : t -> string
         val read : string -> t
       end
-    module Define : functor (D : Desc) -> sig type 'a tag += C : D.t tag end
+    module Define : (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

diff --git a/testsuite/tests/typing-fstclassmod/nondep_instance.ml b/testsuite/tests/typing-fstclassmod/nondep_instance.ml
index f3c29ff313362ca6ab02283e3379abd37f6143b7..460877ff876d73827223b48b7a2ad2b20db7d32e 100644 (file)
--- a/testsuite/tests/typing-fstclassmod/nondep_instance.ml
+++ b/testsuite/tests/typing-fstclassmod/nondep_instance.ml
@@ -46,7 +46,7 @@ end;;
 Line 3, characters 21-22:
 3 |     Linear_map.scale s x
                          ^
-Error: This expression has type "(module Scalar with type t = s)"
+Error: The value "s" has type "(module Scalar with type t = s)"
        but an expression was expected of type
          "(module Vector_space with type scalar = 'a and type t = 'b)"
 |}];;

diff --git a/testsuite/tests/typing-fstclassmod/scope_escape.ml b/testsuite/tests/typing-fstclassmod/scope_escape.ml
index a5cbbaa3b7a08f2ce14eeae2ebb9db3818435575..d46a69ac314e2947e4776cffa7176bfc9f416079 100644 (file)
--- a/testsuite/tests/typing-fstclassmod/scope_escape.ml
+++ b/testsuite/tests/typing-fstclassmod/scope_escape.ml
@@ -117,8 +117,8 @@ module type S = sig type t val x : t end
 Line 15, characters 8-10:
 15 |   unify ()
              ^^
-Error: This expression has type "unit" but an expression was expected of type
-         "M.t"
+Error: The constructor "()" has type "unit"
+       but an expression was expected of type "M.t"
 |}, Principal{|
 module type S = sig type t val x : t end
 Lines 8-12, characters 4-8:
@@ -132,6 +132,6 @@ Warning 18 [not-principal]: this module packing is not principal.
 Line 15, characters 8-10:
 15 |   unify ()
              ^^
-Error: This expression has type "unit" but an expression was expected of type
-         "M.t"
+Error: The constructor "()" has type "unit"
+       but an expression was expected of type "M.t"
 |}];;

diff --git a/testsuite/tests/typing-gadts/ambiguity.ml b/testsuite/tests/typing-gadts/ambiguity.ml
index f016617a4889e6f435cb9d30f36c0eb0f60bb6c0..e29dfe9bcb8c8893f8f7e57a9525fa549f4d7757 100644 (file)
--- a/testsuite/tests/typing-gadts/ambiguity.ml
+++ b/testsuite/tests/typing-gadts/ambiguity.ml
@@ -18,8 +18,7 @@ let ret_e1 (type a b) (b : bool) (wit : (a, b) eq) (x : a) (y : b) =
 Line 3, characters 29-30:
 3 |   | Refl -> if b then x else y
                                  ^
-Error: This expression has type "b" = "a" but an expression was expected of type
-         "a"
+Error: The value "y" has type "b" = "a" but an expression was expected of type "a"
        This instance of "a" is ambiguous:
        it would escape the scope of its equation
 |}]
@@ -33,8 +32,7 @@ let ret_e2 (type a b) (b : bool) (wit : (a, b) eq) (x : a) (y : b) =
 Line 3, characters 29-30:
 3 |   | Refl -> if b then x else y
                                  ^
-Error: This expression has type "b" = "a" but an expression was expected of type
-         "a"
+Error: The value "y" has type "b" = "a" but an expression was expected of type "a"
        This instance of "a" is ambiguous:
        it would escape the scope of its equation
 |}]
@@ -48,7 +46,7 @@ let ret_ei1 (type a) (b : bool) (wit : (a, int) eq) (x : a) =
 Line 3, characters 29-30:
 3 |   | Refl -> if b then x else 0
                                  ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "0" has type "int" but an expression was expected of type
          "a" = "int"
        This instance of "int" is ambiguous:
        it would escape the scope of its equation
@@ -63,7 +61,7 @@ let ret_ei2 (type a) (b : bool) (wit : (a, int) eq) (x : a) =
 Line 3, characters 29-30:
 3 |   | Refl -> if b then x else 0
                                  ^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "0" has type "int" but an expression was expected of type
          "a" = "int"
        This instance of "int" is ambiguous:
        it would escape the scope of its equation
@@ -79,8 +77,7 @@ let ret_f (type a b) (wit : (a, b) eq) (x : a) (y : b) =
 Line 3, characters 16-17:
 3 |   | Refl -> [x; y]
                     ^
-Error: This expression has type "b" = "a" but an expression was expected of type
-         "a"
+Error: The value "y" has type "b" = "a" but an expression was expected of type "a"
        This instance of "a" is ambiguous:
        it would escape the scope of its equation
 |}]
@@ -94,8 +91,7 @@ let ret_g1 (type a b) (wit : (a, b) eq) (x : a) (y : b) =
 Line 3, characters 16-17:
 3 |   | Refl -> [x; y]
                     ^
-Error: This expression has type "b" = "a" but an expression was expected of type
-         "a"
+Error: The value "y" has type "b" = "a" but an expression was expected of type "a"
        This instance of "a" is ambiguous:
        it would escape the scope of its equation
 |}]

diff --git a/testsuite/tests/typing-gadts/didier.ml b/testsuite/tests/typing-gadts/didier.ml
index 286304355b9f4c2dc7ac76634aaf68d51f809910..1907a6e8ba9d517ec44b6689b5237b411ac78111 100644 (file)
--- a/testsuite/tests/typing-gadts/didier.ml
+++ b/testsuite/tests/typing-gadts/didier.ml
@@ -54,8 +54,8 @@ val f : 't -> 't ty -> bool = <fun>
 Line 4, characters 12-13:
 4 |   | Bool -> x
                 ^
-Error: This expression has type "t" = "bool"
-       but an expression was expected of type "bool"
+Error: The value "x" has type "t" = "bool" but an expression was expected of type
+         "bool"
        This instance of "bool" is ambiguous:
        it would escape the scope of its equation
 |}];;

diff --git a/testsuite/tests/typing-gadts/name_existentials.ml b/testsuite/tests/typing-gadts/name_existentials.ml
index ecc7ee0063645482aef4b3ef279ddfd15c943de6..abea7d05ae50e19fa36251afd0ca9e66fcdcadb1 100644 (file)
--- a/testsuite/tests/typing-gadts/name_existentials.ml
+++ b/testsuite/tests/typing-gadts/name_existentials.ml
@@ -37,9 +37,10 @@ let ko2 = function Dyn (type a b) (a, x : a ty * b) -> ignore (x : b)
 Line 1, characters 42-50:
 1 | let ko2 = function Dyn (type a b) (a, x : a ty * b) -> ignore (x : b)
                                               ^^^^^^^^
-Error: This pattern matches values of type "a ty * b"
-       but a pattern was expected which matches values of type "a ty * a"
-       Type "b" is not compatible with type "a"
+Error: The local name "b" can only be given to an existential variable
+       introduced by this GADT constructor.
+       The type annotation tries to bind it to the name "a"
+       that is already bound.
 |}]
 
 type u = C : 'a * ('a -> 'b list) -> u
@@ -84,7 +85,10 @@ let rec test : type a. a expr -> a = function
 Line 2, characters 22-23:
 2 |   | Int (type b) (n : a) -> n
                           ^
-Error: This type does not bind all existentials in the constructor: "type b. a"
+Error: The local name "b" can only be given to an existential variable
+       introduced by this GADT constructor.
+       The type annotation tries to bind it to the type "'a"
+       that is not a locally abstract type.
 |}]
 
 (* Strange wildcard *)
@@ -117,3 +121,125 @@ let f = function Pair (x, y : int * _) -> x + y
 type ('a, 'b) pair = Pair of 'a * 'b
 val f : (int, int) pair -> int = <fun>
 |}]
+
+
+(* #11891: allow naming more types *)
+(* We stillonly allow to name freshly introduced existentials *)
+
+type _ ty =
+  | Int : int ty
+  | Pair : 'b ty * 'c ty -> ('b * 'c) ty
+let rec example : type a . a ty -> a = function
+| Int -> 0
+| Pair (x, y) -> (example x, example y)
+let rec example : type a . a ty -> a = function
+| Int -> 0
+| Pair (type b c) (x, y : b ty * c ty) -> (example x, example y)
+[%%expect{|
+type _ ty = Int : int ty | Pair : 'b ty * 'c ty -> ('b * 'c) ty
+val example : 'a ty -> 'a = <fun>
+val example : 'a ty -> 'a = <fun>
+|}]
+
+let rec example : type a . a ty -> a = function
+| Int -> 0
+| Pair (type b c) (x, y : b ty * c ty) -> (example x, example (*error*)x)
+[%%expect{|
+Line 3, characters 54-72:
+3 | | Pair (type b c) (x, y : b ty * c ty) -> (example x, example (*error*)x)
+                                                          ^^^^^^^^^^^^^^^^^^
+Error: This expression has type "b" = "$0" but an expression was expected of type
+         "$1"
+|}]
+
+type _ th =
+  | Thunk : 'a * ('a -> 'b) -> 'b th
+let f1 (type a) : a th -> a = function
+  | Thunk (type b) (x, f : b * (b -> _)) -> f x
+let f2 (type a) : a th -> a = function
+  | Thunk (type b c) (x, f : b * (b -> c)) -> f x
+[%%expect{|
+type _ th = Thunk : 'a * ('a -> 'b) -> 'b th
+val f1 : 'a th -> 'a = <fun>
+Line 6, characters 29-41:
+6 |   | Thunk (type b c) (x, f : b * (b -> c)) -> f x
+                                 ^^^^^^^^^^^^
+Error: The local name "c" can only be given to an existential variable
+       introduced by this GADT constructor.
+       The type annotation tries to bind it to the name "a"
+       that was defined before.
+|}]
+(* Do not allow to deduce extra assumptions *)
+let ko1 (type a) : a th -> a = function
+  | Thunk (type b c) (x, f : b * (b -> c option)) -> f x
+[%%expect{|
+Line 2, characters 29-48:
+2 |   | Thunk (type b c) (x, f : b * (b -> c option)) -> f x
+                                 ^^^^^^^^^^^^^^^^^^^
+Error: This pattern matches values of type "b * (b -> c option)"
+       but a pattern was expected which matches values of type "b * (b -> a)"
+       Type "c option" is not compatible with type "a"
+|}]
+(* Can only name fresh existentials *)
+let ko2 = function
+  | Thunk (type b c) (x, f : b * (b -> c)) -> f x
+[%%expect{|
+Line 2, characters 29-41:
+2 |   | Thunk (type b c) (x, f : b * (b -> c)) -> f x
+                                 ^^^^^^^^^^^^
+Error: The local name "c" can only be given to an existential variable
+       introduced by this GADT constructor.
+       The type annotation tries to bind it to the type "'a"
+       that is not a locally abstract type.
+|}]
+let ko3 () =
+  match [] with
+  | [Thunk (type b c) (x, f : b * (b -> c))] -> f x
+  | _ -> assert false
+[%%expect{|
+Line 3, characters 30-42:
+3 |   | [Thunk (type b c) (x, f : b * (b -> c))] -> f x
+                                  ^^^^^^^^^^^^
+Error: The local name "c" can only be given to an existential variable
+       introduced by this GADT constructor.
+       The type annotation tries to bind it to the type "'a"
+       that is not a locally abstract type.
+|}]
+
+type _ tho =
+  | Thunk_opt : 'b * ('b -> 'c option) -> 'c option tho
+let f3 (type a) : a tho -> a = function
+  | Thunk_opt (type b c) (x, f : b * (b -> c option)) -> f x
+[%%expect{|
+type _ tho = Thunk_opt : 'b * ('b -> 'c option) -> 'c option tho
+val f3 : 'a tho -> 'a = <fun>
+|}]
+
+
+(* check locality *)
+type 'a wrap = Wrap of 'a
+type _ ty = Int : int ty | Pair : ('b ty * 'c ty) wrap -> ('b * 'c) ty
+(* ok *)
+let rec default : type a. a ty -> a = function
+  | Int -> 0
+  | Pair (type b c) (Wrap (b, c) : (b ty * c ty) wrap) ->
+      (default b : b), (default c : c)
+[%%expect{|
+type 'a wrap = Wrap of 'a
+type _ ty = Int : int ty | Pair : ('b ty * 'c ty) wrap -> ('b * 'c) ty
+val default : 'a ty -> 'a = <fun>
+|}]
+(* ko *)
+let rec default : type a. a ty -> a = function
+  | Int -> 0
+  | Pair (Wrap (type b c) (b, c : b ty * c ty)) ->
+      (default b : b), (default c : c)
+[%%expect{|
+Line 3, characters 34-45:
+3 |   | Pair (Wrap (type b c) (b, c : b ty * c ty)) ->
+                                      ^^^^^^^^^^^
+Error: The local name "b" can only be given to an existential variable
+       introduced by this GADT constructor.
+       The type annotation tries to bind it to the name "$0"
+       that was defined before.
+|}]

diff --git a/testsuite/tests/typing-gadts/nested_equations.ml b/testsuite/tests/typing-gadts/nested_equations.ml
index 24b8c861d17c12e93071c43502f1a396473f5bac..04ddea3b68c13f3eee99e5f154b41b953b9b643f 100644 (file)
--- a/testsuite/tests/typing-gadts/nested_equations.ml
+++ b/testsuite/tests/typing-gadts/nested_equations.ml
@@ -54,8 +54,7 @@ val m_x : int = 33
 module F (X : sig type u = int val x : u end) = struct let x : int = X.x end;;
 let fm_x : int = let Int = M.w in let module FM = F(M) in FM.x;; (* ok *)
 [%%expect{|
-module F :
-  functor (X : sig type u = int val x : u end) -> sig val x : int end
+module F : (X : sig type u = int val x : u end) -> sig val x : int end
 val fm_x : int = 33
 |}];;
 
@@ -67,7 +66,7 @@ let fm'_x : int =
 [%%expect{|
 module M' : sig module M : sig type u val w : u t val x : u end end
 module F' :
-  functor (X : sig module M : sig type u = int val x : u end end) ->
+  (X : sig module M : sig type u = int val x : u end end) ->
     sig val x : int end
 val fm'_x : int = 33
 |}];;
@@ -88,5 +87,5 @@ end;;
 [%%expect{|
 type (_, _) eq = Refl : ('a, 'a) eq
 module type S = sig type t val eql : (t, int) eq end
-module F : functor (M : S) -> sig val zero : M.t end
+module F : (M : S) -> sig val zero : M.t end
 |}];;

diff --git a/testsuite/tests/typing-gadts/optional_args.ml b/testsuite/tests/typing-gadts/optional_args.ml
new file mode 100644 (file)
index 0000000..5a6a5a1
--- /dev/null
+++ b/testsuite/tests/typing-gadts/optional_args.ml
@@ -0,0 +1,54 @@
+(* TEST
+ expect;
+*)
+
+type (_, _) refl = Refl : ('a, 'a) refl
+
+[%%expect{|
+type (_, _) refl = Refl : ('a, 'a) refl
+|}]
+
+let apply (_ : unit -> 'a) : 'a = assert false
+let go (type a) (Refl : (unit, a) refl) = apply (fun () : a -> ())
+
+[%%expect{|
+val apply : (unit -> 'a) -> 'a = <fun>
+val go : (unit, 'a) refl -> 'a = <fun>
+|}]
+
+let apply (_ : x:unit -> unit -> 'a) : 'a = assert false
+let go (type a) (Refl : (unit, a) refl) = apply (fun ~x:_ () : a -> ())
+
+[%%expect{|
+val apply : (x:unit -> unit -> 'a) -> 'a = <fun>
+val go : (unit, 'a) refl -> 'a = <fun>
+|}]
+
+let apply (_ : ?x:unit -> unit -> 'a) : 'a = assert false
+let go (type a) (Refl : (unit, a) refl) = apply (fun ?x:_ () : a -> ())
+
+[%%expect{|
+val apply : (?x:unit -> unit -> 'a) -> 'a = <fun>
+val go : (unit, 'a) refl -> 'a = <fun>
+|}]
+
+let apply (_ : unit -> x:unit -> 'a) : 'a = assert false
+let go (type a) (Refl : (unit, a) refl) = apply (fun () ~x:_ : a -> ())
+
+[%%expect{|
+val apply : (unit -> x:unit -> 'a) -> 'a = <fun>
+val go : (unit, 'a) refl -> 'a = <fun>
+|}]
+
+let apply (_ : unit -> ?x:unit -> 'a) : 'a = assert false
+let go (type a) (Refl : (unit, a) refl) = apply (fun () ?x:_ : a -> ())
+
+[%%expect{|
+val apply : (unit -> ?x:unit -> 'a) -> 'a = <fun>
+Line 2, characters 59-60:
+2 | let go (type a) (Refl : (unit, a) refl) = apply (fun () ?x:_ : a -> ())
+                                                               ^
+Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
+
+val go : (unit, 'a) refl -> 'a = <fun>
+|}]

diff --git a/testsuite/tests/typing-gadts/or_patterns.ml b/testsuite/tests/typing-gadts/or_patterns.ml
index fda50eb183435cc0b38293145f8d221bcbf020e7..39ef0b9809eb9992b09ba83b3216d62e4cf0e53f 100644 (file)
--- a/testsuite/tests/typing-gadts/or_patterns.ml
+++ b/testsuite/tests/typing-gadts/or_patterns.ml
@@ -632,7 +632,7 @@ let return_a (type a) (x : a t3) : a =
 Line 3, characters 13-14:
 3 |   | A | B -> 3 (* fails because the equation [a = int] doesn't escape any of
                  ^
-Error: This expression has type "int" but an expression was expected of type "a"
+Error: The constant "3" has type "int" but an expression was expected of type "a"
 |}]
 
 (* Making sure we don't break a frequent pattern of GADTs indexed by polymorphic

diff --git a/testsuite/tests/typing-gadts/packed-module-recasting.ml b/testsuite/tests/typing-gadts/packed-module-recasting.ml
index 3ee8b2b1c6f7a2ec23d7d72200c2723933afc614..7f8f617f5b5d2e5004d52053dbd408caee5c80f7 100644 (file)
--- a/testsuite/tests/typing-gadts/packed-module-recasting.ml
+++ b/testsuite/tests/typing-gadts/packed-module-recasting.ml
@@ -230,7 +230,7 @@ let cast_functor_argument_under_equality (type t)
   (module F (M))
 [%%expect {|
 module type S = sig type t end
-module type F = functor (M : S) -> sig type t = M.t end
+module type F = (M : S) -> sig type t = M.t end
 module type S' = sig type _ t_aux type t val eq : (t, unit t_aux) eq end
 val cast_functor_argument_under_equality :
   (module S' with type t = 't) -> (module F) -> (module S with type t = 't) =
@@ -261,8 +261,7 @@ let cast_functor_argument_signature_under_equality (type t)
   (module M : F(M).S)
 [%%expect {|
 module type S = sig type t end
-module type F =
-  functor (M : S) -> sig module type S = sig type t = M.t end end
+module type F = (M : S) -> sig module type S = sig type t = M.t end end
 module type S' = sig type _ t_aux type t val eq : (t, unit t_aux) eq end
 val cast_functor_argument_signature_under_equality :
   (module S' with type t = 't) -> (module F) -> (module S with type t = 't) =
@@ -483,7 +482,7 @@ val f : ('a, 'b -> 'b) eq -> ('a, int -> int) eq -> 'a -> 'b = <fun>
 Line 4, characters 2-7:
 4 |   M.res;;
       ^^^^^
-Error: This expression has type "b" = "int"
+Error: The value "M.res" has type "b" = "int"
        but an expression was expected of type "'a"
        This instance of "int" is ambiguous:
        it would escape the scope of its equation
@@ -498,7 +497,7 @@ val f : ('a, 'b -> 'b) eq -> ('a, int -> int) eq -> 'a -> int = <fun>
 Line 4, characters 3-8:
 4 |    M.res;;
        ^^^^^
-Error: This expression has type "int" but an expression was expected of type "'a"
+Error: The value "M.res" has type "int" but an expression was expected of type "'a"
        This instance of "int" is ambiguous:
        it would escape the scope of its equation
 |}]

diff --git a/testsuite/tests/typing-gadts/pr13579.ml b/testsuite/tests/typing-gadts/pr13579.ml
new file mode 100644 (file)
index 0000000..1835f93
--- /dev/null
+++ b/testsuite/tests/typing-gadts/pr13579.ml
@@ -0,0 +1,132 @@
+(* TEST
+ expect;
+*)
+
+(* #13579 *)
+
+module F(X : sig type 'a t end) = struct
+  type (_, _) gadt = T : ('a X.t, 'a) gadt
+
+  let equate_param2_based_on_param1 (type tt m1 m2)
+        (T : (tt, m1) gadt) (T : (tt, m2) gadt) : (m1, m2) Type.eq =
+     Equal
+  ;;
+end
+[%%expect{|
+Line 6, characters 5-10:
+6 |      Equal
+         ^^^^^
+Error: The constructor "Equal" has type "(m1, m1) Type.eq"
+       but an expression was expected of type "(m1, m2) Type.eq"
+       Type "m1" is not compatible with type "m2"
+|}]
+
+(* could cause unsoundness
+module Z = F(struct type 'a t = unit end)
+
+let () =
+  let t1 = (Z.T : (unit, int) Z.gadt) in
+  let t2 = (Z.T : (unit, string) Z.gadt) in
+  let eq : (int, string) Type.eq = Z.equate_param2_based_on_param1 t1 t2 in
+  let cast (type a b) (Equal : (a, b) Type.eq) (a : a) : b = a in
+  print_string (cast eq 1)
+;;
+*)
+
+(* Side-effect of the fix *)
+
+module M = struct type 'a p end
+type _ t = W: int M.p t
+[%%expect{|
+module M : sig type 'a p end
+type _ t = W : int M.p t
+|}]
+
+let f (W: _ M.p t) = ()
+[%%expect{|
+val f : int M.p t -> unit = <fun>
+|}]
+
+let f (W: _ t) = ()
+[%%expect{|
+val f : int M.p t -> unit = <fun>
+|}]
+
+type _ t = W: int M.p t | W2: float M.p t
+[%%expect{|
+type _ t = W : int M.p t | W2 : float M.p t
+|}]
+
+let f (W: _ M.p t) = ()
+[%%expect{|
+Line 1, characters 6-18:
+1 | let f (W: _ M.p t) = ()
+          ^^^^^^^^^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+W2
+
+val f : int M.p t -> unit = <fun>
+|}]
+
+let f =  function W -> () | W2 -> ()
+[%%expect{|
+val f : int M.p t -> unit = <fun>
+|}]
+
+let f =  function (W: _ M.p t) -> () | W2 -> ()
+[%%expect{|
+val f : int M.p t -> unit = <fun>
+|}]
+
+let f: type a. a M.p t -> unit =  function W -> () | W2 -> ()
+[%%expect{|
+val f : 'a M.p t -> unit = <fun>
+|}]
+
+let f (type a) (Equal : ('a M.p * a, 'b M.p * int) Type.eq) = ();;
+[%%expect{|
+Line 1, characters 16-21:
+1 | let f (type a) (Equal : ('a M.p * a, 'b M.p * int) Type.eq) = ();;
+                    ^^^^^
+Error: This pattern matches values of type "($'a M.p * a, $'a M.p * a) Type.eq"
+       but a pattern was expected which matches values of type
+         "($'a M.p * a, 'b M.p * int) Type.eq"
+       The type constructor "$'a" would escape its scope
+|}]
+
+(** Counter-example side *)
+
+type 'a cstr = X of 'a constraint 'a = _ M.p
+type x = int M.p cstr
+type ab = A of x | B of x
+
+let test = function
+   | A a -> [a]
+   | B a -> [a]
+[%%expect {|
+type 'a cstr = X of 'a constraint 'a = 'b M.p
+type x = int M.p cstr
+type ab = A of x | B of x
+val test : ab -> x list = <fun>
+|}]
+
+(** Need to reify even when we do not unify *)
+
+module M : sig type _ t val wrap : 'a -> 'a t val unwrap : 'a t -> 'a end =
+  struct type 'a t = 'a let wrap x = x let unwrap x = x end;;
+type 'a u = U : 'b M.t -> 'b M.t u;;
+[%%expect{|
+module M : sig type _ t val wrap : 'a -> 'a t val unwrap : 'a t -> 'a end
+type 'a u = U : 'b M.t -> 'b M.t u
+|}]
+let f : type a b. a M.t u -> b M.t = fun (U x) -> x;;
+let g x = M.unwrap (f (U (M.wrap x)));;
+[%%expect{|
+Line 1, characters 50-51:
+1 | let f : type a b. a M.t u -> b M.t = fun (U x) -> x;;
+                                                      ^
+Error: The value "x" has type "$0 M.t" but an expression was expected of type
+         "b M.t"
+       Type "$0" is not compatible with type "b"
+|}]

diff --git a/testsuite/tests/typing-gadts/pr5689.ml b/testsuite/tests/typing-gadts/pr5689.ml
index ea1c8ce530a18e08c7c14509e8c1e01e0b1c0057..0995657d5074208a6df5055cbe56899990a9302d 100644 (file)
--- a/testsuite/tests/typing-gadts/pr5689.ml
+++ b/testsuite/tests/typing-gadts/pr5689.ml
@@ -103,7 +103,7 @@ type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2
 Line 7, characters 35-43:
 7 |     | (Kind _, Ast_Text txt)    -> Text txt
                                        ^^^^^^^^
-Error: This expression has type "[< inkind > `Nonlink ] inline_t"
+Error: This constructor has type "[< inkind > `Nonlink ] inline_t"
        but an expression was expected of type "a inline_t"
        Type "[< inkind > `Nonlink ]" = "[< `Link | `Nonlink > `Nonlink ]"
        is not compatible with type "a" = "[< `Link | `Nonlink ]"

diff --git a/testsuite/tests/typing-gadts/pr5785.ml b/testsuite/tests/typing-gadts/pr5785.ml
index 102ba05f4b567fc0f65d7deced9c23552bdd7987..5ebe57c4e499677c92e4f800a89a36e5a57f9992 100644 (file)
--- a/testsuite/tests/typing-gadts/pr5785.ml
+++ b/testsuite/tests/typing-gadts/pr5785.ml
@@ -22,7 +22,7 @@ Here is an example of a case that is not matched:
 (One, Two)
 
 module Add :
-  functor (T : sig type two end) ->
+  (T : sig type two end) ->
     sig
       type _ t = One : [ `One ] t | Two : T.two t
       val add : 'a t * 'a t -> string

diff --git a/testsuite/tests/typing-gadts/pr5948.ml b/testsuite/tests/typing-gadts/pr5948.ml
index 0577625d7e02cc54b5909905ea5edeff24f10f5b..7adc1af76b746729186bb9e46c1405ec5b422e6b 100644 (file)
--- a/testsuite/tests/typing-gadts/pr5948.ml
+++ b/testsuite/tests/typing-gadts/pr5948.ml
@@ -42,7 +42,7 @@ type _ wrapPoly =
 Line 25, characters 23-27:
 25 |     | WrapPoly ATag -> intA
                             ^^^^
-Error: This expression has type "[< `TagA of 'a ] -> 'a"
+Error: The value "intA" has type "[< `TagA of 'a ] -> 'a"
        but an expression was expected of type "a -> int"
        Type "[< `TagA of 'a ]" is not compatible with type
          "a" = "[< `TagA of int | `TagB ]"

diff --git a/testsuite/tests/typing-gadts/pr5981.ml b/testsuite/tests/typing-gadts/pr5981.ml
index 83502759c86cf086c5588bac301da90723bdf720..3a24badc26fc90cc7bdb9576c5c24753c0dd66a2 100644 (file)
--- a/testsuite/tests/typing-gadts/pr5981.ml
+++ b/testsuite/tests/typing-gadts/pr5981.ml
@@ -20,7 +20,7 @@ Here is an example of a case that is not matched:
 (A, A)
 
 module F :
-  functor (S : sig type 'a t end) ->
+  (S : sig type 'a t end) ->
     sig
       type _ ab = A : int S.t ab | B : float S.t ab
       val f : int S.t ab -> float S.t ab -> string
@@ -48,7 +48,7 @@ Here is an example of a case that is not matched:
 (A, A)
 
 module F :
-  functor (S : sig type 'a t end) ->
+  (S : sig type 'a t end) ->
     sig
       type a = int * int
       type b = int -> int

diff --git a/testsuite/tests/typing-gadts/pr6174.ml b/testsuite/tests/typing-gadts/pr6174.ml
index 82458bf0babf02adcd504abca5b5d527ec39222f..fcdb2c642506060bf779d8243136ed25d9c175a7 100644 (file)
--- a/testsuite/tests/typing-gadts/pr6174.ml
+++ b/testsuite/tests/typing-gadts/pr6174.ml
@@ -10,6 +10,5 @@ type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t
 Line 3, characters 24-25:
 3 |  fun C k -> k (fun x -> x);;
                             ^
-Error: This expression has type "$0" but an expression was expected of type
-         "$1" = "o"
+Error: The value "x" has type "$0" but an expression was expected of type "$1" = "o"
 |}];;

diff --git a/testsuite/tests/typing-gadts/pr6241.ml b/testsuite/tests/typing-gadts/pr6241.ml
index c7975600df35f3ce9a69a9cbfc0f8bdf092d1a2d..1d134a7716d744a3e6f6ddaf307f34b57fbfd75e 100644 (file)
--- a/testsuite/tests/typing-gadts/pr6241.ml
+++ b/testsuite/tests/typing-gadts/pr6241.ml
@@ -29,7 +29,7 @@ Here is an example of a case that is not matched:
 A
 
 module M :
-  functor (A : sig module type T end) (B : sig module type T end) ->
+  (A : sig module type T end) (B : sig module type T end) ->
     sig val f : ((module A.T), (module B.T)) t -> string end
 module A : sig module type T = sig end end
 module N : sig val f : ((module A.T), (module A.T)) t -> string end

diff --git a/testsuite/tests/typing-gadts/pr6980.ml b/testsuite/tests/typing-gadts/pr6980.ml
index d04db3dff101acdfdd3144dd6ee20f157784cbe1..dbaca8baedd216b9a50653c36b10418ee481b799 100644 (file)
--- a/testsuite/tests/typing-gadts/pr6980.ml
+++ b/testsuite/tests/typing-gadts/pr6980.ml
@@ -24,7 +24,7 @@ val it : [< `Bar | `Foo > `Bar ] = `Bar
 Line 11, characters 27-29:
 11 | let g (Aux(Second, f)) = f it;;
                                 ^^
-Error: This expression has type "[< `Bar | `Foo > `Bar ]"
+Error: The value "it" has type "[< `Bar | `Foo > `Bar ]"
        but an expression was expected of type "[< `Bar | `Foo ]"
        The second variant type is bound to "$a",
        it may not allow the tag(s) "`Bar"

diff --git a/testsuite/tests/typing-gadts/pr7234.ml b/testsuite/tests/typing-gadts/pr7234.ml
index fb61bcd80fdd58d61a1f3e7e0e38c1a07d4fab8f..58f3742eec25ac6f5926180c351b423d4b198c40 100644 (file)
--- a/testsuite/tests/typing-gadts/pr7234.ml
+++ b/testsuite/tests/typing-gadts/pr7234.ml
@@ -29,6 +29,5 @@ Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Eq
 
-module F :
-  functor (T : sig type _ t end) -> sig val f : ('a, 'a T.t) eq -> int end
+module F : (T : sig type _ t end) -> sig val f : ('a, 'a T.t) eq -> int end
 |}];;

diff --git a/testsuite/tests/typing-gadts/pr7374.ml b/testsuite/tests/typing-gadts/pr7374.ml
index 4c12e4577e83f51e6fc2eec32eba2152c40cc3a2..023ec546ec0a8f9c9bcb2ea63302acbabe4bc7f4 100644 (file)
--- a/testsuite/tests/typing-gadts/pr7374.ml
+++ b/testsuite/tests/typing-gadts/pr7374.ml
@@ -24,7 +24,7 @@ end;; (* should fail *)
 Line 7, characters 16-20:
 7 |     fun Refl -> Refl
                     ^^^^
-Error: This expression has type "(a, a) eq"
+Error: The constructor "Refl" has type "(a, a) eq"
        but an expression was expected of type "(a, t) eq"
        Type "a" is not compatible with type "t" = "[ `Rec of 'a ] X.t as 'a"
 |}]
@@ -56,7 +56,7 @@ end;; (* should fail *)
 Line 4, characters 21-25:
 4 |     fun Refl Refl -> Refl;;
                          ^^^^
-Error: This expression has type "(a, a) eq"
+Error: The constructor "Refl" has type "(a, a) eq"
        but an expression was expected of type "(a, a X.t X.t) eq"
        Type "a" = "b X.t" is not compatible with type "a X.t X.t"
        Type "b" is not compatible with type "a X.t"

diff --git a/testsuite/tests/typing-gadts/principality-and-gadts.ml b/testsuite/tests/typing-gadts/principality-and-gadts.ml
index b7769dde4921257c9aaaddc2f9368360defab4c2..1c994798894ba43497647c6f717ce578ac8ce4d8 100644 (file)
--- a/testsuite/tests/typing-gadts/principality-and-gadts.ml
+++ b/testsuite/tests/typing-gadts/principality-and-gadts.ml
@@ -106,7 +106,7 @@ let f (type a) t (x : a) =
 Line 3, characters 17-18:
 3 |   | IntLit, n -> n+1
                      ^
-Error: This expression has type "a" but an expression was expected of type "int"
+Error: The value "n" has type "a" but an expression was expected of type "int"
 |}]
 
 (**********************)

diff --git a/testsuite/tests/typing-gadts/test.ml b/testsuite/tests/typing-gadts/test.ml
index adc0faabf4a15be72f44776f45784f54fd549d51..46e4b98ae8fe4290e30a7e8594a4953ad826251a 100644 (file)
--- a/testsuite/tests/typing-gadts/test.ml
+++ b/testsuite/tests/typing-gadts/test.ml
@@ -293,8 +293,7 @@ module Existential_escape =
 Line 5, characters 21-22:
 5 |     let eval (D x) = x
                          ^
-Error: This expression has type "$a t" but an expression was expected of type
-         "'a"
+Error: The value "x" has type "$a t" but an expression was expected of type "'a"
        The type constructor "$a" would escape its scope
        Hint: "$a" is an existential type bound by the constructor "D".
 |}];;
@@ -377,7 +376,7 @@ module Propagation :
 Line 13, characters 19-20:
 13 |     | BoolLit b -> b
                         ^
-Error: This expression has type "bool" but an expression was expected of type
+Error: The value "b" has type "bool" but an expression was expected of type
          "s" = "bool"
        This instance of "bool" is ambiguous:
        it would escape the scope of its equation
@@ -586,7 +585,7 @@ val either : 'a -> 'a -> 'a = <fun>
 Line 3, characters 44-45:
 3 |   match v with Int -> let y = either 1 x in y
                                                 ^
-Error: This expression has type "int" but an expression was expected of type "'a"
+Error: The value "y" has type "int" but an expression was expected of type "'a"
        This instance of "int" is ambiguous:
        it would escape the scope of its equation
 |}];;
@@ -704,7 +703,7 @@ let f : type a b. (a,b) eq -> <m : a; ..> -> <m : b; ..> =
 Line 2, characters 14-15:
 2 |   fun Eq o -> o
                   ^
-Error: This expression has type "< m : a; .. >"
+Error: The value "o" has type "< m : a; .. >"
        but an expression was expected of type "< m : b; .. >"
        Type "a" is not compatible with type "b" = "a"
        This instance of "a" is ambiguous:
@@ -717,7 +716,7 @@ let f (type a) (type b) (eq : (a,b) eq) (o : <m : a; ..>) : <m : b; ..> =
 Line 2, characters 22-23:
 2 |   match eq with Eq -> o ;; (* should fail *)
                           ^
-Error: This expression has type "< m : a; .. >"
+Error: The value "o" has type "< m : a; .. >"
        but an expression was expected of type "< m : b; .. >"
        Type "a" is not compatible with type "b" = "a"
        This instance of "a" is ambiguous:
@@ -757,8 +756,8 @@ val f : ('a, 'b) eq -> < m : 'a > -> < m : 'b > = <fun>
 Line 4, characters 44-45:
 4 |     let r : < m : b > = match eq with Eq -> o in (* fail with principal *)
                                                 ^
-Error: This expression has type "< m : a >"
-       but an expression was expected of type "< m : b >"
+Error: The value "o" has type "< m : a >" but an expression was expected of type
+         "< m : b >"
        Type "a" is not compatible with type "b" = "a"
        This instance of "a" is ambiguous:
        it would escape the scope of its equation
@@ -773,7 +772,7 @@ let f : type a b. (a,b) eq -> < m : a; .. > -> < m : b > =
 Line 3, characters 44-45:
 3 |     let r : < m : b > = match eq with Eq -> o in (* fail *)
                                                 ^
-Error: This expression has type "< m : a; .. >"
+Error: The value "o" has type "< m : a; .. >"
        but an expression was expected of type "< m : b >"
        Type "a" is not compatible with type "b" = "a"
        This instance of "a" is ambiguous:
@@ -786,7 +785,7 @@ let f : type a b. (a,b) eq -> [> `A of a] -> [> `A of b] =
 Line 2, characters 14-15:
 2 |   fun Eq o -> o ;; (* fail *)
                   ^
-Error: This expression has type "[> `A of a ]"
+Error: The value "o" has type "[> `A of a ]"
        but an expression was expected of type "[> `A of b ]"
        Type "a" is not compatible with type "b" = "a"
        This instance of "a" is ambiguous:
@@ -799,7 +798,7 @@ let f (type a b) (eq : (a,b) eq) (v : [> `A of a]) : [> `A of b] =
 Line 2, characters 22-23:
 2 |   match eq with Eq -> v ;; (* should fail *)
                           ^
-Error: This expression has type "[> `A of a ]"
+Error: The value "v" has type "[> `A of a ]"
        but an expression was expected of type "[> `A of b ]"
        Type "a" is not compatible with type "b" = "a"
        This instance of "a" is ambiguous:
@@ -855,7 +854,7 @@ Error: This expression has type
 Line 4, characters 49-50:
 4 |     let r : [`A of b | `B] = match eq with Eq -> o in (* fail with principal *)
                                                      ^
-Error: This expression has type "[ `A of a | `B ]"
+Error: The value "o" has type "[ `A of a | `B ]"
        but an expression was expected of type "[ `A of b | `B ]"
        Type "a" is not compatible with type "b" = "a"
        This instance of "a" is ambiguous:
@@ -871,7 +870,7 @@ let f : type a b. (a,b) eq -> [> `A of a | `B] -> [`A of b | `B] =
 Line 3, characters 49-50:
 3 |     let r : [`A of b | `B] = match eq with Eq -> o in (* fail *)
                                                      ^
-Error: This expression has type "[> `A of a | `B ]"
+Error: The value "o" has type "[> `A of a | `B ]"
        but an expression was expected of type "[ `A of b | `B ]"
        Type "a" is not compatible with type "b" = "a"
        This instance of "a" is ambiguous:
@@ -1019,7 +1018,7 @@ module M : sig type 'a t val eq : ('a t, 'b t) eq end
 Line 6, characters 17-19:
 6 |   function Eq -> Eq (* fail *)
                      ^^
-Error: This expression has type "(a, a) eq"
+Error: The constructor "Eq" has type "(a, a) eq"
        but an expression was expected of type "(a, b) eq"
        Type "a" is not compatible with type "b"
 |}];;
@@ -1075,7 +1074,7 @@ type _ int_bar = IB_constr : < bar : int; .. > int_bar
 Line 10, characters 3-4:
 10 |   (x:<foo:int>)
         ^
-Error: This expression has type "t" = "< foo : int; .. >"
+Error: The value "x" has type "t" = "< foo : int; .. >"
        but an expression was expected of type "< foo : int >"
        Type "$0" = "< bar : int; .. >" is not compatible with type "<  >"
        The second object type has no method "bar"
@@ -1089,7 +1088,7 @@ let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) =
 Line 3, characters 3-4:
 3 |   (x:<foo:int;bar:int>)
        ^
-Error: This expression has type "t" = "< foo : int; .. >"
+Error: The value "x" has type "t" = "< foo : int; .. >"
        but an expression was expected of type "< bar : int; foo : int >"
        Type "$0" = "< bar : int; .. >" is not compatible with type "< bar : int >"
        The first object type has an abstract row, it cannot be closed
@@ -1134,7 +1133,8 @@ val g : 't -> 't int_foo -> 't int_bar -> 't * int * int = <fun>
 Line 3, characters 5-10:
 3 |   x, x#foo, x#bar
          ^^^^^
-Error: This expression has type "int" but an expression was expected of type "'a"
+Error: The method call "x#foo" has type "int"
+       but an expression was expected of type "'a"
        This instance of "int" is ambiguous:
        it would escape the scope of its equation
 |}];;
@@ -1202,8 +1202,8 @@ let f : type a b. (a,b) eq -> (a,int) eq -> a -> b -> _ = fun ab aint a b ->
 Line 5, characters 24-25:
 5 |     if true then a else b
                             ^
-Error: This expression has type "b" = "int"
-       but an expression was expected of type "a" = "int"
+Error: The value "b" has type "b" = "int" but an expression was expected of type
+         "a" = "int"
        This instance of "int" is ambiguous:
        it would escape the scope of its equation
 |}];;
@@ -1219,8 +1219,8 @@ let f : type a b. (a,b) eq -> (b,int) eq -> a -> b -> _ = fun ab bint a b ->
 Line 5, characters 24-25:
 5 |     if true then a else b
                             ^
-Error: This expression has type "b" = "int"
-       but an expression was expected of type "a" = "int"
+Error: The value "b" has type "b" = "int" but an expression was expected of type
+         "a" = "int"
        This instance of "int" is ambiguous:
        it would escape the scope of its equation
 |}];;
@@ -1234,8 +1234,8 @@ let f (type a b c) (b : bool) (w1 : (a,b) eq) (w2 : (a,int) eq) (x : a) (y : b)
 Line 4, characters 19-20:
 4 |   if b then x else y
                        ^
-Error: This expression has type "b" = "int"
-       but an expression was expected of type "a" = "int"
+Error: The value "y" has type "b" = "int" but an expression was expected of type
+         "a" = "int"
        This instance of "int" is ambiguous:
        it would escape the scope of its equation
 |}];;
@@ -1248,8 +1248,8 @@ let f (type a b c) (b : bool) (w1 : (a,b) eq) (w2 : (a,int) eq) (x : a) (y : b)
 Line 4, characters 19-20:
 4 |   if b then y else x
                        ^
-Error: This expression has type "a" = "int"
-       but an expression was expected of type "b" = "int"
+Error: The value "x" has type "a" = "int" but an expression was expected of type
+         "b" = "int"
        This instance of "int" is ambiguous:
        it would escape the scope of its equation
 |}];;
@@ -1287,7 +1287,7 @@ type (_, _) eq = Refl : ('a, 'a) eq
 Line 7, characters 35-36:
 7 |   if true then fun x -> x + 1 else x
                                        ^
-Error: This expression has type "M.t" = "int -> int"
+Error: The value "x" has type "M.t" = "int -> int"
        but an expression was expected of type "int -> int"
        This instance of "int -> int" is ambiguous:
        it would escape the scope of its equation

diff --git a/testsuite/tests/typing-immediate/immediate.ml b/testsuite/tests/typing-immediate/immediate.ml
index c97cc6f297287b4ff023a222d085f202dbae10c8..2a62f7d902123777755839b356916757d78e8a28 100644 (file)
--- a/testsuite/tests/typing-immediate/immediate.ml
+++ b/testsuite/tests/typing-immediate/immediate.ml
@@ -6,7 +6,7 @@ module type S = sig type t [@@immediate] end;;
 module F (M : S) : S = M;;
 [%%expect{|
 module type S = sig type t [@@immediate] end
-module F : functor (M : S) -> S
+module F : (M : S) -> S
 |}];;
 
 (* VALID DECLARATIONS *)

diff --git a/testsuite/tests/typing-misc-bugs/pr6303_bad.compilers.reference b/testsuite/tests/typing-misc-bugs/pr6303_bad.compilers.reference
index 3f0f9278312050833500ca38dac28cdc44d43250..0ac56bd35b14667b88333a758d8030166a4acd55 100644 (file)
--- a/testsuite/tests/typing-misc-bugs/pr6303_bad.compilers.reference
+++ b/testsuite/tests/typing-misc-bugs/pr6303_bad.compilers.reference
@@ -1,6 +1,6 @@
 File "pr6303_bad.ml", line 11, characters 22-23:
 11 | let r' : string foo = r
                            ^
-Error: This expression has type "int foo"
-       but an expression was expected of type "string foo"
+Error: The value "r" has type "int foo" but an expression was expected of type
+         "string foo"
        Type "int" is not compatible with type "string"

diff --git a/testsuite/tests/typing-misc/automatic_generalize.ml b/testsuite/tests/typing-misc/automatic_generalize.ml
new file mode 100644 (file)
index 0000000..571c0ee
--- /dev/null
+++ b/testsuite/tests/typing-misc/automatic_generalize.ml
@@ -0,0 +1,13 @@
+(* TEST
+ expect;
+*)
+
+(* #13688 *)
+type 'e opt = 'e option constraint 'e = [> `A ]
+let f: unit -> [> `A] opt = fun () -> None
+let x = f ()
+[%%expect{|
+type 'a opt = 'a option constraint 'a = [> `A ]
+val f : unit -> [> `A ] opt = <fun>
+val x : [> `A ] opt = None
+|}]

diff --git a/testsuite/tests/typing-misc/constraints.ml b/testsuite/tests/typing-misc/constraints.ml
index 9163da5f696f43c125127a6cb294c162545fc212..01b7e41b86eb57acedd830f8c2031a755d068c38 100644 (file)
--- a/testsuite/tests/typing-misc/constraints.ml
+++ b/testsuite/tests/typing-misc/constraints.ml
@@ -419,7 +419,7 @@ Error: The type abbreviation "cycle" is cyclic:
          "cycle id" = "cycle"
 |}]
 
-(* Vanishing constraints may be discarded during the translation *)
+(* Vanishing constraints should be checked during the translation *)
 type 'a t = [`Foo]
 type 'a cstr constraint 'a = float
 [%%expect{|
@@ -430,8 +430,11 @@ type 'a cstr constraint 'a = float
 type s = int
 and r = [s cstr t | `Bar]
 [%%expect{|
-type s = int
-and r = [ `Bar | `Foo ]
+Line 1, characters 0-12:
+1 | type s = int
+    ^^^^^^^^^^^^
+Error: This type constructor expands to type "s" = "int"
+       but is used here with type "float"
 |}]
 
 
@@ -448,3 +451,15 @@ Error: Constraints are not satisfied in this type.
        Type "foo" was considered abstract when checking constraints in this
        recursive type definition.
 |}]
+
+(* PR#13510 *)
+
+type 'a x = [ `X of 'e ] constraint 'a = 'e list
+
+type p = private [> a x]
+and a = int list
+[%%expect{|
+type 'a x = [ `X of 'e ] constraint 'a = 'e list
+type p = private [> a x ]
+and a = int list
+|}]

diff --git a/testsuite/tests/typing-misc/exp_denom.ml b/testsuite/tests/typing-misc/exp_denom.ml
new file mode 100644 (file)
index 0000000..c536046
--- /dev/null
+++ b/testsuite/tests/typing-misc/exp_denom.ml
@@ -0,0 +1,102 @@
+(* TEST
+   expect;
+*)
+
+(* This test showcases the various denominations used in type clash errors *)
+
+let f (x : < m : float >) = print_int x#m
+
+[%%expect {|
+Line 1, characters 38-41:
+1 | let f (x : < m : float >) = print_int x#m
+                                          ^^^
+Error: The method call "x#m" has type "float"
+       but an expression was expected of type "int"
+|}]
+
+type r = { f : float }
+
+let f (x : r) = print_int x.f
+
+[%%expect {|
+type r = { f : float; }
+Line 3, characters 26-29:
+3 | let f (x : r) = print_int x.f
+                              ^^^
+Error: The field access "x.f" has type "float"
+       but an expression was expected of type "int"
+|}]
+
+type v = Cons
+
+let _ = print_int Cons
+
+[%%expect {|
+type v = Cons
+Line 3, characters 18-22:
+3 | let _ = print_int Cons
+                      ^^^^
+Error: The constructor "Cons" has type "v" but an expression was expected of type
+         "int"
+|}]
+
+let _ = print_int `Cons
+
+[%%expect {|
+Line 1, characters 18-23:
+1 | let _ = print_int `Cons
+                      ^^^^^
+Error: The constructor "`Cons" has type "[> `Cons ]"
+       but an expression was expected of type "int"
+|}]
+
+let v = 0.
+let _ = print_int v
+
+[%%expect {|
+val v : float = 0.
+Line 2, characters 18-19:
+2 | let _ = print_int v
+                      ^
+Error: The value "v" has type "float" but an expression was expected of type "int"
+|}]
+
+let _ = print_int 0.
+
+[%%expect {|
+Line 1, characters 18-20:
+1 | let _ = print_int 0.
+                      ^^
+Error: The constant "0." has type "float" but an expression was expected of type
+         "int"
+|}]
+
+let _ = print_int "foo"
+
+[%%expect {|
+Line 1, characters 18-23:
+1 | let _ = print_int "foo"
+                      ^^^^^
+Error: This constant has type "string" but an expression was expected of type
+         "int"
+|}]
+
+let _ : int = while false do () done
+
+[%%expect {|
+Line 1, characters 14-36:
+1 | let _ : int = while false do () done
+                  ^^^^^^^^^^^^^^^^^^^^^^
+Error: This "while" expression has type "unit"
+       but an expression was expected of type "int"
+|}]
+
+let _ : int = for _ = 1 to 2 do () done
+
+[%%expect {|
+Line 1, characters 14-39:
+1 | let _ : int = for _ = 1 to 2 do () done
+                  ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This "for" expression has type "unit"
+       but an expression was expected of type "int"
+|}]

diff --git a/testsuite/tests/typing-misc/injectivity.ml b/testsuite/tests/typing-misc/injectivity.ml
index efef3a2a912125b0c59909618118a2c323ae4169..325c96f166c759dc37b216702f40b745fcdacd23 100644 (file)
--- a/testsuite/tests/typing-misc/injectivity.ml
+++ b/testsuite/tests/typing-misc/injectivity.ml
@@ -212,7 +212,7 @@ module F(X : sig type 'a t end) = struct
 end
 [%%expect{|
 module F :
-  functor (X : sig type 'a t end) ->
+  (X : sig type 'a t end) ->
     sig type 'a u = 'b X.t constraint 'a = < b : 'b X.t > end
 |}]
 (* But not too clever *)
@@ -232,7 +232,7 @@ module F(X : sig type 'a t end) = struct
 end
 [%%expect{|
 module F :
-  functor (X : sig type 'a t end) ->
+  (X : sig type 'a t end) ->
     sig type 'a u = 'b X.t constraint 'a = < b : 'b X.t > end
 |}, Principal{|
 Line 2, characters 2-51:
@@ -396,7 +396,7 @@ let coerce : type a b. (a, b) eql -> a -> b = fun Refl x -> x;;
 [%%expect{|
 type (_, _) eql = Refl : ('a, 'a) eql
 module Uninj :
-  functor (X : sig type !'a t end) ->
+  (X : sig type !'a t end) ->
     sig val uninj : ('a X.t, 'b X.t) eql -> ('a, 'b) eql end
 val coerce : ('a, 'b) eql -> 'a -> 'b = <fun>
 |}]

diff --git a/testsuite/tests/typing-misc/labels.ml b/testsuite/tests/typing-misc/labels.ml
index 9a99b58bed0e3ce83f0de585eee16b72eaf6382c..83311100d93fed9500d84383f92a2aa0d6f391c8 100644 (file)
--- a/testsuite/tests/typing-misc/labels.ml
+++ b/testsuite/tests/typing-misc/labels.ml
@@ -151,3 +151,47 @@ val f : (x:int -> y:int -> int) -> int = <fun>
 module E : sig type t = (x:int -> y:int -> int) -> int end
 val g : 'a -> E.t = <fun>
 |}]
+
+let labeled ~x = ()
+let unlabeled x = ()
+let wrong_label ~y = ()
+let expect_unlabeled g = if true then g ()
+let expect_labeled g x = if true then g ~x;;
+[%%expect {|
+val labeled : x:'a -> unit = <fun>
+val unlabeled : 'a -> unit = <fun>
+val wrong_label : y:'a -> unit = <fun>
+val expect_unlabeled : (unit -> unit) -> unit = <fun>
+val expect_labeled : (x:'a -> unit) -> 'a -> unit = <fun>
+|}]
+
+let () = expect_unlabeled labeled
+[%%expect {|
+Line 1, characters 26-33:
+1 | let () = expect_unlabeled labeled
+                              ^^^^^^^
+Error: The value "labeled" has type "x:'a -> unit"
+       but an expression was expected of type "unit -> unit"
+       The first argument is labeled "x",
+       but an unlabeled argument was expected
+|}]
+
+let () = expect_labeled unlabeled
+[%%expect {|
+Line 1, characters 24-33:
+1 | let () = expect_labeled unlabeled
+                            ^^^^^^^^^
+Error: The value "unlabeled" has type "'a -> unit"
+       but an expression was expected of type "x:'b -> unit"
+       A label "x" was expected
+|}]
+
+let () = expect_labeled wrong_label
+[%%expect {|
+Line 1, characters 24-35:
+1 | let () = expect_labeled wrong_label
+                            ^^^^^^^^^^^
+Error: The value "wrong_label" has type "y:'a -> unit"
+       but an expression was expected of type "x:'b -> unit"
+       Labels "y" and "x" do not match
+|}]

diff --git a/testsuite/tests/typing-misc/let_rec_approx.ml b/testsuite/tests/typing-misc/let_rec_approx.ml
index 2224acb1ced625f1f1bc7e53c3625b7c852ace75..3684b4da25ae5697a1b01f61fff8fc902fc24c85 100644 (file)
--- a/testsuite/tests/typing-misc/let_rec_approx.ml
+++ b/testsuite/tests/typing-misc/let_rec_approx.ml
@@ -17,7 +17,7 @@ and g (x : string) = f ()
 Line 1, characters 17-19:
 1 | let rec f () = g 42
                      ^^
-Error: This expression has type "int" but an expression was expected of type
+Error: The constant "42" has type "int" but an expression was expected of type
          "string"
 |}]
 

diff --git a/testsuite/tests/typing-misc/occur_check.ml b/testsuite/tests/typing-misc/occur_check.ml
index 05f8df6940716deecf0642c247983fac233fb8af..35b56fc33ef35aa0bdfa2065cf3192410eafc2dc 100644 (file)
--- a/testsuite/tests/typing-misc/occur_check.ml
+++ b/testsuite/tests/typing-misc/occur_check.ml
@@ -11,8 +11,8 @@ type 'a t = 'a
 Line 2, characters 42-43:
 2 | let f (g : 'a list -> 'a t -> 'a) s = g s s;;
                                               ^
-Error: This expression has type "'a list"
-       but an expression was expected of type "'a t" = "'a"
+Error: The value "s" has type "'a list" but an expression was expected of type
+         "'a t" = "'a"
        The type variable "'a" occurs inside "'a list"
 |}];;
 
@@ -21,8 +21,8 @@ let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;;
 Line 1, characters 42-43:
 1 | let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;;
                                               ^
-Error: This expression has type "'a * 'b"
-       but an expression was expected of type "'a t" = "'a"
+Error: The value "s" has type "'a * 'b" but an expression was expected of type
+         "'a t" = "'a"
        The type variable "'a" occurs inside "'a * 'b"
 |}];;
 

diff --git a/testsuite/tests/typing-misc/optbinders.ml b/testsuite/tests/typing-misc/optbinders.ml
index 12188461a6a340cbaf7046a033f44f12b580d6a2..5f9e5ccb19d87e3d9dfc275e7a47c4487e4e7355 100644 (file)
--- a/testsuite/tests/typing-misc/optbinders.ml
+++ b/testsuite/tests/typing-misc/optbinders.ml
@@ -12,8 +12,8 @@ module Id : Id2 = struct let id x = x end
 [%%expect{|
 module type Id1 = sig val id : 'a -> 'a end
 module type Id2 = sig val id : 'a -> 'a end
-module F : functor (X : Id1) -> Id2
-module G : functor (X : Id2) -> Id1
+module F : (X : Id1) -> Id2
+module G : (X : Id2) -> Id1
 module Id : Id2
 |}]
 

diff --git a/testsuite/tests/typing-misc/polyvars.ml b/testsuite/tests/typing-misc/polyvars.ml
index 7510f338a3b1d071ff9eb19cdf61ed12443bf451..77f87cd94459c287ba4b621093c8604cce48e895 100644 (file)
--- a/testsuite/tests/typing-misc/polyvars.ml
+++ b/testsuite/tests/typing-misc/polyvars.ml
@@ -180,8 +180,7 @@ type t = private [< `A ]
 Line 2, characters 30-31:
 2 | let f: t -> [ `A ] = fun x -> x
                                   ^
-Error: This expression has type "t" but an expression was expected of type
-         "[ `A ]"
+Error: The value "x" has type "t" but an expression was expected of type "[ `A ]"
        The first variant type is private, it may not allow the tag(s) "`A"
 |}]
 
@@ -242,7 +241,7 @@ let f (x:[`X of int]) = (x:[`X])
 Line 5, characters 25-26:
 5 | let f (x:[`X of int]) = (x:[`X])
                              ^
-Error: This expression has type "[ `X of int ]"
+Error: The value "x" has type "[ `X of int ]"
        but an expression was expected of type "[ `X ]"
        Types for tag "`X" are incompatible
 |}]
@@ -253,7 +252,7 @@ let f (x:[`X of int]) = (x:[<`X of & int])
 Line 1, characters 25-26:
 1 | let f (x:[`X of int]) = (x:[<`X of & int])
                              ^
-Error: This expression has type "[ `X of int ]"
+Error: The value "x" has type "[ `X of int ]"
        but an expression was expected of type "[< `X of & int ]"
        Types for tag "`X" are incompatible
 |}]
@@ -265,7 +264,7 @@ let f (x:[<`X of & int & float]) = (x:[`X])
 Line 3, characters 36-37:
 3 | let f (x:[<`X of & int & float]) = (x:[`X])
                                         ^
-Error: This expression has type "[< `X of & int & float ]"
+Error: The value "x" has type "[< `X of & int & float ]"
        but an expression was expected of type "[ `X ]"
        Types for tag "`X" are incompatible
 |}]
@@ -282,7 +281,7 @@ val f : ([< `A | `B of string | `R of 'a ] as 'a) -> int = <fun>
 Line 4, characters 30-31:
 4 | let g (x:[`A | `R of rt]) = f x
                                   ^
-Error: This expression has type "[ `A | `R of rt ]"
+Error: The value "x" has type "[ `A | `R of rt ]"
        but an expression was expected of type "[< `A | `R of 'a ] as 'a"
        Type "rt" = "[ `A | `B of string | `R of rt ]" is not compatible with type
          "[< `A | `R of 'a ] as 'a"

diff --git a/testsuite/tests/typing-misc/pr6416.ml b/testsuite/tests/typing-misc/pr6416.ml
index 5a7562dee47e1b3032c3c2a1f432a8a4107485ea..9fb2eae652900edf1aa50e6488f77b615fb239f9 100644 (file)
--- a/testsuite/tests/typing-misc/pr6416.ml
+++ b/testsuite/tests/typing-misc/pr6416.ml
@@ -55,7 +55,7 @@ Error: Signature mismatch:
        Constructors do not match:
          "A of t"
        is not the same as:
-         "A of t"
+         "A of t/2"
        The type "t" is not equal to the type "t/2"
        Line 4, characters 9-19:
          Definition of type "t"
@@ -80,22 +80,19 @@ Lines 4-7, characters 4-7:
 7 |     end
 Error: Signature mismatch:
        Modules do not match:
-         sig module type s module A : functor (X : s) -> sig end end
+         sig module type s module A : (X : s) -> sig end end
        is not included in
-         sig module A : functor (X : s) -> sig end end
+         sig module A : (X : s) -> sig end end
        In module "A":
        Modules do not match:
-         functor (X : s) -> ...
+         (X : s) -> ...
        is not included in
-         functor (X : s/2) -> ...
-       Module types do not match:
-         s
-       does not include
-         s/2
-       Line 5, characters 6-19:
-         Definition of module type "s"
-       Line 2, characters 2-15:
-         Definition of module type "s/2"
+         (X : s/2) -> ...
+       Module types do not match: s does not include s/2
+Line 5, characters 6-19:
+  Definition of module type "s"
+Line 2, characters 2-15:
+  Definition of module type "s/2"
 |}]
 
 module L = struct
@@ -124,7 +121,7 @@ Error: Signature mismatch:
        Constructors do not match:
          "A of T.t"
        is not the same as:
-         "A of T.t"
+         "A of T/2.t"
        The type "T.t" is not equal to the type "T/2.t"
        Line 5, characters 6-34:
          Definition of module "T"
@@ -154,7 +151,7 @@ Error: Signature mismatch:
          val f : (module s/2) -> t/2 -> t/2
        The type "(module s) -> t/2 -> t" is not compatible with the type
          "(module s/2) -> t/2 -> t/2"
-       Type "(module s)" is not compatible with type "(module s/2)"
+       Modules do not match: s is not included in s/2
        Line 5, characters 23-33:
          Definition of type "t"
        Line 3, characters 2-12:
@@ -221,10 +218,10 @@ Error: Signature mismatch:
          class b : a/2
        The public method c cannot be hidden
        The first class type has no method m
-       Line 5, characters 4-74:
-         Definition of class type "a"
-       Line 2, characters 2-36:
-         Definition of class type "a/2"
+Line 5, characters 4-74:
+  Definition of class type "a"
+Line 2, characters 2-36:
+  Definition of class type "a/2"
 |}]
 
 module R = struct
@@ -252,10 +249,10 @@ Error: Signature mismatch:
        does not match
          class type b = a/2
        The first class type has no method m
-       Line 5, characters 4-29:
-         Definition of class type "a"
-       Line 2, characters 2-42:
-         Definition of class type "a/2"
+Line 5, characters 4-29:
+  Definition of class type "a"
+Line 2, characters 2-42:
+  Definition of class type "a/2"
 |}]
 
 module S = struct

diff --git a/testsuite/tests/typing-misc/pr7103.ml b/testsuite/tests/typing-misc/pr7103.ml
index 6ba3a4f97ab8e76c5b21a58c425a37ab4f88dffe..e4ca3d1cc8ac1d4ea538d1f5d67228ad3212c44a 100644 (file)
--- a/testsuite/tests/typing-misc/pr7103.ml
+++ b/testsuite/tests/typing-misc/pr7103.ml
@@ -23,7 +23,7 @@ let _ = fun (x : a t) -> f x;;
 Line 1, characters 27-28:
 1 | let _ = fun (x : a t) -> f x;;
                                ^
-Error: This expression has type "a t" but an expression was expected of type
+Error: The value "x" has type "a t" but an expression was expected of type
          "< .. > t"
        Type "a" is not compatible with type "< .. >"
 |}];;
@@ -33,7 +33,7 @@ let _ = fun (x : a t) -> g x;;
 Line 1, characters 27-28:
 1 | let _ = fun (x : a t) -> g x;;
                                ^
-Error: This expression has type "a t" but an expression was expected of type
+Error: The value "x" has type "a t" but an expression was expected of type
          "[< `b ] t"
        Type "a" is not compatible with type "[< `b ]"
 |}];;
@@ -43,7 +43,7 @@ let _ = fun (x : a t) -> h x;;
 Line 1, characters 27-28:
 1 | let _ = fun (x : a t) -> h x;;
                                ^
-Error: This expression has type "a t" but an expression was expected of type
+Error: The value "x" has type "a t" but an expression was expected of type
          "[> `b ] t"
        Type "a" is not compatible with type "[> `b ]"
 |}];;

diff --git a/testsuite/tests/typing-misc/pr7937.ml b/testsuite/tests/typing-misc/pr7937.ml
index 780e1be7d6a2fda4c02268d56d889afe20b7d73a..3605e46a5affb9c79f50abdaf7b33258a7a9baa1 100644 (file)
--- a/testsuite/tests/typing-misc/pr7937.ml
+++ b/testsuite/tests/typing-misc/pr7937.ml
@@ -10,8 +10,8 @@ type 'a r = 'a constraint 'a = [< `X of int & 'a ]
 Line 3, characters 35-39:
 3 | let f: 'a. 'a r -> 'a r = fun x -> true;;
                                        ^^^^
-Error: This expression has type "bool" but an expression was expected of type
-         "([< `X of int & 'a ] as 'a) r"
+Error: The constructor "true" has type "bool"
+       but an expression was expected of type "([< `X of int & 'a ] as 'a) r"
 |}]
 
 let g: 'a. 'a r -> 'a r = fun x -> { contents = 0 };;

diff --git a/testsuite/tests/typing-misc/pr8548.ml b/testsuite/tests/typing-misc/pr8548.ml
index dd6cac13efa7c318a0d2b837dd789ea9f67d11a3..ed0054dda42f9569f1526b88ac3da7756f83d9b2 100644 (file)
--- a/testsuite/tests/typing-misc/pr8548.ml
+++ b/testsuite/tests/typing-misc/pr8548.ml
@@ -77,43 +77,41 @@ end
 ;;
 [%%expect{|
 module Assume :
-  functor
-    (Given : sig
-               module Make_range :
-                 functor (Endpoint : Endpoint_intf) ->
-                   sig
-                     module Endpoint : sig type t = Endpoint.t end
-                     type finite = [ `Before of Endpoint.t ]
-                     type infinite = [ `Until_infinity ]
-                     type +'a range = private { until : 'a; }
-                       constraint 'a =
-                         [< `Before of Endpoint.t | `Until_infinity ]
-                     val until :
-                       ([< `Before of Endpoint.t | `Until_infinity ] as 'a)
-                       range -> 'a
-                   end
-               module Make_ranged :
-                 functor (Range : S) ->
-                   sig
-                     module Endpoint : sig type t = Range.Endpoint.t end
-                     module Range :
-                       sig
-                         module Endpoint : sig type t = Range.Endpoint.t end
-                         type finite = [ `Before of Endpoint.t ]
-                         type infinite = [ `Until_infinity ]
-                         type +'a range =
-                           'a Range.range = private {
-                           until : 'a;
-                         }
-                           constraint 'a =
-                             [< `Before of Endpoint.t | `Until_infinity ]
-                         val until :
-                           ([< `Before of Endpoint.t | `Until_infinity ]
-                            as 'a)
-                           range -> 'a
-                       end
-                   end
-             end)
+  (Given : sig
+             module Make_range :
+               (Endpoint : Endpoint_intf) ->
+                 sig
+                   module Endpoint : sig type t = Endpoint.t end
+                   type finite = [ `Before of Endpoint.t ]
+                   type infinite = [ `Until_infinity ]
+                   type +'a range = private { until : 'a; }
+                     constraint 'a =
+                       [< `Before of Endpoint.t | `Until_infinity ]
+                   val until :
+                     ([< `Before of Endpoint.t | `Until_infinity ] as 'a)
+                     range -> 'a
+                 end
+             module Make_ranged :
+               (Range : S) ->
+                 sig
+                   module Endpoint : sig type t = Range.Endpoint.t end
+                   module Range :
+                     sig
+                       module Endpoint : sig type t = Range.Endpoint.t end
+                       type finite = [ `Before of Endpoint.t ]
+                       type infinite = [ `Until_infinity ]
+                       type +'a range =
+                         'a Range.range = private {
+                         until : 'a;
+                       }
+                         constraint 'a =
+                           [< `Before of Endpoint.t | `Until_infinity ]
+                       val until :
+                         ([< `Before of Endpoint.t | `Until_infinity ] as 'a)
+                         range -> 'a
+                     end
+                 end
+           end)
     ->
     sig
       module Point : sig type t end

diff --git a/testsuite/tests/typing-misc/printing.ml b/testsuite/tests/typing-misc/printing.ml
index 7f26f459c7a0bc3acce0a030ab8edd3da113a4a0..ff390212925c34071d6621bbc5b29ff94f31a4ea 100644 (file)
--- a/testsuite/tests/typing-misc/printing.ml
+++ b/testsuite/tests/typing-misc/printing.ml
@@ -79,7 +79,7 @@ type t = < m : int * 'a > as 'a
 Line 4, characters 32-33:
 4 |   | Refl -> if true then x else y
                                     ^
-Error: This expression has type "a" but an expression was expected of type "t"
+Error: The value "y" has type "a" but an expression was expected of type "t"
        This instance of "< m : int * 'a > as 'a" is ambiguous:
        it would escape the scope of its equation
 |}]
@@ -94,7 +94,7 @@ type t2 = < m : 'a. 'a * ('a * 'b) > as 'b
 Line 3, characters 22-23:
 3 | let f (x : t1) : t2 = x;;
                           ^
-Error: This expression has type "t1" but an expression was expected of type "t2"
+Error: The value "x" has type "t1" but an expression was expected of type "t2"
        The method "m" has type "'c. 'c * ('a * < m : 'c. 'b >) as 'b",
        but the expected method type was "'a. 'a * ('a * < m : 'a. 'd >) as 'd"
        The universal variable "'a" would escape its scope

diff --git a/testsuite/tests/typing-misc/scope_escape.ml b/testsuite/tests/typing-misc/scope_escape.ml
index 8b902ad114abd18733f71faf13532a6504b65494..952b86768b570507332bf73725caf313c35d0ea3 100644 (file)
--- a/testsuite/tests/typing-misc/scope_escape.ml
+++ b/testsuite/tests/typing-misc/scope_escape.ml
@@ -9,7 +9,7 @@ val x : '_weak1 list ref = {contents = []}
 Line 2, characters 34-35:
 2 | module M = struct type t let _ = (x : t list ref) end;;
                                       ^
-Error: This expression has type "'weak1 list ref"
+Error: The value "x" has type "'weak1 list ref"
        but an expression was expected of type "t list ref"
        The type constructor "t" would escape its scope
 |}]

diff --git a/testsuite/tests/typing-misc/typecore_errors.ml b/testsuite/tests/typing-misc/typecore_errors.ml
index 9476d58e59ae5cad5c794d249e5341e94c0d5edd..b11d0a7ecd89ea2ed366594034578f5e190d77b5 100644 (file)
--- a/testsuite/tests/typing-misc/typecore_errors.ml
+++ b/testsuite/tests/typing-misc/typecore_errors.ml
@@ -12,9 +12,9 @@
 
 let x = function 0. .. 1. -> ()
 [%%expect {|
-Line 8, characters 17-25:
+Line 8, characters 17-19:
 8 | let x = function 0. .. 1. -> ()
-                     ^^^^^^^^
+                     ^^
 Error: Only character intervals are supported in patterns.
 |}]
 

diff --git a/testsuite/tests/typing-misc/unique_names_in_unification.ml b/testsuite/tests/typing-misc/unique_names_in_unification.ml
index 307dcc0974b618a777dd3ab2a20393beaea48057..fc9748522063fdcd5a6a12313d96cdcc8ab2be9c 100644 (file)
--- a/testsuite/tests/typing-misc/unique_names_in_unification.ml
+++ b/testsuite/tests/typing-misc/unique_names_in_unification.ml
@@ -14,7 +14,7 @@ val x : t = A
 Line 5, characters 27-28:
 5 |   let f: t -> t = fun B -> x
                                ^
-Error: This expression has type "t/2" but an expression was expected of type "t"
+Error: The value "x" has type "t/2" but an expression was expected of type "t"
        Line 4, characters 2-12:
          Definition of type "t"
        Line 1, characters 0-10:
@@ -36,8 +36,7 @@ val y : M.t = M.B
 Line 7, characters 34-35:
 7 |   let f : M.t -> M.t = fun M.C -> y
                                       ^
-Error: This expression has type "M/2.t" but an expression was expected of type
-         "M.t"
+Error: The value "y" has type "M/2.t" but an expression was expected of type "M.t"
        Lines 4-6, characters 2-5:
          Definition of module "M"
        Line 1, characters 0-32:
@@ -53,7 +52,7 @@ type t = D
 Line 2, characters 25-26:
 2 | let f: t -> t = fun D -> x;;
                              ^
-Error: This expression has type "t/2" but an expression was expected of type "t"
+Error: The value "x" has type "t/2" but an expression was expected of type "t"
        Line 1, characters 0-10:
          Definition of type "t"
        Line 1, characters 0-10:
@@ -76,8 +75,7 @@ type nonrec ttt = X of ttt
 Line 2, characters 32-33:
 2 | let x: ttt = let rec y = A y in y;;
                                     ^
-Error: This expression has type "ttt/2" but an expression was expected of type
-         "ttt"
+Error: The value "y" has type "ttt/2" but an expression was expected of type "ttt"
        Line 1, characters 0-26:
          Definition of type "ttt"
        Line 2, characters 0-30:

diff --git a/testsuite/tests/typing-misc/variant.ml b/testsuite/tests/typing-misc/variant.ml
index 27dd24306056ca83e57a7ae0337b9a55fb781fa5..3ed9611d7a1e349b0da1d0e25be1f1f963447b9c 100644 (file)
--- a/testsuite/tests/typing-misc/variant.ml
+++ b/testsuite/tests/typing-misc/variant.ml
@@ -37,7 +37,7 @@ module Make (X : sig val f : [ `A ] -> unit end) = struct
 end;;
 [%%expect{|
 module Make :
-  functor (X : sig val f : [ `A ] -> unit end) ->
+  (X : sig val f : [ `A ] -> unit end) ->
     sig
       val make : (([< `A ] as 'a) -> 'b) -> ('a -> 'c) -> 'a -> 'c
       val f : [ `A ] -> unit

diff --git a/testsuite/tests/typing-missing-cmi-3/user.ml b/testsuite/tests/typing-missing-cmi-3/user.ml
index 6026f841000adfe307fb195e960eba45b1ae04bb..ff95b6e11870d519730994435f8c21d0a188500d 100644 (file)
--- a/testsuite/tests/typing-missing-cmi-3/user.ml
+++ b/testsuite/tests/typing-missing-cmi-3/user.ml
@@ -32,7 +32,7 @@ let () = Middle.(f x)
 Line 1, characters 19-20:
 1 | let () = Middle.(f x)
                        ^
-Error: This expression has type "(module Original.T)"
+Error: The value "x" has type "(module Original.T)"
        but an expression was expected of type
          "(module Original.T with type t = int)"
 |}]
@@ -75,6 +75,7 @@ Line 2, characters 12-45:
                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Type "Middle.pack1" = "(module Original.T with type t = int)"
        is not a subtype of "(module T1)"
+       The module alias "Original.T" could not be expanded
 |}]
 
 module type T2 = sig module M : sig type t = int end end
@@ -86,6 +87,7 @@ Line 2, characters 12-45:
                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Type "Middle.pack2" = "(module Middle.T with type M.t = int)"
        is not a subtype of "(module T2)"
+       The module alias "Original.T" could not be expanded
 |}]
 
 (* Check the detection of type kind in type-directed disambiguation . *)

diff --git a/testsuite/tests/typing-missing-cmi/test.compilers.reference b/testsuite/tests/typing-missing-cmi/test.compilers.reference
index 95a913bfa9a023d363f4b3fa40d1dd7549e19e2a..08becbce8eac31b18494c4f964ef6e5744d016a3 100644 (file)
--- a/testsuite/tests/typing-missing-cmi/test.compilers.reference
+++ b/testsuite/tests/typing-missing-cmi/test.compilers.reference
@@ -1,8 +1,7 @@
 File "main.ml", line 1, characters 14-17:
 1 | let _ = A.a = B.b
                   ^^^
-Error: This expression has type "M.b" but an expression was expected of type
-         "M.a"
+Error: The value "B.b" has type "M.b" but an expression was expected of type "M.a"
        Type "M.b" is abstract because no corresponding cmi file was found
        in path.
        Type "M.a" is abstract because no corresponding cmi file was found

diff --git a/testsuite/tests/typing-modules-bugs/pr10693_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr10693_bad.compilers.reference
index 41476915aaf5014efd252b8ff8347201e6b82b74..37c39f5c392ffd2f91d2a029de5fde1675e6c6e7 100644 (file)
--- a/testsuite/tests/typing-modules-bugs/pr10693_bad.compilers.reference
+++ b/testsuite/tests/typing-modules-bugs/pr10693_bad.compilers.reference
@@ -10,10 +10,10 @@ Error: Signature mismatch:
        Modules do not match:
          Dep -> S
        is not included in
-         functor (X : Dep) ->
+         (X : Dep) ->
            sig
              val x : X.t option
-             module M : functor (Y : Dep) -> sig val x : X.t option end
+             module M : (Y : Dep) -> sig val x : X.t option end
            end
        In module "M":
        Modules do not match:
@@ -21,22 +21,22 @@ Error: Signature mismatch:
        is not included in
          sig
            val x : X.t option
-           module M : functor (Y : Dep) -> sig val x : X.t option end
+           module M : (Y : Dep) -> sig val x : X.t option end
          end
        In module "M.M":
        Modules do not match:
-         functor (X : Dep) ->
+         (X : Dep) ->
            sig
              val x : X.t option
-             module M : functor (Y : Dep) -> sig val x : X.t option end
+             module M : (Y : Dep) -> sig val x : X.t option end
            end
        is not included in
-         functor (Y : Dep) -> sig val x : X.t option end
+         (Y : Dep) -> sig val x : X.t option end
        In module "M.M":
        Modules do not match:
          sig
            val x : X.t option
-           module M : functor (Y : Dep) -> sig val x : X.t option end
+           module M : (Y : Dep) -> sig val x : X.t option end
          end
        is not included in
          sig val x : X.t option end

diff --git a/testsuite/tests/typing-modules-bugs/pr6752_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr6752_bad.compilers.reference
index ee441d5f5a3286dedf31ca9d26725c15d62c5168..78ce714445f1c0d8531c1b03f22900b1ddc43812 100644 (file)
--- a/testsuite/tests/typing-modules-bugs/pr6752_bad.compilers.reference
+++ b/testsuite/tests/typing-modules-bugs/pr6752_bad.compilers.reference
@@ -1,6 +1,6 @@
 File "pr6752_bad.ml", line 26, characters 31-40:
 26 | let q' : Common0.msg Queue.t = Common0.q
                                     ^^^^^^^^^
-Error: This expression has type "'a Queue.t"
+Error: The value "Common0.q" has type "'a Queue.t"
        but an expression was expected of type "Common0.msg Queue.t"
        The type constructor "Common0.msg" would escape its scope

diff --git a/testsuite/tests/typing-modules-bugs/pr6992_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr6992_bad.compilers.reference
index 9da4e397837037f993f49311c5941c93ff014529..942be04f1dd9c74a084b1319acdffe8adf49e2aa 100644 (file)
--- a/testsuite/tests/typing-modules-bugs/pr6992_bad.compilers.reference
+++ b/testsuite/tests/typing-modules-bugs/pr6992_bad.compilers.reference
@@ -1,6 +1,6 @@
 File "pr6992_bad.ml", line 16, characters 69-71:
 16 |   let uniq (type a) (type b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq
                                                                           ^^
-Error: This expression has type "(a, a) eq"
+Error: The constructor "Eq" has type "(a, a) eq"
        but an expression was expected of type "(a, b) eq"
        Type "a" is not compatible with type "b"

diff --git a/testsuite/tests/typing-modules-bugs/pr7414_2_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr7414_2_bad.compilers.reference
index 5418524928dfdae37cca748cd4f53e248d36267e..7028884d5f55d7019dd23ca8e29391682466c0a9 100644 (file)
--- a/testsuite/tests/typing-modules-bugs/pr7414_2_bad.compilers.reference
+++ b/testsuite/tests/typing-modules-bugs/pr7414_2_bad.compilers.reference
@@ -2,8 +2,8 @@ File "pr7414_2_bad.ml", line 46, characters 22-35:
 46 |   let module Ignore = Force(Choose) in
                            ^^^^^^^^^^^^^
 Error: Modules do not match:
-       functor () -> sig module Choice : T val r : '_weak1 list ref ref end
-     is not included in functor () -> S
+       () -> sig module Choice : T val r : '_weak1 list ref ref end
+     is not included in () -> S
      Modules do not match:
        sig module Choice : T val r : '_weak1 list ref ref end
      is not included in

diff --git a/testsuite/tests/typing-modules-bugs/pr7414_bad.compilers.reference b/testsuite/tests/typing-modules-bugs/pr7414_bad.compilers.reference
index 1dbed9449246569767bcb35da3ec29bdc85db158..dd896a08eb3a6fe94abdd8960c8ed07e4a81e6d6 100644 (file)
--- a/testsuite/tests/typing-modules-bugs/pr7414_bad.compilers.reference
+++ b/testsuite/tests/typing-modules-bugs/pr7414_bad.compilers.reference
@@ -2,8 +2,8 @@ File "pr7414_bad.ml", line 52, characters 16-29:
 52 | module Ignore = Force(Choose)
                      ^^^^^^^^^^^^^
 Error: Modules do not match:
-       functor () -> sig module Choice : T val r : '_weak1 list ref ref end
-     is not included in functor () -> S
+       () -> sig module Choice : T val r : '_weak1 list ref ref end
+     is not included in () -> S
      Modules do not match:
        sig module Choice : T val r : '_weak1 list ref ref end
      is not included in

diff --git a/testsuite/tests/typing-modules/.gitattributes b/testsuite/tests/typing-modules/.gitattributes
deleted file mode 100644 (file)
index e69de29..0000000

diff --git a/testsuite/tests/typing-modules/Test.ml b/testsuite/tests/typing-modules/Test.ml
index 792f02182dfc9e67c5c9bc2803f21fe015ea14d7..ce983751f806969242429fade4d30046edd148d6 100644 (file)
--- a/testsuite/tests/typing-modules/Test.ml
+++ b/testsuite/tests/typing-modules/Test.ml
@@ -119,11 +119,11 @@ Error: Multiple definition of the extension constructor name "Foo".
 module F(X : sig end) = struct let x = 3 end;;
 F.x;; (* fail *)
 [%%expect{|
-module F : functor (X : sig end) -> sig val x : int end
+module F : (X : sig end) -> sig val x : int end
 Line 2, characters 0-3:
 2 | F.x;; (* fail *)
     ^^^
-Error: The module F is a functor, it cannot have any components
+Error: The module "F" is a functor, it cannot have any components
 |}];;
 
 type t = ..;;

diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml
index 486f99e7117f79f695f2ab48a2bc2fd2223eecb5..e093ac2c6ead0fd58d344c411b9b616d10318651 100644 (file)
--- a/testsuite/tests/typing-modules/aliases.ml
+++ b/testsuite/tests/typing-modules/aliases.ml
@@ -57,7 +57,7 @@ module C4 = F(struct end);;
 C4.chr 66;;
 [%%expect{|
 module F :
-  functor (X : sig end) ->
+  (X : sig end) ->
     sig
       external code : char -> int = "%identity"
       val chr : int -> char
@@ -91,7 +91,7 @@ module C4 :
 module G(X:sig end) = struct module M = X end;; (* does not alias X *)
 module M = G(struct end);;
 [%%expect{|
-module G : functor (X : sig end) -> sig module M : sig end end
+module G : (X : sig end) -> sig module M : sig end end
 module M : sig module M : sig end end
 |}];;
 
@@ -141,9 +141,8 @@ module M5 = G(struct end);;
 M5.N'.x;;
 [%%expect{|
 module F :
-  functor (X : sig end) ->
-    sig module N : sig val x : int end module N' = N end
-module G : functor (X : sig end) -> sig module N' : sig val x : int end end
+  (X : sig end) -> sig module N : sig val x : int end module N' = N end
+module G : (X : sig end) -> sig module N' : sig val x : int end end
 module M5 : sig module N' : sig val x : int end end
 - : int = 1
 |}];;
@@ -265,7 +264,7 @@ val pow : t -> t -> t = <fun>
 
 module F(X:sig module C = Char end) = struct module C = X.C end;;
 [%%expect{|
-module F : functor (X : sig module C = Char end) -> sig module C = Char end
+module F : (X : sig module C = Char end) -> sig module C = Char end
 |}];;
 
 (* Applicative functors *)
@@ -383,7 +382,7 @@ end;;
 include T;;
 let f (x : t) : T.t = x ;;
 [%%expect{|
-module F : functor (M : sig end) -> sig type t end
+module F : (M : sig end) -> sig type t end
 module T : sig module M : sig end type t = F(M).t end
 module M = T.M
 type t = F(M).t
@@ -470,11 +469,11 @@ module G = F (M.Y);;
 module N = G (M);;
 module N = F (M.Y) (M);;
 [%%expect{|
-module FF : functor (X : sig end) -> sig type t end
+module FF : (X : sig end) -> sig type t end
 module M :
   sig module X : sig end module Y : sig type t = FF(X).t end type t = Y.t end
-module F : functor (Y : sig type t end) (M : sig type t = Y.t end) -> sig end
-module G : functor (M : sig type t = M.Y.t end) -> sig end
+module F : (Y : sig type t end) (M : sig type t = Y.t end) -> sig end
+module G : (M : sig type t = M.Y.t end) -> sig end
 module N : sig end
 module N : sig end
 |}];;
@@ -488,7 +487,7 @@ end
 include T
 let f (x : t) : T.t = x
 [%%expect {|
-module F : functor (M : sig end) -> sig type t end
+module F : (M : sig end) -> sig type t end
 module T : sig module M : sig end type t = F(M).t end
 module M = T.M
 type t = F(M).t
@@ -511,7 +510,7 @@ module A1 : sig end
 module A2 : sig end
 module L1 : sig module X = A1 end
 module L2 : sig module X = A2 end
-module F : functor (L : sig module X : sig end end) -> sig end
+module F : (L : sig module X : sig end end) -> sig end
 module F1 : sig end
 module F2 : sig end
 |}];;
@@ -688,7 +687,7 @@ module type A = Alias with module N := F(List);;
 module rec Bad : A = Bad;;
 [%%expect{|
 module type Alias = sig module N : sig end module M = N end
-module F : functor (X : sig end) -> sig type t end
+module F : (X : sig end) -> sig type t end
 Line 1:
 Error: Module type declarations do not match:
          module type A = sig module M = F(List) end
@@ -780,7 +779,7 @@ end = struct
   type a = Foo.b
 end;;
 [%%expect{|
-module F : functor (X : sig end) -> sig type t end
+module F : (X : sig end) -> sig type t end
 module M :
   sig type a module Foo : sig module Bar : sig end type b = a end end
 |}];;
@@ -880,7 +879,7 @@ module M :
         module A : sig val x : string end
         module B : sig val x : int end
       end
-    module F : functor (X : sig module A = N.A end) -> sig val s : string end
+    module F : (X : sig module A = N.A end) -> sig val s : string end
   end
 module N : sig val s : string end
 val s : string = "hello"

diff --git a/testsuite/tests/typing-modules/applicative_functor_type.ml b/testsuite/tests/typing-modules/applicative_functor_type.ml
index bd83485e0f4fc73b33dc9049f988aa937b87a6ab..1aa096f9cb910719c38d173678257762249bdd6d 100644 (file)
--- a/testsuite/tests/typing-modules/applicative_functor_type.ml
+++ b/testsuite/tests/typing-modules/applicative_functor_type.ml
@@ -32,8 +32,7 @@ Error: Modules do not match:
 module F(X : sig type t = M.t val equal : unit end)
   = struct type t end
 [%%expect{|
-module F :
-  functor (X : sig type t = M.t val equal : unit end) -> sig type t end
+module F : (X : sig type t = M.t val equal : unit end) -> sig type t end
 |} ]
 
 type t = F(M).t
@@ -55,7 +54,7 @@ Error: Modules do not match:
 (* MPR#7611 *)
 module Generative() = struct type t end
 [%%expect{|
-module Generative : functor () -> sig type t end
+module Generative : () -> sig type t end
 |}]
 
 type t = Generative(M).t

diff --git a/testsuite/tests/typing-modules/firstclass.ml b/testsuite/tests/typing-modules/firstclass.ml
index 89d139439222d4466cfb7fde763dca94219811aa..a4295887cc0611dbf70ae48c052a3de617438633 100644 (file)
--- a/testsuite/tests/typing-modules/firstclass.ml
+++ b/testsuite/tests/typing-modules/firstclass.ml
@@ -32,9 +32,13 @@ val h : (module S2 with type t = 'a) -> (module S with type t = 'a) = <fun>
 Line 5, characters 3-4:
 5 |   (x : (module S'));; (* fail *)
        ^
-Error: This expression has type
-         "(module S2 with type t = int and type u = bool)"
+Error: The value "x" has type "(module S2 with type t = int and type u = bool)"
        but an expression was expected of type "(module S')"
+       Modules do not match:
+         S'
+       is not included in
+         sig type u = bool type t = int type w end
+       The type "w" is required but not provided
 |}];;
 
 (* but you cannot forget values (no physical coercions) *)
@@ -48,4 +52,97 @@ Line 3, characters 2-67:
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Type "(module S3 with type t = int and type u = bool)"
        is not a subtype of "(module S')"
+       The two first-class module types differ by their runtime size.
 |}];;
+
+(* but you cannot move values (no physical coercions) *)
+module type S4 = sig val x : int  val mid:int  val y:int end
+module type S5 = sig val x:int val y:int end
+let g4 x =
+  (x : (module S4) :> (module S5));; (* fail *)
+[%%expect{|
+module type S4 = sig val x : int val mid : int val y : int end
+module type S5 = sig val x : int val y : int end
+Line 4, characters 2-34:
+4 |   (x : (module S4) :> (module S5));; (* fail *)
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type "(module S4)" is not a subtype of "(module S5)"
+       The two first-class module types do not share
+       the same positions for runtime components.
+       For example, the value "mid" occurs at the expected position of
+       the value "y".
+|}];;
+
+
+let g5 x =
+  (x : (module S5) :> (module S4));; (* fail *)
+[%%expect{|
+Line 2, characters 2-34:
+2 |   (x : (module S5) :> (module S4));; (* fail *)
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type "(module S5)" is not a subtype of "(module S4)"
+       Modules do not match: S5 is not included in S4
+       The value "mid" is required but not provided
+|}];;
+
+module type Prim_Id = sig external id: 'a -> 'a = "%identity" end
+module type Id = sig val id: 'a -> 'a end
+module Named = struct end
+module type Alias = sig module Alias = Named end
+module type Nested = sig module Alias: sig end end
+[%%expect {|
+module type Prim_Id = sig external id : 'a -> 'a = "%identity" end
+module type Id = sig val id : 'a -> 'a end
+module Named : sig end
+module type Alias = sig module Alias = Named end
+module type Nested = sig module Alias : sig end end
+|}]
+
+let coerce_prim x = (x:(module Prim_Id):>(module Id))
+[%%expect {|
+Line 1, characters 20-53:
+1 | let coerce_prim x = (x:(module Prim_Id):>(module Id))
+                        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type "(module Prim_Id)" is not a subtype of "(module Id)"
+       The two first-class module types differ by a coercion of
+       the primitive "%identity" to a value.
+|}]
+
+let coerce_alias x = (x:(module Alias):>(module Nested))
+[%%expect {|
+Line 1, characters 21-56:
+1 | let coerce_alias x = (x:(module Alias):>(module Nested))
+                         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type "(module Alias)" is not a subtype of "(module Nested)"
+       The two first-class module types differ by a coercion of
+       a module alias "Named" to a module.
+|}]
+
+module type Nested_coercion = sig
+  module M: sig
+    external identity: 'a -> 'a = "%identity"
+  end
+end
+
+
+module type Nested_coercion_bis = sig
+  module M: sig
+    val identity: 'a -> 'a
+  end
+end
+
+let coerce_prim' x = (x:(module Nested_coercion):>(module Nested_coercion_bis))
+
+[%%expect{|
+module type Nested_coercion =
+  sig module M : sig external identity : 'a -> 'a = "%identity" end end
+module type Nested_coercion_bis =
+  sig module M : sig val identity : 'a -> 'a end end
+Line 14, characters 21-79:
+14 | let coerce_prim' x = (x:(module Nested_coercion):>(module Nested_coercion_bis))
+                          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type "(module Nested_coercion)" is not a subtype of
+         "(module Nested_coercion_bis)"
+       The two first-class module types differ by a coercion of
+       the primitive "%identity" to a value, in module "M".
+|}]

diff --git a/testsuite/tests/typing-modules/functors.ml b/testsuite/tests/typing-modules/functors.ml
index 3f2cfab0c874beb8c0dc3aa8419b996a8566d321..e9d83c5943d79e6650b884f0fd6bf61e52d091ca 100644 (file)
--- a/testsuite/tests/typing-modules/functors.ml
+++ b/testsuite/tests/typing-modules/functors.ml
@@ -11,7 +11,7 @@ module type c
 module type x = sig type x end
 module type y = sig type y end
 module type z = sig type z end
-
+module type w = sig type w end
 
 module type empty = sig end
 
@@ -19,6 +19,7 @@ module Empty = struct end
 module X: x = struct type x end
 module Y: y = struct type y end
 module Z: z = struct type z end
+module W: w = struct type w end
 module F(X:x)(Y:y)(Z:z) = struct end
 [%%expect {|
 module type a
@@ -27,12 +28,14 @@ module type c
 module type x = sig type x end
 module type y = sig type y end
 module type z = sig type z end
+module type w = sig type w end
 module type empty = sig end
 module Empty : sig end
 module X : x
 module Y : y
 module Z : z
-module F : functor (X : x) (Y : y) (Z : z) -> sig end
+module W : w
+module F : (X : x) (Y : y) (Z : z) -> sig end
 |}]
 
 
@@ -45,25 +48,67 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          X Z
        do not match these parameters:
-         functor (X : x) (Y : y) (Z : z) -> ...
+         (X : x) (Y : y) (Z : z) -> ...
        1. Module X matches the expected module type x
        2. An argument appears to be missing with module type y
        3. Module Z matches the expected module type z
 |}]
 
+module M = F(W)
+[%%expect {|
+Line 1, characters 11-15:
+1 | module M = F(W)
+               ^^^^
+Error: Modules do not match: sig type w = W.w end is not included in
+       x
+     The type "x" is required but not provided
+|}]
+
+module M = F(Y)
+[%%expect {|
+Line 1, characters 11-15:
+1 | module M = F(Y)
+               ^^^^
+Error: This application of the functor "F" is ill-typed.
+       These arguments:
+         Y
+       do not match these parameters:
+         (X : x) (Y : y) -> ...
+       1. An argument appears to be missing with module type x
+       2. Module Y matches the expected module type y
+|}]
+
+module M = F(X)(W)
+[%%expect {|
+Line 1, characters 11-18:
+1 | module M = F(X)(W)
+               ^^^^^^^
+Error: This application of the functor "F" is ill-typed.
+       These arguments:
+         X W
+       do not match these parameters:
+         (X : x) (Y : y) -> ...
+       1. Module X matches the expected module type x
+       2. Modules do not match:
+            W : sig type w = W.w end
+          is not included in
+            y
+          The type "y" is required but not provided
+|}]
+
 module type f = functor (X:empty)(Y:empty) -> empty
 module F: f =
   functor(X:empty)(Y:empty)(Z:empty) -> Empty
 [%%expect {|
-module type f = functor (X : empty) (Y : empty) -> empty
+module type f = (X : empty) (Y : empty) -> empty
 Line 3, characters 9-45:
 3 |   functor(X:empty)(Y:empty)(Z:empty) -> Empty
              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
        Modules do not match:
-         functor (X : empty) (Y : empty) (Z : empty) -> ...
+         (X : empty) (Y : empty) (Z : empty) -> ...
        is not included in
-         functor (X : empty) (Y : empty) -> ...
+         (X : empty) (Y : empty) -> ...
        1. Module types empty and empty match
        2. Module types empty and empty match
        3. An extra argument is provided of module type empty
@@ -72,15 +117,15 @@ Error: Signature mismatch:
 module type f = functor (X:a)(Y:b) -> c
 module F:f = functor (X:a)(Y:b)(Z:c) -> Empty
 [%%expect {|
-module type f = functor (X : a) (Y : b) -> c
+module type f = (X : a) (Y : b) -> c
 Line 2, characters 21-45:
 2 | module F:f = functor (X:a)(Y:b)(Z:c) -> Empty
                          ^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
        Modules do not match:
-         functor (X : a) (Y : b) (Z : c) -> ...
+         (X : a) (Y : b) (Z : c) -> ...
        is not included in
-         functor (X : a) (Y : b) -> ...
+         (X : a) (Y : b) -> ...
        1. Module types a and a match
        2. Module types b and b match
        3. An extra argument is provided of module type c
@@ -97,14 +142,14 @@ Lines 2-4, characters 2-5:
 4 |   end
 Error: Signature mismatch:
        Modules do not match:
-         sig module F : functor (X : sig type t end) -> sig end end
+         sig module F : (X : sig type t end) -> sig end end
        is not included in
-         sig module F : functor (X : sig end) -> sig end end
+         sig module F : (X : sig end) -> sig end end
        In module "F":
        Modules do not match:
-         functor (X : $S1) -> ...
+         (X : $S1) -> ...
        is not included in
-         functor (X : sig end) -> ...
+         (X : sig end) -> ...
        Module types do not match:
          $S1 = sig type t end
        does not include
@@ -115,7 +160,7 @@ Error: Signature mismatch:
 module F(X:sig type t end) = struct end
 module M = F(struct type x end)
 [%%expect {|
-module F : functor (X : sig type t end) -> sig end
+module F : (X : sig type t end) -> sig end
 Line 2, characters 11-31:
 2 | module M = F(struct type x end)
                ^^^^^^^^^^^^^^^^^^^^
@@ -129,7 +174,7 @@ end
 type u = F(X)(Z).t
 [%%expect {|
 module F :
-  functor (X : sig type x end) (Y : sig type y end) (Z : sig type z end) ->
+  (X : sig type x end) (Y : sig type y end) (Z : sig type z end) ->
     sig type t = X of X.x | Y of Y.y | Z of Z.z end
 Line 4, characters 9-18:
 4 | type u = F(X)(Z).t
@@ -138,7 +183,7 @@ Error: The functor application "F(X)(Z)" is ill-typed.
        These arguments:
          X Z
        do not match these parameters:
-         functor (X : ...) (Y : $T2) (Z : ...) -> ...
+         (X : ...) (Y : $T2) (Z : ...) -> ...
        1. Module X matches the expected module type
        2. An argument appears to be missing with module type
               $T2 = sig type y end
@@ -148,7 +193,7 @@ Error: The functor application "F(X)(Z)" is ill-typed.
 module F()(X:sig type t end) = struct end
 module M = F()()
 [%%expect {|
-module F : functor () (X : sig type t end) -> sig end
+module F : () (X : sig type t end) -> sig end
 Line 2, characters 11-16:
 2 | module M = F()()
                ^^^^^
@@ -156,7 +201,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          () ()
        do not match these parameters:
-         functor () (X : $T2) -> ...
+         () (X : $T2) -> ...
        1. Module () matches the expected module type
        2. The functor was expected to be applicative at this position
 |}]
@@ -173,17 +218,16 @@ Lines 3-5, characters 6-3:
 5 | end
 Error: Signature mismatch:
        Modules do not match:
-         sig module F : functor (X : sig type y end) -> sig end end
+         sig module F : (X : sig type y end) -> sig end end
        is not included in
          sig
-           module F :
-             functor (X : sig type x end) (X : sig type y end) -> sig end
+           module F : (X : sig type x end) (X : sig type y end) -> sig end
          end
        In module "F":
        Modules do not match:
-         functor (X : $S2) -> ...
+         (X : $S2) -> ...
        is not included in
-         functor (X : $T1) (X : $T2) -> ...
+         (X : $T1) (X : $T2) -> ...
        1. An argument appears to be missing with module type
               $T1 = sig type x end
        2. Module types $S2 and $T2 match
@@ -208,7 +252,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          Ctx.Y Ctx.X
        do not match these parameters:
-         functor (A : Ctx.t) (B : Ctx.u) -> ...
+         (A : Ctx.t) (B : Ctx.u) -> ...
        1. Modules do not match: Ctx.Y : Ctx.u is not included in Ctx.t
        2. Modules do not match: Ctx.X : Ctx.t is not included in Ctx.u
 |}]
@@ -225,10 +269,10 @@ Error: This application of the functor "Map.Make" is ill-typed.
        These arguments:
          Ord Ord
        do not match these parameters:
-         functor (Ord : Map.OrderedType) -> ...
-       1. The following extra argument is provided
+         (Ord : Map.OrderedType) -> ...
+       1. Module Ord matches the expected module type Map.OrderedType
+       2. The following extra argument is provided
               Ord : sig type t = unit val compare : 'a -> 'b -> int end
-       2. Module Ord matches the expected module type Map.OrderedType
 |}]
 
 
@@ -244,8 +288,8 @@ module K = struct include X include Y end
 module M = F(K)(struct type x = K.x end)( (* struct type z = K.y end *) )
 [%%expect {|
 module F :
-  functor (A : sig type x type y end) (B : sig type x = A.x end)
-    (C : sig type y = A.y end) -> sig end
+  (A : sig type x type y end) (B : sig type x = A.x end)
+  (C : sig type y = A.y end) -> sig end
 module K : sig type x = X.x type y = Y.y end
 Line 10, characters 11-73:
 10 | module M = F(K)(struct type x = K.x end)( (* struct type z = K.y end *) )
@@ -254,7 +298,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          K $S2 ()
        do not match these parameters:
-         functor (A : ...) (B : ...) (C : $T3) -> ...
+         (A : ...) (B : ...) (C : $T3) -> ...
        1. Module K matches the expected module type
        2. Module $S2 matches the expected module type
        3. The functor was expected to be applicative at this position
@@ -269,7 +313,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          K $S3
        do not match these parameters:
-         functor (A : ...) (B : $T2) (C : ...) -> ...
+         (A : ...) (B : $T2) (C : ...) -> ...
        1. Module K matches the expected module type
        2. An argument appears to be missing with module type
               $T2 = sig type x = A.x end
@@ -292,7 +336,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          $S1 $S2 $S3
        do not match these parameters:
-         functor (A : ...) (B : ...) (C : $T3) -> ...
+         (A : ...) (B : ...) (C : $T3) -> ...
        1. Module $S1 matches the expected module type
        2. Module $S2 matches the expected module type
        3. Modules do not match:
@@ -327,7 +371,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          M.N Defs.Y
        do not match these parameters:
-         functor (A : ...) (B : $T2) (C : ...) -> ...
+         (A : ...) (B : $T2) (C : ...) -> ...
        1. Module M.N matches the expected module type
        2. An argument appears to be missing with module type
               $T2 = sig type x = A.x end
@@ -343,11 +387,11 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          M.N Defs.X Defs.X Defs.Y
        do not match these parameters:
-         functor (A : ...) (B : ...) (C : ...) -> ...
+         (A : ...) (B : ...) (C : ...) -> ...
        1. Module M.N matches the expected module type
-       2. The following extra argument is provided
+       2. Module Defs.X matches the expected module type
+       3. The following extra argument is provided
               Defs.X : sig type x = M.N.x end
-       3. Module Defs.X matches the expected module type
        4. Module Defs.Y matches the expected module type
 |}]
 
@@ -365,7 +409,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          $S1 Y
        do not match these parameters:
-         functor (A : ...) (B : $T2) (C : ...) -> ...
+         (A : ...) (B : $T2) (C : ...) -> ...
        1. Module $S1 matches the expected module type
        2. An argument appears to be missing with module type
               $T2 = sig type x = A.x end
@@ -381,10 +425,10 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          $S1 X X Y
        do not match these parameters:
-         functor (A : ...) (B : ...) (C : ...) -> ...
+         (A : ...) (B : ...) (C : ...) -> ...
        1. Module $S1 matches the expected module type
-       2. The following extra argument is provided X : sig type x = int end
-       3. Module X matches the expected module type
+       2. Module X matches the expected module type
+       3. The following extra argument is provided X : sig type x = int end
        4. Module Y matches the expected module type
 |}]
 
@@ -396,16 +440,16 @@ module type f =
 module F: f = functor (A:sig include x include y end)(Z:sig type y = A.y end) -> struct end
 [%%expect {|
 module type f =
-  functor (A : sig type x type y end) (B : sig type x = A.x end)
-    (C : sig type y = A.y end) -> sig end
+  (A : sig type x type y end) (B : sig type x = A.x end)
+  (C : sig type y = A.y end) -> sig end
 Line 4, characters 22-91:
 4 | module F: f = functor (A:sig include x include y end)(Z:sig type y = A.y end) -> struct end
                           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
        Modules do not match:
-         functor (A : $S1) (Z : $S3) -> ...
+         (A : $S1) (Z : $S3) -> ...
        is not included in
-         functor (A : $T1) (B : $T2) (C : $T3) -> ...
+         (A : $T1) (B : $T2) (C : $T3) -> ...
        1. Module types $S1 and $T1 match
        2. An argument appears to be missing with module type
               $T2 = sig type x = A.x end
@@ -419,17 +463,17 @@ module type f =
 module F: f = functor (X:sig include x include y end)(Z:sig type zv = Z of X.y end) -> struct end
 [%%expect {|
 module type f =
-  functor (B : sig type x type y type u = x type v = y end)
-    (Y : sig type yu = Y of B.u end) (Z : sig type zv = Z of B.v end) ->
+  (B : sig type x type y type u = x type v = y end)
+  (Y : sig type yu = Y of B.u end) (Z : sig type zv = Z of B.v end) ->
     sig end
 Line 4, characters 22-97:
 4 | module F: f = functor (X:sig include x include y end)(Z:sig type zv = Z of X.y end) -> struct end
                           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
        Modules do not match:
-         functor (X : $S1) (Z : $S3) -> ...
+         (X : $S1) (Z : $S3) -> ...
        is not included in
-         functor (B : $T1) (Y : $T2) (Z : $T3) -> ...
+         (B : $T1) (Y : $T2) (Z : $T3) -> ...
        1. Module types $S1 and $T1 match
        2. An argument appears to be missing with module type
               $T2 = sig type yu = Y of B.u end
@@ -509,7 +553,7 @@ module M = struct
   end
 end
 [%%expect {|
-module F : functor (X : x) (B : b) (Y : y) -> sig type t end
+module F : (X : x) (B : b) (Y : y) -> sig type t end
 Line 8, characters 15-57:
 8 |     module U = F(struct type x end)(B)(struct type w end)
                    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -517,17 +561,14 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          $S1 P.B $S3
        do not match these parameters:
-         functor (X : x) (B : b/2) (Y : y) -> ...
+         (X : x) (B : b/2) (Y : y) -> ...
        1. Module $S1 matches the expected module type x
-       2. Modules do not match:
-            P.B : b
-          is not included in
-            b/2
-          Line 5, characters 2-15:
-            Definition of module type "b"
-          Line 2, characters 0-13:
-            Definition of module type "b/2"
+       2. Modules do not match: P.B : b is not included in b/2
        3. Modules do not match: $S3 : sig type w end is not included in y
+Line 5, characters 2-15:
+  Definition of module type "b"
+Line 2, characters 0-13:
+  Definition of module type "b/2"
 |}]
 
 module F(X:a) = struct type t end
@@ -539,15 +580,15 @@ module M = struct
   end
 end
 [%%expect {|
-module F : functor (X : a) -> sig type t end
+module F : (X : a) -> sig type t end
 Line 6, characters 13-19:
 6 |     type t = F(X).t
                  ^^^^^^
 Error: Modules do not match: a is not included in a/2
-     Line 3, characters 2-15:
-       Definition of module type "a"
-     Line 1, characters 0-13:
-       Definition of module type "a/2"
+Line 3, characters 2-15:
+  Definition of module type "a"
+Line 1, characters 0-13:
+  Definition of module type "a/2"
 |}]
 
 
@@ -570,24 +611,21 @@ Error: Signature mismatch:
          sig
            module type aa = a
            module type a
-           module F : functor (X : aa) (Y : a) -> sig end
+           module F : (X : aa) (Y : a) -> sig end
          end
        is not included in
-         sig module F : functor (X : a) (Y : a) -> sig end end
+         sig module F : (X : a) (Y : a) -> sig end end
        In module "F":
        Modules do not match:
-         functor (X : aa) (Y : a) -> ...
+         (X : aa) (Y : a) -> ...
        is not included in
-         functor (X : a/2) (Y : a/2) -> ...
+         (X : a/2) (Y : a/2) -> ...
        1. Module types aa and a/2 match
-       2. Module types do not match:
-            a
-          does not include
-            a/2
-          Line 4, characters 2-15:
-            Definition of module type "a"
-          Line 1, characters 0-13:
-            Definition of module type "a/2"
+       2. Module types do not match: a does not include a/2
+Line 4, characters 2-15:
+  Definition of module type "a"
+Line 1, characters 0-13:
+  Definition of module type "a/2"
 |}]
 
 module X: functor ( X: sig end) -> sig end = functor(X: Set.OrderedType) -> struct end
@@ -597,9 +635,9 @@ Line 1, characters 52-86:
                                                         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: Signature mismatch:
        Modules do not match:
-         functor (X : Set.OrderedType) -> ...
+         (X : Set.OrderedType) -> ...
        is not included in
-         functor (X : sig end) -> ...
+         (X : sig end) -> ...
        Module types do not match:
          Set.OrderedType
        does not include
@@ -653,43 +691,33 @@ Error: Signature mismatch:
        Modules do not match:
          sig
            module F :
-             functor
-               (X : functor (A : sig type xa end) (B : sig type xz end) ->
-                      sig end)
-               (Y : functor (A : sig type ya end) (B : sig type ybb end) ->
-                      sig end)
-               (Z : functor (A : sig type za end) (B : sig type zbb end) ->
-                      sig end)
-               -> sig end
+             (X : (A : sig type xa end) (B : sig type xz end) -> sig end)
+             (Y : (A : sig type ya end) (B : sig type ybb end) -> sig end)
+             (Z : (A : sig type za end) (B : sig type zbb end) -> sig end) ->
+               sig end
          end
        is not included in
          sig
            module F :
-             functor
-               (X : functor (A : sig type xa end) (B : sig type xz end) ->
-                      sig end)
-               (Y : functor (A : sig type ya end) (B : sig type yb end) ->
-                      sig end)
-               (Z : functor (A : sig type za end) (B : sig type zb end) ->
-                      sig end)
-               -> sig end
+             (X : (A : sig type xa end) (B : sig type xz end) -> sig end)
+             (Y : (A : sig type ya end) (B : sig type yb end) -> sig end)
+             (Z : (A : sig type za end) (B : sig type zb end) -> sig end) ->
+               sig end
          end
        In module "F":
        Modules do not match:
-         functor (X : $S1) (Y : $S2) (Z : $S3) -> ...
+         (X : $S1) (Y : $S2) (Z : $S3) -> ...
        is not included in
-         functor (X : $T1) (Y : $T2) (Z : $T3) -> ...
+         (X : $T1) (Y : $T2) (Z : $T3) -> ...
        1. Module types $S1 and $T1 match
        2. Module types do not match:
-            $S2 =
-            functor (A : sig type ya end) (B : sig type ybb end) -> sig end
+            $S2 = (A : sig type ya end) (B : sig type ybb end) -> sig end
           does not include
-            $T2 =
-            functor (A : sig type ya end) (B : sig type yb end) -> sig end
+            $T2 = (A : sig type ya end) (B : sig type yb end) -> sig end
           Modules do not match:
-            functor (A : $S1) (B : $S2) -> ...
+            (A : $S1) (B : $S2) -> ...
           is not included in
-            functor (A : $T1) (B : $T2) -> ...
+            (A : $T1) (B : $T2) -> ...
           1. Module types $S1 and $T1 match
           2. Module types do not match:
                $S2 = sig type yb end
@@ -697,15 +725,13 @@ Error: Signature mismatch:
                $T2 = sig type ybb end
              The type "yb" is required but not provided
        3. Module types do not match:
-            $S3 =
-            functor (A : sig type za end) (B : sig type zbb end) -> sig end
+            $S3 = (A : sig type za end) (B : sig type zbb end) -> sig end
           does not include
-            $T3 =
-            functor (A : sig type za end) (B : sig type zb end) -> sig end
+            $T3 = (A : sig type za end) (B : sig type zb end) -> sig end
           Modules do not match:
-            functor (A : $S1) (B : $S2) -> ...
+            (A : $S1) (B : $S2) -> ...
           is not included in
-            functor (A : $T1) (B : $T2) -> ...
+            (A : $T1) (B : $T2) -> ...
 |}]
 
 
@@ -746,35 +772,27 @@ Error: Signature mismatch:
        Modules do not match:
          sig
            module F :
-             functor
-               (X : functor (A : sig type xa end) (B : sig type xz end) ->
-                      sig end)
-               (Y : functor (A : sig type ya end) (B : sig type yb end) ->
-                      sig end)
-               -> sig end
+             (X : (A : sig type xa end) (B : sig type xz end) -> sig end)
+             (Y : (A : sig type ya end) (B : sig type yb end) -> sig end) ->
+               sig end
          end
        is not included in
          sig
            module F :
-             functor
-               (X : functor (A : sig type xa end) (B : sig type xz end) ->
-                      sig end)
-               (Y : functor (A : sig type ya end) (B : sig type yb end) ->
-                      sig end)
-               (Z : functor (A : sig type za end) (B : sig type zb end) ->
-                      sig end)
-               -> sig end
+             (X : (A : sig type xa end) (B : sig type xz end) -> sig end)
+             (Y : (A : sig type ya end) (B : sig type yb end) -> sig end)
+             (Z : (A : sig type za end) (B : sig type zb end) -> sig end) ->
+               sig end
          end
        In module "F":
        Modules do not match:
-         functor (X : $S1) (Y : $S2) -> ...
+         (X : $S1) (Y : $S2) -> ...
        is not included in
-         functor (X : $T1) (Y : $T2) (Z : $T3) -> ...
+         (X : $T1) (Y : $T2) (Z : $T3) -> ...
        1. Module types $S1 and $T1 match
        2. Module types $S2 and $T2 match
        3. An argument appears to be missing with module type
-              $T3 =
-              functor (A : sig type za end) (B : sig type zb end) -> sig end
+              $T3 = (A : sig type za end) (B : sig type zb end) -> sig end
 |}]
 
 module M: sig
@@ -817,42 +835,32 @@ Error: Signature mismatch:
        Modules do not match:
          sig
            module F :
-             functor
-               (X : functor (A : sig type xaa end) (B : sig type xz end) ->
-                      sig end)
-               (Y : functor (A : sig type ya end) (B : sig type ybb end) ->
-                      sig end)
-               (Z : functor (A : sig type za end) (B : sig type zbb end) ->
-                      sig end)
-               -> sig end
+             (X : (A : sig type xaa end) (B : sig type xz end) -> sig end)
+             (Y : (A : sig type ya end) (B : sig type ybb end) -> sig end)
+             (Z : (A : sig type za end) (B : sig type zbb end) -> sig end) ->
+               sig end
          end
        is not included in
          sig
            module F :
-             functor
-               (X : functor (A : sig type xa end) (B : sig type xz end) ->
-                      sig end)
-               (Y : functor (A : sig type ya end) (B : sig type yb end) ->
-                      sig end)
-               (Z : functor (A : sig type za end) (B : sig type zb end) ->
-                      sig end)
-               -> sig end
+             (X : (A : sig type xa end) (B : sig type xz end) -> sig end)
+             (Y : (A : sig type ya end) (B : sig type yb end) -> sig end)
+             (Z : (A : sig type za end) (B : sig type zb end) -> sig end) ->
+               sig end
          end
        In module "F":
        Modules do not match:
-         functor (X : $S1) (Y : $S2) (Z : $S3) -> ...
+         (X : $S1) (Y : $S2) (Z : $S3) -> ...
        is not included in
-         functor (X : $T1) (Y : $T2) (Z : $T3) -> ...
+         (X : $T1) (Y : $T2) (Z : $T3) -> ...
        1. Module types do not match:
-            $S1 =
-            functor (A : sig type xaa end) (B : sig type xz end) -> sig end
+            $S1 = (A : sig type xaa end) (B : sig type xz end) -> sig end
           does not include
-            $T1 =
-            functor (A : sig type xa end) (B : sig type xz end) -> sig end
+            $T1 = (A : sig type xa end) (B : sig type xz end) -> sig end
           Modules do not match:
-            functor (A : $S1) (B : $S2) -> ...
+            (A : $S1) (B : $S2) -> ...
           is not included in
-            functor (A : $T1) (B : $T2) -> ...
+            (A : $T1) (B : $T2) -> ...
           1. Module types do not match:
                $S1 = sig type xa end
              does not include
@@ -860,25 +868,21 @@ Error: Signature mismatch:
              The type "xa" is required but not provided
           2. Module types $S2 and $T2 match
        2. Module types do not match:
-            $S2 =
-            functor (A : sig type ya end) (B : sig type ybb end) -> sig end
+            $S2 = (A : sig type ya end) (B : sig type ybb end) -> sig end
           does not include
-            $T2 =
-            functor (A : sig type ya end) (B : sig type yb end) -> sig end
+            $T2 = (A : sig type ya end) (B : sig type yb end) -> sig end
           Modules do not match:
-            functor (A : $S1) (B : $S2) -> ...
+            (A : $S1) (B : $S2) -> ...
           is not included in
-            functor (A : $T1) (B : $T2) -> ...
+            (A : $T1) (B : $T2) -> ...
        3. Module types do not match:
-            $S3 =
-            functor (A : sig type za end) (B : sig type zbb end) -> sig end
+            $S3 = (A : sig type za end) (B : sig type zbb end) -> sig end
           does not include
-            $T3 =
-            functor (A : sig type za end) (B : sig type zb end) -> sig end
+            $T3 = (A : sig type za end) (B : sig type zb end) -> sig end
           Modules do not match:
-            functor (A : $S1) (B : $S2) -> ...
+            (A : $S1) (B : $S2) -> ...
           is not included in
-            functor (A : $T1) (B : $T2) -> ...
+            (A : $T1) (B : $T2) -> ...
 |}]
 
 module A: sig
@@ -928,9 +932,8 @@ Error: Signature mismatch:
                        module E :
                          sig
                            module F :
-                             functor (X : sig type x end)
-                               (Y : sig type y' end) (W : sig type w end) ->
-                               sig end
+                             (X : sig type x end) (Y : sig type y' end)
+                             (W : sig type w end) -> sig end
                          end
                      end
                  end
@@ -1010,16 +1013,17 @@ Error: Signature mismatch:
          end
        In module "B.C.D.E.F":
        Modules do not match:
-         functor (X : $S1) (Y : $S3) (W : $S4) -> ...
+         (X : $S1) (Y : $S2) (W : $S4) -> ...
        is not included in
-         functor $T1 $T2 $T3 $T4 -> ...
+         $T1 $T2 $T3 $T4 -> ...
        1. Module types $S1 and $T1 match
-       2. An argument appears to be missing with module type
-              $T2 = sig type y end
-       3. Module types do not match:
-            $S3 = sig type y' end
+       2. Module types do not match:
+            $S2 = sig type y' end
           does not include
-            $T3 = sig type z end
+            $T2 = sig type y end
+          The type "y'" is required but not provided
+       3. An argument appears to be missing with module type
+              $T3 = sig type z end
        4. Module types $S4 and $T4 match
 |}]
 
@@ -1054,19 +1058,19 @@ Error: The functor application "G(X)(Y)(X)(Y)(X)" is ill-typed.
        These arguments:
          A.X A.Y A.X A.Y A.X
        do not match these parameters:
-         functor (X : A.A) (Y : A.A) A.A (Z : A.A) -> ...
-       1. The following extra argument is provided
-              A.X : A.Honorificabilitudinitatibus
-       2. Module A.Y matches the expected module type A.A
-       3. Modules do not match:
+         (X : A.A) (Y : A.A) A.A (Z : A.A) -> ...
+       1. Modules do not match:
             A.X : A.Honorificabilitudinitatibus
           is not included in
             A.A
-       4. Module A.Y matches the expected module type A.A
-       5. Modules do not match:
+       2. Module A.Y matches the expected module type A.A
+       3. Modules do not match:
             A.X : A.Honorificabilitudinitatibus
           is not included in
             A.A
+       4. Module A.Y matches the expected module type A.A
+       5. The following extra argument is provided
+              A.X : A.Honorificabilitudinitatibus
 |}]
 
 
@@ -1090,37 +1094,22 @@ module F: s = functor
   -> struct end
 [%%expect {|
 module type s =
-  functor
-    (X : sig
-           type when_
-           type shall
-           type we
-           type three
-           type meet
-           type again
-         end)
-    (Y : sig type in_ val thunder : in_ val lightning : in_ type rain end)
-    (Z : sig type when_ type the type hurlyburly's type done_ end)
-    (Z : sig
-           type when_
-           type the
-           type battle's
-           type lost
-           type and_
-           type won
-         end)
-    (W : sig
-           type that
-           type will
-           type be
-           type ere
-           type the_
-           type set
-           type of_
-           type sun
-         end)
-    (S : sig type where type the type place end)
-    (R : sig type upon type the type heath end) -> sig end
+  (X : sig type when_ type shall type we type three type meet type again end)
+  (Y : sig type in_ val thunder : in_ val lightning : in_ type rain end)
+  (Z : sig type when_ type the type hurlyburly's type done_ end)
+  (Z : sig type when_ type the type battle's type lost type and_ type won end)
+  (W : sig
+         type that
+         type will
+         type be
+         type ere
+         type the_
+         type set
+         type of_
+         type sun
+       end)
+  (S : sig type where type the type place end)
+  (R : sig type upon type the type heath end) -> sig end
 Lines 11-18, characters 2-15:
 11 | ..(X: sig type when_ type shall type we type tree type meet type again end)
 12 |   (Y:sig type in_ val thunder:in_ val lightning: in_ type pain end)
@@ -1132,10 +1121,10 @@ Lines 11-18, characters 2-15:
 18 |   -> struct end
 Error: Signature mismatch:
        Modules do not match:
-         functor (X : $S1) (Y : $S2) (Z : $S3) (Z : $S4) (W : $S5) (S : $S6)
+         (X : $S1) (Y : $S2) (Z : $S3) (Z : $S4) (W : $S5) (S : $S6)
          (R : $S7) -> ...
        is not included in
-         functor (X : $T1) (Y : $T2) (Z : $T3) (Z : $T4) (W : $T5) (S : $T6)
+         (X : $T1) (Y : $T2) (Z : $T3) (Z : $T4) (W : $T5) (S : $T6)
          (R : $T7) -> ...
        1. Module types do not match:
             $S1 =
@@ -1236,13 +1225,12 @@ end
 
 module U = F(PF)(PF)(PF)
 [%%expect {|
-module F :
-  functor (X : sig type witness module type t module M : t end) -> X.t
+module F : (X : sig type witness module type t module M : t end) -> X.t
 module PF :
   sig
     type witness
     module type t =
-      functor (X : sig type witness module type t module M : t end) -> X.t
+      (X : sig type witness module type t module M : t end) -> X.t
     module M = F
   end
 module U : PF.t
@@ -1257,23 +1245,17 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          PF PF PF PF PF F
        do not match these parameters:
-         functor (X : ...) (X : ...) (X : ...) (X : ...) (X : ...) (X : $T6)
-         -> ...
+         (X : ...) (X : ...) (X : ...) (X : ...) (X : ...) (X : $T6) -> ...
        1. Module PF matches the expected module type
        2. Module PF matches the expected module type
        3. Module PF matches the expected module type
        4. Module PF matches the expected module type
        5. Module PF matches the expected module type
        6. Modules do not match:
-            F :
-            functor (X : sig type witness module type t module M : t end) ->
-              X.t
+            F : (X : sig type witness module type t module M : t end) -> X.t
           is not included in
             $T6 = sig type witness module type t module M : t end
-          Modules do not match:
-            functor (X : $S1) -> ...
-          is not included in
-            functor  -> ...
+          Modules do not match: (X : $S1) -> ... is not included in  -> ...
           An extra argument is provided of module type
               $S1 = sig type witness module type t module M : t end
 |}]
@@ -1323,7 +1305,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          Add_one' Add_three A A A
        do not match these parameters:
-         functor (X : ...) arg arg arg -> ...
+         (X : ...) arg arg arg -> ...
        1. The following extra argument is provided
               Add_one' :
               sig module M = Add_one'.M module type t = Add_one'.t end
@@ -1345,18 +1327,20 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          Add_one Add_three A A A
        do not match these parameters:
-         functor (X : ...) arg arg arg -> ...
-       1. The following extra argument is provided
-              Add_one :
+         (X : ...) arg -> ...
+       1. Module Add_one matches the expected module type
+       2. The following extra argument is provided
+              Add_three :
               sig
-                type witness = Add_one.witness
-                module M = Add_one'.M
-                module type t = Add_one.t
+                module M = Add_three.M
+                module type t = Add_three.t
+                type witness = Add_three.witness
               end
-       2. Module Add_three matches the expected module type
        3. Module A matches the expected module type arg
-       4. Module A matches the expected module type arg
-       5. Module A matches the expected module type arg
+       4. The following extra argument is provided
+              A : sig type arg = A.arg end
+       5. The following extra argument is provided
+              A : sig type arg = A.arg end
 |}]
 
 
@@ -1388,26 +1372,23 @@ Lines 14-16, characters 2-3:
 Error: Signature mismatch:
        Modules do not match:
          sig
-           module F :
-             functor (X : sig type x end) (Z : sig type z end) -> sig end
+           module F : (X : sig type x end) (Z : sig type z end) -> sig end
          end
        is not included in
          sig
            module F :
-             functor
-               (X : sig
-                      type x
-                      module type t =
-                        functor (Y : sig type y end) (Z : sig type z end) ->
-                          sig end
-                    end)
+             (X : sig
+                    type x
+                    module type t =
+                      (Y : sig type y end) (Z : sig type z end) -> sig end
+                  end)
                -> X.t
          end
        In module "F":
        Modules do not match:
-         functor (X : $S1) (Z : $S3) -> ...
+         (X : $S1) (Z : $S3) -> ...
        is not included in
-         functor (X : $T1) (Y : $T2) (Z : $T3) -> ...
+         (X : $T1) (Y : $T2) (Z : $T3) -> ...
        1. Module types $S1 and $T1 match
        2. An argument appears to be missing with module type
               $T2 = sig type y end
@@ -1442,25 +1423,24 @@ Error: Signature mismatch:
        Modules do not match:
          sig
            module F :
-             functor (Wrong : sig type wrong end)
-               (X : sig module type t module M : t end) -> X.t
+             (Wrong : sig type wrong end)
+             (X : sig module type t module M : t end) -> X.t
          end
        is not included in
          sig
            module F :
-             functor
-               (X : sig
-                      module type T
-                      module type t = T -> T -> T
-                      module M : t
-                    end)
+             (X : sig
+                    module type T
+                    module type t = T -> T -> T
+                    module M : t
+                  end)
                -> X.T -> X.T -> X.T
          end
        In module "F":
        Modules do not match:
-         functor (Wrong : $S1) (X : $S2) X.T X.T -> ...
+         (Wrong : $S1) (X : $S2) X.T X.T -> ...
        is not included in
-         functor (X : $T2) X.T X.T -> ...
+         (X : $T2) X.T X.T -> ...
        1. An extra argument is provided of module type
               $S1 = sig type wrong end
        2. Module types $S2 and $T2 match
@@ -1502,45 +1482,41 @@ Error: Signature mismatch:
          sig
            module F :
              sig type wrong end ->
-               functor (X : sig module type T end) (Res : X.T) (Res :
-                 X.T) (Res : X.T)
-               -> X.T
+               (X : sig module type T end) (Res : X.T) (Res : X.T)
+               (Res : X.T) -> X.T
          end
        is not included in
          sig
            module F :
              sig end ->
-               functor
-                 (X : sig
-                        module type T
-                        module type inner =
-                          sig module type t module M : t end
-                        module F :
-                          functor (X : inner) -> (T -> T -> T) ->
-                            sig module type res = X.t end
-                        module Y :
-                          sig
-                            module type t = T -> T -> T
-                            module M : functor (X : T) (Y : T) -> T
-                          end
-                      end)
+               (X : sig
+                      module type T
+                      module type inner = sig module type t module M : t end
+                      module F :
+                        (X : inner) -> (T -> T -> T) ->
+                          sig module type res = X.t end
+                      module Y :
+                        sig
+                          module type t = T -> T -> T
+                          module M : (X : T) (Y : T) -> T
+                        end
+                    end)
                -> X.F(X.Y)(X.Y.M).res
          end
        In module "F":
        Modules do not match:
-         functor (Arg : $S1) (X : $S2) (Res : X.T) (Res : X.T) (Res :
-         X.T) -> ...
+         (Arg : $S1) (X : $S2) (Res : X.T) (Res : X.T) (Res : X.T) -> ...
        is not included in
-         functor (sig end) (X : $T2) X.T X.T -> ...
+         (sig end) (X : $T2) X.T X.T -> ...
        1. Module types do not match:
             $S1 = sig type wrong end
           does not include
             sig end
           The type "wrong" is required but not provided
        2. Module types $S2 and $T2 match
-       3. An extra argument is provided of module type X.T
+       3. Module types X.T and X.T match
        4. Module types X.T and X.T match
-       5. Module types X.T and X.T match
+       5. An extra argument is provided of module type X.T
 |}]
 
 
@@ -1555,8 +1531,8 @@ module Z = struct type t = Z of int end
 module Error=F(X)(struct type t = int end)(Y)(Z)
 [%%expect {|
 module F :
-  functor (X : sig type t end) (Y : sig type t = Y of X.t end)
-    (Z : sig type t = Z of X.t end) -> sig end
+  (X : sig type t end) (Y : sig type t = Y of X.t end)
+  (Z : sig type t = Z of X.t end) -> sig end
 module X : sig type t = U end
 module Y : sig type t = Y of int end
 module Z : sig type t = Z of int end
@@ -1565,37 +1541,34 @@ Line 9, characters 13-48:
                  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This application of the functor "F" is ill-typed.
        These arguments:
-         X ... Y Z
+         X $S2 Y Z
        do not match these parameters:
-         functor (X : ...) (Y : $T3) (Z : $T4) -> ...
+         (X : ...) (Y : $T2) (Z : $T3) -> ...
        1. Module X matches the expected module type
-       2. The following extra argument is provided ... : sig type t = int end
-       3. Modules do not match:
-            Y : sig type t = Y.t = Y of int end
+       2. Modules do not match:
+            $S2 : sig type t = int end
           is not included in
-            $T3 = sig type t = Y of X.t end
+            $T2 = sig type t = Y of X.t end
           Type declarations do not match:
-            type t = Y.t = Y of int
+            type t = int
           is not included in
             type t = Y of X.t
-          Constructors do not match:
-            "Y of int"
-          is not the same as:
-            "Y of X.t"
-          The type "int" is not equal to the type "X.t"
-       4. Modules do not match:
-            Z : sig type t = Z.t = Z of int end
+          The first is abstract, but the second is a variant.
+       3. Modules do not match:
+            Y : sig type t = Y.t = Y of int end
           is not included in
-            $T4 = sig type t = Z of X.t end
+            $T3 = sig type t = Z of X.t end
           Type declarations do not match:
-            type t = Z.t = Z of int
+            type t = Y/2.t = Y of int
           is not included in
             type t = Z of X.t
-          Constructors do not match:
-            "Z of int"
-          is not the same as:
-            "Z of X.t"
-          The type "int" is not equal to the type "X.t"
+          Constructors have different names, "Y" and "Z".
+       4. The following extra argument is provided
+              Z : sig type t = Z.t = Z of int end
+File "_none_", line 1:
+  Definition of module "Y"
+Line 6, characters 0-39:
+  Definition of module "Y/2"
 |}]
 
 (** Final state in the presence of extensions
@@ -1634,7 +1607,7 @@ module type Ext = sig module type T module X : T end
 module AExt : sig module type T = A module X = A end
 module FiveArgsExt :
   sig module type T = ty -> ty -> ty -> ty -> ty -> sig end module X : T end
-module Bar : functor (W : A) (X : Ext) (Y : B) (Z : Ext) -> Z.T
+module Bar : (W : A) (X : Ext) (Y : B) (Z : Ext) -> Z.T
 type fine = Bar(A)(FiveArgsExt)(B)(AExt).a
 |}]
 
@@ -1647,7 +1620,7 @@ Error: The functor application "Bar(B)(FiveArgsExt)(B)(AExt)" is ill-typed.
        These arguments:
          B FiveArgsExt B AExt
        do not match these parameters:
-         functor (W : A) (X : Ext) (Y : B) (Z : Ext) -> ...
+         (W : A) (X : Ext) (Y : B) (Z : Ext) -> ...
        1. Modules do not match:
             B : sig type b = B.b end
           is not included in
@@ -1667,16 +1640,21 @@ Error: The functor application "Bar(A)(FiveArgsExt)(TY)(TY)(TY)(TY)(TY)" is ill-
        These arguments:
          A FiveArgsExt TY TY TY TY TY
        do not match these parameters:
-         functor (W : A) (X : Ext) (Y : B) (Z : Ext) ty ty ty ty ty -> ...
+         (W : A) (X : Ext) (Y : B) (Z : Ext) -> ...
        1. Module A matches the expected module type A
-       2. An argument appears to be missing with module type Ext
-       3. An argument appears to be missing with module type B
-       4. Module FiveArgsExt matches the expected module type Ext
-       5. Module TY matches the expected module type ty
-       6. Module TY matches the expected module type ty
-       7. Module TY matches the expected module type ty
-       8. Module TY matches the expected module type ty
-       9. Module TY matches the expected module type ty
+       2. Module FiveArgsExt matches the expected module type Ext
+       3. Modules do not match:
+            TY : sig type t = TY.t end
+          is not included in
+            B
+          The type "b" is required but not provided
+       4. Modules do not match:
+            TY : sig type t = TY.t end
+          is not included in
+            Ext
+       5. The following extra argument is provided TY : sig type t = TY.t end
+       6. The following extra argument is provided TY : sig type t = TY.t end
+       7. The following extra argument is provided TY : sig type t = TY.t end
 |}]
 
 module Shape_arg = struct
@@ -1711,15 +1689,13 @@ end
 [%%expect{|
 module Shape_arg :
   sig
-    module M1 :
-      functor (Arg1 : sig end) -> sig module type S1 = sig type t end end
-    module type S2 =
-      sig module Make : functor (Arg2 : sig end) -> M1(Arg2).S1 end
+    module M1 : (Arg1 : sig end) -> sig module type S1 = sig type t end end
+    module type S2 = sig module Make : (Arg2 : sig end) -> M1(Arg2).S1 end
     module M2 : S2
     module M3 :
-      functor (Arg4 : sig end) ->
+      (Arg4 : sig end) ->
         sig module type S3 = sig type t = M2.Make(Arg4).t end end
-    module M4 : functor (Arg5 : sig end) -> M3(Arg5).S3
+    module M4 : (Arg5 : sig end) -> M3(Arg5).S3
   end
 |}]
 
@@ -1729,7 +1705,7 @@ module Shape_arg :
 module F(X:A) = struct end
 module R = F(struct end[@warning "-73"]);;
 [%%expect {|
-module F : functor (X : A) -> sig end
+module F : (X : A) -> sig end
 Line 2, characters 11-40:
 2 | module R = F(struct end[@warning "-73"]);;
                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -1741,7 +1717,7 @@ module F()(X:empty)()(Y:A) = struct end
 module R =
   F(struct end[@warning "-73"])(struct end)(struct end[@warning "-73"])();;
 [%%expect {|
-module F : functor () (X : empty) () (Y : A) -> sig end
+module F : () (X : empty) () (Y : A) -> sig end
 Line 3, characters 2-73:
 3 |   F(struct end[@warning "-73"])(struct end)(struct end[@warning "-73"])();;
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -1749,7 +1725,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          (struct end) (struct end) (struct end) ()
        do not match these parameters:
-         functor () (X : empty) () (Y : A) -> ...
+         () (X : empty) () (Y : A) -> ...
        1. Module (struct end) matches the expected module type
        2. Module (struct end) matches the expected module type empty
        3. Module (struct end) matches the expected module type
@@ -1761,7 +1737,7 @@ module F(X:empty) = struct end
 module R =
   F(struct end)();;
 [%%expect {|
-module F : functor (X : empty) -> sig end
+module F : (X : empty) -> sig end
 Line 3, characters 2-17:
 3 |   F(struct end)();;
       ^^^^^^^^^^^^^^^
@@ -1769,7 +1745,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          (struct end) ()
        do not match these parameters:
-         functor (X : empty) -> ...
+         (X : empty) -> ...
        1. Module (struct end) matches the expected module type empty
        2. The following extra argument is provided ()
 |}]
@@ -1798,8 +1774,8 @@ include
     end)
 [%%expect {|
 module F :
-  functor (A : sig type 'a t end)
-    (B : sig type 'a t val f : 'a A.t -> 'a t end) -> sig end
+  (A : sig type 'a t end) (B : sig type 'a t val f : 'a A.t -> 'a t end) ->
+    sig end
 Lines 15-21, characters 2-8:
 15 | ..F
 16 |     (struct
@@ -1812,7 +1788,7 @@ Error: This application of the functor "F" is ill-typed.
        These arguments:
          $S1 $S2
        do not match these parameters:
-         functor (A : $T1) (B : $T2) -> ...
+         (A : $T1) (B : $T2) -> ...
        1. Modules do not match:
             $S1 : sig type t = unit end
           is not included in
@@ -1839,8 +1815,8 @@ struct end
 module R = G(struct end)(struct let f (x,_) = x end)
 [%%expect {|
 module G :
-  functor (A : sig type 'a t = 'a * 'a end)
-    (B : sig val f : 'a A.t -> 'a end) -> sig end
+  (A : sig type 'a t = 'a * 'a end) (B : sig val f : 'a A.t -> 'a end) ->
+    sig end
 Line 8, characters 11-52:
 8 | module R = G(struct end)(struct let f (x,_) = x end)
                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -1848,7 +1824,7 @@ Error: This application of the functor "G" is ill-typed.
        These arguments:
          (struct end) $S2
        do not match these parameters:
-         functor (A : $T1) (B : ...) -> ...
+         (A : $T1) (B : ...) -> ...
        1. Modules do not match:
             (struct end)
           is not included in
@@ -1870,8 +1846,8 @@ module R = With_expansion(struct
     ()
 [%%expect {|
 module With_expansion :
-  functor (A : sig module type t module M : t end)
-    (B : sig module type t = A.t end) -> B.t
+  (A : sig module type t module M : t end) (B : sig module type t = A.t end)
+    -> B.t
 Lines 5-11, characters 11-6:
  5 | ...........With_expansion(struct
  6 |     module M()() = struct end
@@ -1884,7 +1860,7 @@ Error: This application of the functor "With_expansion" is ill-typed.
        These arguments:
          $S1 () () ()
        do not match these parameters:
-         functor (A : ...) (B : $T2) () () -> ...
+         (A : ...) (B : $T2) () () -> ...
        1. Module $S1 matches the expected module type
        2. The functor was expected to be applicative at this position
        3. Module () matches the expected module type
@@ -1910,7 +1886,7 @@ Error: This application of the functor "With_expansion" is ill-typed.
        These arguments:
          $S1 () ()
        do not match these parameters:
-         functor (A : ...) (B : $T2) () () -> ...
+         (A : ...) (B : $T2) () () -> ...
        1. Module $S1 matches the expected module type
        2. An argument appears to be missing with module type
               $T2 = sig module type t = A.t end
@@ -1946,8 +1922,8 @@ module _ =
     end)
 [%%expect {|
 module H :
-  functor (X : sig type 'a t type 'a s end)
-    (Y : sig val f : 'a X.s -> 'a end) -> sig end
+  (X : sig type 'a t type 'a s end) (Y : sig val f : 'a X.s -> 'a end) ->
+    sig end
 Lines 18-25, characters 2-8:
 18 | ..H
 19 |     (struct
@@ -1961,7 +1937,7 @@ Error: This application of the functor "H" is ill-typed.
        These arguments:
          $S1 $S2
        do not match these parameters:
-         functor (X : $T1) (Y : $T2) -> ...
+         (X : $T1) (Y : $T2) -> ...
        1. Modules do not match:
             $S1 : sig type t type 'a s = 'a end
           is not included in
@@ -1999,20 +1975,20 @@ Error: Signature mismatch:
        Modules do not match:
          sig
            module F :
-             functor (X : sig type 'a t = 'a list end)
-               (Y : sig type 'a t = ('a * 'a) * 'a X.t end) -> sig end
+             (X : sig type 'a t = 'a list end)
+             (Y : sig type 'a t = ('a * 'a) * 'a X.t end) -> sig end
          end
        is not included in
          sig
            module F :
-             functor (X : sig type 'a t = 'a * 'a end)
-               (Y : sig type 'a t = 'a X.t * 'a list end) -> sig end
+             (X : sig type 'a t = 'a * 'a end)
+             (Y : sig type 'a t = 'a X.t * 'a list end) -> sig end
          end
        In module "F":
        Modules do not match:
-         functor (X : $S1) (Y : $S2) -> ...
+         (X : $S1) (Y : $S2) -> ...
        is not included in
-         functor (X : $T1) (Y : $T2) -> ...
+         (X : $T1) (Y : $T2) -> ...
        1. Module types do not match:
             $S1 = sig type 'a t = 'a list end
           does not include
@@ -2053,10 +2029,22 @@ Error: The functor application "Set.Make(Set)(A)" is ill-typed.
        These arguments:
          Set A
        do not match these parameters:
-         functor (Ord : Set.OrderedType) -> ...
-       1. The following extra argument is provided Set : (module Set)
-       2. Modules do not match:
-            A : sig type a = A.a end
+         (Ord : Set.OrderedType) -> ...
+       1. Modules do not match:
+            Set : (module Set)
           is not included in
             Set.OrderedType
+          Modules do not match:
+            sig
+              module type OrderedType = Set.OrderedType
+              module type S = Set.S
+              module Make = Set.Make
+            end
+          is not included in
+            Set.OrderedType
+          The type "t" is required but not provided
+          File "set.mli", line 52, characters 4-10: Expected declaration
+          The value "compare" is required but not provided
+          File "set.mli", line 55, characters 4-31: Expected declaration
+       2. The following extra argument is provided A : sig type a = A.a end
 |}]

diff --git a/testsuite/tests/typing-modules/generative.ml b/testsuite/tests/typing-modules/generative.ml
index db26570cb8e95ce726484b7322dc639386f8fc61..fd6d9c0566e4e6d1f13a9c7cd15868afe1e803ca 100644 (file)
--- a/testsuite/tests/typing-modules/generative.ml
+++ b/testsuite/tests/typing-modules/generative.ml
@@ -13,9 +13,9 @@ module H (X : sig end) = (val v);; (* ok *)
 [%%expect{|
 module type S = sig val x : int end
 val v : (module S) = <module>
-module F : functor () -> S
-module G : functor (X : sig end) -> S
-module H : functor (X : sig end) -> S
+module F : () -> S
+module G : (X : sig end) -> S
+module H : (X : sig end) -> S
 |}];;
 
 (* With type *)
@@ -25,7 +25,7 @@ module F() = (val v);; (* ok *)
 [%%expect{|
 module type S = sig type t val x : t end
 val v : (module S) = <module>
-module F : functor () -> S
+module F : () -> S
 |}];;
 module G (X : sig end) : S = F ();; (* fail *)
 [%%expect{|
@@ -37,7 +37,7 @@ Error: This expression creates fresh types.
 |}];;
 module H() = F();; (* ok *)
 [%%expect{|
-module H : functor () -> S
+module H : () -> S
 |}];;
 
 (* Alias *)
@@ -67,29 +67,29 @@ Error: This is a generative functor. It can only be applied to "()"
 module F1 (X : sig end) = struct end;;
 module F2 : () -> sig end = F1;; (* fail *)
 [%%expect{|
-module F1 : functor (X : sig end) -> sig end
+module F1 : (X : sig end) -> sig end
 Line 2, characters 28-30:
 2 | module F2 : () -> sig end = F1;; (* fail *)
                                 ^^
 Error: Signature mismatch:
        Modules do not match:
-         functor (X : sig end) -> ...
+         (X : sig end) -> ...
        is not included in
-         functor () -> ...
+         () -> ...
        The functor was expected to be generative at this position
 |}];;
 module F3 () = struct end;;
 module F4 : functor (X : sig end) -> sig end = F3;; (* fail *)
 [%%expect{|
-module F3 : functor () -> sig end
+module F3 : () -> sig end
 Line 2, characters 47-49:
 2 | module F4 : functor (X : sig end) -> sig end = F3;; (* fail *)
                                                    ^^
 Error: Signature mismatch:
        Modules do not match:
-         functor () -> ...
+         () -> ...
        is not included in
-         functor (X : sig end) -> ...
+         (X : sig end) -> ...
        The functor was expected to be applicative at this position
 |}];;
 
@@ -101,10 +101,10 @@ module Z = functor (_: sig end) (_:sig end) (_: sig end) -> struct end;;
 module GZ : functor (X: sig end) () (Z: sig end) -> sig end
           = functor (X: sig end) () (Z: sig end) -> struct end;;
 [%%expect{|
-module X : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end
-module Y : functor (X : sig end) (Y : sig end) (Z : sig end) -> sig end
+module X : (X : sig end) (Y : sig end) (Z : sig end) -> sig end
+module Y : (X : sig end) (Y : sig end) (Z : sig end) -> sig end
 module Z : sig end -> sig end -> sig end -> sig end
-module GZ : functor (X : sig end) () (Z : sig end) -> sig end
+module GZ : (X : sig end) () (Z : sig end) -> sig end
 |}];;
 
 (* disabling warning 73 in the argument *)
@@ -112,6 +112,6 @@ module F5 () = struct end;;
 module No_warn = F5 (struct end [@warning "-73"])
 
 [%%expect{|
-module F5 : functor () -> sig end
+module F5 : () -> sig end
 module No_warn : sig end
 |}]

diff --git a/testsuite/tests/typing-modules/illegal_permutation.ml b/testsuite/tests/typing-modules/illegal_permutation.ml
index 11096ee74b31ffe564c61e92cff7a4e1b45ce196..4a225e6589804ec8ff3c77ca6cb965b10eb63d33 100644 (file)
--- a/testsuite/tests/typing-modules/illegal_permutation.ml
+++ b/testsuite/tests/typing-modules/illegal_permutation.ml
@@ -397,16 +397,16 @@ Lines 2-4, characters 0-3:
 4 | end
 Error: Signature mismatch:
        Modules do not match:
-         sig module type x = functor (X : c12) -> s end
+         sig module type x = (X : c12) -> s end
        is not included in
-         sig module type x = functor (X : s) -> s end
+         sig module type x = (X : s) -> s end
        Module type declarations do not match:
-         module type x = functor (X : c12) -> s
+         module type x = (X : c12) -> s
        does not match
-         module type x = functor (X : s) -> s
+         module type x = (X : s) -> s
        At position "module type x = <here>"
        Illegal permutation of runtime components in a module type.
-         For example, at position "functor (X : <here>) -> ...",
+         For example, at position "(X : <here>) -> ...",
          the class "two" and the value "one" are not in the same order
          in the expected and actual module types.
 |}]
@@ -422,16 +422,16 @@ Lines 2-4, characters 0-3:
 4 | end
 Error: Signature mismatch:
        Modules do not match:
-         sig module type x = functor (X : s) -> c12 end
+         sig module type x = (X : s) -> c12 end
        is not included in
-         sig module type x = functor (X : s) -> s end
+         sig module type x = (X : s) -> s end
        Module type declarations do not match:
-         module type x = functor (X : s) -> c12
+         module type x = (X : s) -> c12
        does not match
-         module type x = functor (X : s) -> s
+         module type x = (X : s) -> s
        At position "module type x = <here>"
        Illegal permutation of runtime components in a module type.
-         For example, at position "functor (X) -> <here>",
+         For example, at position "(X) -> <here>",
          the class "two" and the value "one" are not in the same order
          in the expected and actual module types.
 |}]
@@ -501,22 +501,22 @@ Error: Signature mismatch:
                    module B :
                      sig
                        module C :
-                         functor (X : sig end) (Y : sig end)
-                           (Z : sig
-                                  module D :
-                                    sig
-                                      module E :
-                                        sig
-                                          module F :
-                                            functor (X : sig end)
-                                              (Arg : sig
-                                                       val two : int
-                                                       val one : int
-                                                     end)
-                                              -> sig end
-                                        end
-                                    end
-                                end)
+                         (X : sig end) (Y : sig end)
+                         (Z : sig
+                                module D :
+                                  sig
+                                    module E :
+                                      sig
+                                        module F :
+                                          (X : sig end)
+                                          (Arg : sig
+                                                   val two : int
+                                                   val one : int
+                                                 end)
+                                            -> sig end
+                                      end
+                                  end
+                              end)
                            -> sig end
                      end
                  end
@@ -531,22 +531,22 @@ Error: Signature mismatch:
                    module B :
                      sig
                        module C :
-                         functor (X : sig end) (Y : sig end)
-                           (Z : sig
-                                  module D :
-                                    sig
-                                      module E :
-                                        sig
-                                          module F :
-                                            functor (X : sig end)
-                                              (Arg : sig
-                                                       val one : int
-                                                       val two : int
-                                                     end)
-                                              -> sig end
-                                        end
-                                    end
-                                end)
+                         (X : sig end) (Y : sig end)
+                         (Z : sig
+                                module D :
+                                  sig
+                                    module E :
+                                      sig
+                                        module F :
+                                          (X : sig end)
+                                          (Arg : sig
+                                                   val one : int
+                                                   val two : int
+                                                 end)
+                                            -> sig end
+                                      end
+                                  end
+                              end)
                            -> sig end
                      end
                  end
@@ -560,22 +560,22 @@ Error: Signature mismatch:
                  module B :
                    sig
                      module C :
-                       functor (X : sig end) (Y : sig end)
-                         (Z : sig
-                                module D :
-                                  sig
-                                    module E :
-                                      sig
-                                        module F :
-                                          functor (X : sig end)
-                                            (Arg : sig
-                                                     val two : int
-                                                     val one : int
-                                                   end)
-                                            -> sig end
-                                      end
-                                  end
-                              end)
+                       (X : sig end) (Y : sig end)
+                       (Z : sig
+                              module D :
+                                sig
+                                  module E :
+                                    sig
+                                      module F :
+                                        (X : sig end)
+                                        (Arg : sig
+                                                 val two : int
+                                                 val one : int
+                                               end)
+                                          -> sig end
+                                    end
+                                end
+                            end)
                          -> sig end
                    end
                end
@@ -588,22 +588,22 @@ Error: Signature mismatch:
                  module B :
                    sig
                      module C :
-                       functor (X : sig end) (Y : sig end)
-                         (Z : sig
-                                module D :
-                                  sig
-                                    module E :
-                                      sig
-                                        module F :
-                                          functor (X : sig end)
-                                            (Arg : sig
-                                                     val one : int
-                                                     val two : int
-                                                   end)
-                                            -> sig end
-                                      end
-                                  end
-                              end)
+                       (X : sig end) (Y : sig end)
+                       (Z : sig
+                              module D :
+                                sig
+                                  module E :
+                                    sig
+                                      module F :
+                                        (X : sig end)
+                                        (Arg : sig
+                                                 val one : int
+                                                 val two : int
+                                               end)
+                                          -> sig end
+                                    end
+                                end
+                            end)
                          -> sig end
                    end
                end

diff --git a/testsuite/tests/typing-modules/inclusion_errors.ml b/testsuite/tests/typing-modules/inclusion_errors.ml
index 987112fd5ce39e82fb7e2434ca03d515963b1017..ef84ff84e20eb576d16d5c7207fd7b96018001b3 100644 (file)
--- a/testsuite/tests/typing-modules/inclusion_errors.ml
+++ b/testsuite/tests/typing-modules/inclusion_errors.ml
@@ -510,15 +510,14 @@ module Ignore = Force(Choose)
 module type T = sig type t end
 module Int : sig type t = int end
 module type S = sig module Choice : T val r : Choice.t list ref ref end
-module Force : functor (X : functor () -> S) -> sig end
-module Choose :
-  functor () -> sig module Choice : T val r : '_weak1 list ref ref end
+module Force : (X : () -> S) -> sig end
+module Choose : () -> sig module Choice : T val r : '_weak1 list ref ref end
 Line 17, characters 16-29:
 17 | module Ignore = Force(Choose)
                      ^^^^^^^^^^^^^
 Error: Modules do not match:
-       functor () -> sig module Choice : T val r : '_weak1 list ref ref end
-     is not included in functor () -> S
+       () -> sig module Choice : T val r : '_weak1 list ref ref end
+     is not included in () -> S
      Modules do not match:
        sig module Choice : T val r : '_weak1 list ref ref end
      is not included in
@@ -558,7 +557,7 @@ Error: Signature mismatch:
          val f : (module s/2) -> unit
        The type "(module s) -> unit" is not compatible with the type
          "(module s/2) -> unit"
-       Type "(module s)" is not compatible with type "(module s/2)"
+       Modules do not match: s is not included in s/2
        Line 6, characters 4-17:
          Definition of module type "s"
        Line 2, characters 2-15:
@@ -1329,7 +1328,7 @@ Error: Signature mismatch:
 type w = private float
 type q = private (int * w)
 type u = private (int * q)
-module M : sig (* Confussing error message :( *)
+module M : sig (* Confusing error message :( *)
   type t = private (int * (int * int))
 end = struct
   type t = private u
@@ -1853,3 +1852,186 @@ Error: Signature mismatch:
        The value "x" is required but not provided
        The value "y" is required but not provided
 |}];;
+
+
+module Eq_label: sig
+  type t = int -> int
+end = struct
+  type t = x:int -> int
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = x:int -> int
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = x:int -> int end
+       is not included in
+         sig type t = int -> int end
+       Type declarations do not match:
+         type t = x:int -> int
+       is not included in
+         type t = int -> int
+       The type "x:int -> int" is not equal to the type "int -> int"
+       The first argument is labeled "x",
+       but an unlabeled argument was expected
+|}]
+
+module Eq_label2: sig
+  type t = y:int -> int
+end = struct
+  type t = x:int -> int
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = x:int -> int
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = x:int -> int end
+       is not included in
+         sig type t = y:int -> int end
+       Type declarations do not match:
+         type t = x:int -> int
+       is not included in
+         type t = y:int -> int
+       The type "x:int -> int" is not equal to the type "y:int -> int"
+       Labels "x" and "y" do not match
+|}]
+
+module Label1 : sig
+  val f: int -> unit
+end = struct
+  let f ~x = ()
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   let f ~x = ()
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig val f : x:'a -> unit end
+       is not included in
+         sig val f : int -> unit end
+       Values do not match:
+         val f : x:'a -> unit
+       is not included in
+         val f : int -> unit
+       The type "x:'a -> unit" is not compatible with the type "int -> unit"
+       The first argument is labeled "x",
+       but an unlabeled argument was expected
+|}]
+
+module Label2 : sig
+  val f: int -> unit
+end = struct
+  let f ?x = ()
+end
+[%%expect {|
+Line 4, characters 9-10:
+4 |   let f ?x = ()
+             ^
+Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
+
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   let f ?x = ()
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig val f : ?x:'a -> unit end
+       is not included in
+         sig val f : int -> unit end
+       Values do not match:
+         val f : ?x:'a -> unit
+       is not included in
+         val f : int -> unit
+       The type "?x:'a -> unit" is not compatible with the type "int -> unit"
+       The first argument is labeled "?x",
+       but an unlabeled argument was expected
+|}]
+
+
+module Label3 : sig
+  val f: x:int -> unit
+end = struct
+  let f ?x = ()
+end
+[%%expect {|
+Line 4, characters 9-10:
+4 |   let f ?x = ()
+             ^
+Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
+
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   let f ?x = ()
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig val f : ?x:'a -> unit end
+       is not included in
+         sig val f : x:int -> unit end
+       Values do not match:
+         val f : ?x:'a -> unit
+       is not included in
+         val f : x:int -> unit
+       The type "?x:'a -> unit" is not compatible with the type "x:int -> unit"
+       The label "?x" was expected to not be optional
+|}]
+
+
+module Label4 : sig
+  val f: ?x:int -> unit
+end = struct
+  let f ?y = ()
+end
+[%%expect {|
+Line 4, characters 9-10:
+4 |   let f ?y = ()
+             ^
+Warning 16 [unerasable-optional-argument]: this optional argument cannot be erased.
+
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   let f ?y = ()
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig val f : ?y:'a -> unit end
+       is not included in
+         sig val f : ?x:int -> unit end
+       Values do not match:
+         val f : ?y:'a -> unit
+       is not included in
+         val f : ?x:int -> unit
+       The type "?y:'a -> unit" is not compatible with the type "?x:int -> unit"
+       Labels "?y" and "?x" do not match
+|}]
+
+
+module Label5 : sig
+  val f: ?x:int -> unit
+end = struct
+  let f x = ()
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   let f x = ()
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig val f : 'a -> unit end
+       is not included in
+         sig val f : ?x:int -> unit end
+       Values do not match:
+         val f : 'a -> unit
+       is not included in
+         val f : ?x:int -> unit
+       The type "'a -> unit" is not compatible with the type "?x:int -> unit"
+       A label "?x" was expected
+|}]

diff --git a/testsuite/tests/typing-modules/merge_constraint.ml b/testsuite/tests/typing-modules/merge_constraint.ml
index 72b9a31041478db3559a37698ad695718dfcd8f3..74314f56c2065a0089347804393d14eec02a7713 100644 (file)
--- a/testsuite/tests/typing-modules/merge_constraint.ml
+++ b/testsuite/tests/typing-modules/merge_constraint.ml
@@ -207,7 +207,7 @@ end
 module type Iobuf_packet =
   sig
     module Make :
-      functor (Header : Header) () ->
+      (Header : Header) () ->
         sig
           module Packet_type : sig type t = Header.Packet_type.t end
           module Header :

diff --git a/testsuite/tests/typing-modules/mixmod5.ml b/testsuite/tests/typing-modules/mixmod5.ml
new file mode 100644 (file)
index 0000000..a216282
--- /dev/null
+++ b/testsuite/tests/typing-modules/mixmod5.ml
@@ -0,0 +1,334 @@
+(* TEST
+ expect;
+*)
+
+(* Basic interfaces *)
+
+(* The types involved in our recursion *)
+module type ET = sig type exp end
+(* The recursive operations on our our types *)
+module type E =
+  sig
+    include ET
+    val eval : (string * exp) list -> exp -> exp
+  end
+(* Utility functor to extract useful types in its argument *)
+module Types(X : sig type exp type a end) =
+  struct type exp = X.exp type a = X.a end
+[%%expect{|
+module type ET = sig type exp end
+module type E = sig type exp val eval : (string * exp) list -> exp -> exp end
+module Types :
+  (X : sig type exp type a end) -> sig type exp = X.exp type a = X.a end
+|}]
+
+(* Variables are common to lambda and expr *)
+
+module VarT = struct
+  type exp = [`Var of string]
+end
+module type VarS = sig
+  type exp0 = private [> VarT.exp]
+  include E with type exp = exp0
+end
+module Var(E : VarS) =
+  struct
+    type exp0 = VarT.exp
+    type exp = E.exp
+    let eval sub (`Var s as v : exp0) : exp =
+      try List.assoc s sub with Not_found -> v
+  end
+[%%expect{|
+module VarT : sig type exp = [ `Var of string ] end
+module type VarS =
+  sig
+    type exp0 = private [> VarT.exp ]
+    type exp = exp0
+    val eval : (string * exp) list -> exp -> exp
+  end
+module Var :
+  (E : VarS) ->
+    sig
+      type exp0 = VarT.exp
+      type exp = E.exp
+      val eval : (string * exp) list -> exp0 -> exp
+    end
+|}]
+
+(* The lambda language: free variables, substitutions, and evaluation *)
+
+let gensym = let n = ref 0 in fun () -> incr n; "_" ^ string_of_int !n
+
+(* Concrete definition of types in this language, with parameters to
+   allow extension *)
+module LamT = struct
+  (* Define types using only one parameter for recursion; *)
+  (* actual types are then extracted through the constraint *)
+  type 'a exp = [VarT.exp | `Abs of string * 'e | `App of 'e * 'e]
+  constraint 'a = <exp:'e;..>
+end
+(* Signature for parameters to the language construction functor *)
+module type LamS = sig
+  (* Close the recursion creating row-abstract types *)
+  type exp0 = private [> a LamT.exp]
+  and a = <exp:exp0>
+  include E with type exp = exp0
+end
+module Lam(E : LamS) =
+  struct
+    type exp0 = E.a LamT.exp
+    include Types(E)
+    module LVar = Var(E)
+
+    let eval subst : exp0 -> exp = function
+        #LVar.exp0 as v -> LVar.eval subst v
+      | `App(l1, l2) ->
+          let l2' = E.eval subst l2 in
+          let l1' = E.eval subst l1 in
+          begin match l1' with
+            `Abs (s, body) ->
+              E.eval [s,l2'] body
+          | _ ->
+              `App (l1', l2')
+          end
+      | `Abs(s, l1) ->
+          let s' = gensym () in
+          `Abs(s', E.eval ((s,`Var s')::subst) l1)
+  end
+[%%expect{|
+val gensym : unit -> string = <fun>
+module LamT :
+  sig
+    type 'a exp = [ `Abs of string * 'e | `App of 'e * 'e | `Var of string ]
+      constraint 'a = < exp : 'e; .. >
+  end
+module type LamS =
+  sig
+    type exp0 = private [> a LamT.exp ]
+    and a = < exp : exp0 >
+    type exp = exp0
+    val eval : (string * exp) list -> exp -> exp
+  end
+module Lam :
+  (E : LamS) ->
+    sig
+      type exp0 = E.a LamT.exp
+      type exp = E.exp
+      type a = E.a
+      module LVar :
+        sig
+          type exp0 = VarT.exp
+          type exp = E.exp
+          val eval : (string * exp) list -> exp0 -> exp
+        end
+      val eval : (string * E.exp) list -> exp0 -> exp
+    end
+|}]
+
+(* Signature for an actual module *)
+module type LamF = sig
+  (* Close the recursion creating concrete types *)
+  type exp0 = a LamT.exp
+  and a = <exp:exp0>
+  include E with type exp = exp0
+end
+(* The actual language is a fix-point of the construction functor *)
+module rec LamF : LamF = Lam(LamF)
+let e1 = LamF.eval [] (`App(`Abs("x",`Var"x"), `Var"y"));;
+[%%expect{|
+module type LamF =
+  sig
+    type exp0 = a LamT.exp
+    and a = < exp : exp0 >
+    type exp = exp0
+    val eval : (string * exp) list -> exp -> exp
+  end
+module rec LamF : LamF/2
+val e1 : LamF.exp = `Var "y"
+|}]
+
+(* The expr language of arithmetic expressions *)
+
+(* Define the concrete types in the language *)
+module ExprT = struct
+  type 'a exp =
+      [ `Var of string | `Num of int | `Add of 'e * 'e | `Mult of 'e * 'e]
+  constraint 'a = <exp:'e;..>
+end
+(* Exactly the same boilerplate as for Lam *)
+module type ExprS = sig
+  type exp0 = private [> a ExprT.exp]
+  and a = <exp:exp0>
+  include E with type exp = exp0
+end
+module Expr(E : ExprS) =
+  struct
+    type exp0 = E.a ExprT.exp
+    include Types(E)
+    module LVar = Var(E)
+
+    let map f : exp0 -> exp = function
+        #LVar.exp0 | `Num _ as e -> e
+      | `Add(e1, e2) -> `Add (f e1, f e2)
+      | `Mult(e1, e2) -> `Mult (f e1, f e2)
+
+    let eval subst (e : exp0) =
+      let e' = map (E.eval subst) e in
+      match e' with
+        #LVar.exp0 as v -> LVar.eval subst v
+      | `Add(e1, e2) ->
+          begin match e1, e2 with
+            `Num m, `Num n -> `Num (m+n)
+          | _ -> e'
+          end
+      | `Mult(e1, e2) ->
+          begin match e1, e2 with
+            `Num m, `Num n -> `Num (m*n)
+          | _ -> e'
+          end
+      | _ -> e'
+  end
+
+module type ExprF = sig
+  type exp0 = a ExprT.exp
+  and a = <exp:exp0>
+  include E with type exp = exp0
+end
+module rec ExprF : ExprF = Expr(ExprF)
+let e2 = ExprF.eval [] (`Add(`Mult(`Num 3, `Num 2), `Var"x"));;
+[%%expect{|
+module ExprT :
+  sig
+    type 'a exp =
+        [ `Add of 'e * 'e | `Mult of 'e * 'e | `Num of int | `Var of string ]
+      constraint 'a = < exp : 'e; .. >
+  end
+module type ExprS =
+  sig
+    type exp0 = private [> a ExprT.exp ]
+    and a = < exp : exp0 >
+    type exp = exp0
+    val eval : (string * exp) list -> exp -> exp
+  end
+module Expr :
+  (E : ExprS) ->
+    sig
+      type exp0 = E.a ExprT.exp
+      type exp = E.exp
+      type a = E.a
+      module LVar :
+        sig
+          type exp0 = VarT.exp
+          type exp = E.exp
+          val eval : (string * exp) list -> exp0 -> exp
+        end
+      val map : (E.exp0 -> E.exp0) -> exp0 -> exp
+      val eval : (string * LVar.exp) list -> exp0 -> LVar.exp
+    end
+module type ExprF =
+  sig
+    type exp0 = a ExprT.exp
+    and a = < exp : exp0 >
+    type exp = exp0
+    val eval : (string * exp) list -> exp -> exp
+  end
+module rec ExprF : ExprF/2
+val e2 : ExprF.exp = `Add (`Num 6, `Var "x")
+|}]
+
+(* The lexpr language, reunion of lambda and expr *)
+
+module LExprT = struct
+  (* We don't need to write the constraint here, as we don't use
+     'e specifically *)
+  type 'a exp = [ 'a LamT.exp | 'a ExprT.exp ]
+end
+module type LExprS = sig
+  type exp0 = private [> a LExprT.exp]
+  and a = <exp:exp0>
+  include E with type exp = exp0
+end
+module LExpr(E : LExprS) =
+  struct
+    include Types(E)
+    type exp0 = E.a LExprT.exp
+    module SLam = Lam(E)
+    module SExpr = Expr(E)
+
+    let eval subst : exp0 -> exp = function
+        #SLam.exp0 as x -> SLam.eval subst x
+      | #SExpr.exp0 as x -> SExpr.eval subst x
+  end
+
+module type LExprF = sig
+  type exp0 = a LExprT.exp
+  and a = <exp:exp0>
+  include E with type exp = exp0
+end
+module rec LExprF : LExprF = LExpr(LExprF)
+let e3 =
+  LExprF.eval [] (`Add(`App(`Abs("x",`Mult(`Var"x",`Var"x")),`Num 2), `Num 5))
+[%%expect{|
+module LExprT :
+  sig
+    type 'a exp =
+        [ `Abs of string * 'b
+        | `Add of 'b * 'b
+        | `App of 'b * 'b
+        | `Mult of 'b * 'b
+        | `Num of int
+        | `Var of string ]
+      constraint 'a = < exp : 'b; .. >
+  end
+module type LExprS =
+  sig
+    type exp0 = private [> a LExprT.exp ]
+    and a = < exp : exp0 >
+    type exp = exp0
+    val eval : (string * exp) list -> exp -> exp
+  end
+module LExpr :
+  (E : LExprS) ->
+    sig
+      type exp = E.exp
+      type a = E.a
+      type exp0 = E.a LExprT.exp
+      module SLam :
+        sig
+          type exp0 = E.a LamT.exp
+          type exp = E.exp
+          type a = E.a
+          module LVar :
+            sig
+              type exp0 = VarT.exp
+              type exp = E.exp
+              val eval : (string * exp) list -> exp0 -> exp
+            end
+          val eval : (string * E.exp) list -> exp0 -> exp
+        end
+      module SExpr :
+        sig
+          type exp0 = E.a ExprT.exp
+          type exp = E.exp
+          type a = E.a
+          module LVar :
+            sig
+              type exp0 = VarT.exp
+              type exp = E.exp
+              val eval : (string * exp) list -> exp0 -> exp
+            end
+          val map : (E.exp0 -> E.exp0) -> exp0 -> exp
+          val eval : (string * LVar.exp) list -> exp0 -> LVar.exp
+        end
+      val eval : (string * SExpr.LVar.exp) list -> exp0 -> exp
+    end
+module type LExprF =
+  sig
+    type exp0 = a LExprT.exp
+    and a = < exp : exp0 >
+    type exp = exp0
+    val eval : (string * exp) list -> exp -> exp
+  end
+module rec LExprF : LExprF/2
+val e3 : LExprF.exp = `Num 9
+|}]

diff --git a/testsuite/tests/typing-modules/module_type_substitution.ml b/testsuite/tests/typing-modules/module_type_substitution.ml
index 3eb6561cd42ccbc517acbb4be58b02abde7052ae..6f5035ba8dcac8858b148a49f3f8df92bc95fad3 100644 (file)
--- a/testsuite/tests/typing-modules/module_type_substitution.ml
+++ b/testsuite/tests/typing-modules/module_type_substitution.ml
@@ -286,14 +286,13 @@ end
 module X :
   sig
     module type s = sig type t end
-    module Y : functor (Z : s) -> sig module type Ys = sig end end
+    module Y : (Z : s) -> sig module type Ys = sig end end
   end
 module type fcm_path =
   sig
     module Z : sig type t end
     module F :
-      functor (Z : sig type t end) ->
-        sig module type t_F = sig type ff end end
+      (Z : sig type t end) -> sig module type t_F = sig type ff end end
     val x_s : (module X.s)
     val x_sY : (module X.Y(Z).Ys)
     val x_sFF : (module F(Z).t_F)
@@ -323,3 +322,48 @@ end
 [%%expect {|
 module type hidden = sig type u val x : int end
 |}]
+
+
+module type s = sig
+  module type t := sig end
+  type s := (module t)
+end
+[%%expect {|
+Line 3, characters 2-22:
+3 |   type s := (module t)
+      ^^^^^^^^^^^^^^^^^^^^
+Error: The module type "t" is not a valid type for a packed module:
+       it is defined as a local substitution (temporary name)
+       for an anonymous module type. (see manual section 12.7.3)
+|}]
+
+module type s = sig
+  module type t := sig end
+  module type r := t
+  type s := (module r)
+end
+[%%expect {|
+Line 4, characters 2-22:
+4 |   type s := (module r)
+      ^^^^^^^^^^^^^^^^^^^^
+Error: The module type "r" is not a valid type for a packed module:
+       it is defined as a local substitution (temporary name)
+       for an anonymous module type. (see manual section 12.7.3)
+|}]
+
+module type s = sig
+  module type t := sig end
+  module type r := sig
+      type s = (module t)
+  end
+  module type k = r
+end
+[%%expect {|
+Lines 3-5, characters 2-5:
+3 | ..module type r := sig
+4 |       type s = (module t)
+5 |   end
+Error: The module type "t" is not a valid type for a packed module:
+       it is defined as a local substitution (temporary name)
+       for an anonymous module type. (see manual section 12.7.3)
+|}]

diff --git a/testsuite/tests/typing-modules/nondep.ml b/testsuite/tests/typing-modules/nondep.ml
index 8b02e03e56ed54fd10c2aeacc83ab53453e101ae..5f4d7d47b1da90d69be66a7737a8275c86fac2c3 100644 (file)
--- a/testsuite/tests/typing-modules/nondep.ml
+++ b/testsuite/tests/typing-modules/nondep.ml
@@ -6,7 +6,7 @@ module F(X : sig type t end) = struct
   let f (_ : X.t) = ()
 end;;
 [%%expect{|
-module F : functor (X : sig type t end) -> sig val f : X.t -> unit end
+module F : (X : sig type t end) -> sig val f : X.t -> unit end
 |}]
 
 module M = F(struct type t = T end);;
@@ -15,7 +15,7 @@ Line 1, characters 11-35:
 1 | module M = F(struct type t = T end);;
                ^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This functor has type
-       "functor (X : sig type t end) -> sig val f : X.t -> unit end"
+       "(X : sig type t end) -> sig val f : X.t -> unit end"
        The parameter cannot be eliminated in the result type.
        Please bind the argument to a module identifier.
 |}]
@@ -31,7 +31,7 @@ module N = M (struct type 'a t = int constraint 'a = float end)
 
 [%%expect{|
 module M :
-  functor (X : sig type 'a t constraint 'a = float end) ->
+  (X : sig type 'a t constraint 'a = float end) ->
     sig module type S = sig type t = float val foo : t X.t end end
 module N : sig module type S = sig type t = float val foo : int end end
 |}]
@@ -41,7 +41,7 @@ module F (X : sig type t end) = struct type s = X.t always_int end
 module M = F (struct type t = T end)
 [%%expect{|
 type 'a always_int = int
-module F : functor (X : sig type t end) -> sig type s = X.t always_int end
+module F : (X : sig type t end) -> sig type s = X.t always_int end
 module M : sig type s = int end
 |}]
 
@@ -52,7 +52,7 @@ end
 [%%expect{|
 module M :
   sig
-    module F : functor (X : sig type t end) -> sig type t = X.t end
+    module F : (X : sig type t end) -> sig type t = X.t end
     module Not_ok : sig type t end
   end
 |}]

diff --git a/testsuite/tests/typing-modules/nondep_private_abbrev.ml b/testsuite/tests/typing-modules/nondep_private_abbrev.ml
index e5315cb3761d99e3bdd8f6f05df1df82eea0ef44..32582705efebd8c3b2a50e6c657816cb53a833f8 100644 (file)
--- a/testsuite/tests/typing-modules/nondep_private_abbrev.ml
+++ b/testsuite/tests/typing-modules/nondep_private_abbrev.ml
@@ -20,7 +20,7 @@ module G(X : sig end) : sig
   type t = F(X).t
 end = F(X);;
 [%%expect{|
-module G : functor (X : sig end) -> sig type t = F(X).t end
+module G : (X : sig end) -> sig type t = F(X).t end
 |}]
 
 module Indirect = G(struct end);;
@@ -58,14 +58,14 @@ module H(X : sig end) : sig
   type t = Pub(X).t
 end = Pub(X);;
 [%%expect{|
-module H : functor (X : sig end) -> sig type t = Pub(X).t end
+module H : (X : sig end) -> sig type t = Pub(X).t end
 |}]
 
 module I(X : sig end) : sig
   type t = Priv(X).t
 end = Priv(X);;
 [%%expect{|
-module I : functor (X : sig end) -> sig type t = Priv(X).t end
+module I : (X : sig end) -> sig type t = Priv(X).t end
 |}]
 
 module IndirectPub = H(struct end);;
@@ -144,7 +144,7 @@ module I(X : sig end) : sig
   type t = Priv(X).t
 end = Priv(X);;
 [%%expect{|
-module I : functor (X : sig end) -> sig type t = Priv(X).t end
+module I : (X : sig end) -> sig type t = Priv(X).t end
 |}]
 
 module IndirectPriv = I(struct end);;

diff --git a/testsuite/tests/typing-modules/package_constraint.ml b/testsuite/tests/typing-modules/package_constraint.ml
index 0cfb3e42021f10078bf0fcc4f8fcfd3c844fd6b9..6044ed7ff4a1af766cf03f0a9404799a8ff32a35 100644 (file)
--- a/testsuite/tests/typing-modules/package_constraint.ml
+++ b/testsuite/tests/typing-modules/package_constraint.ml
@@ -151,7 +151,7 @@ end;;
 module type S = sig type t end
 type m = (module S with type t = int)
 module F :
-  functor (X : sig val x : m end) ->
+  (X : sig val x : m end) ->
     sig module M : sig type t = int end type t = M.t [@@immediate] end
 |}];;
 

diff --git a/testsuite/tests/typing-modules/pr13099/lib1/lib.ml b/testsuite/tests/typing-modules/pr13099/lib1/lib.ml
new file mode 100644 (file)
index 0000000..35bab63
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr13099/lib1/lib.ml
@@ -0,0 +1 @@
+type t = unit

diff --git a/testsuite/tests/typing-modules/pr13099/lib1_client.ml b/testsuite/tests/typing-modules/pr13099/lib1_client.ml
new file mode 100644 (file)
index 0000000..f338891
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr13099/lib1_client.ml
@@ -0,0 +1 @@
+let f (_ : Lib.t) = ()

diff --git a/testsuite/tests/typing-modules/pr13099/lib2/lib.ml b/testsuite/tests/typing-modules/pr13099/lib2/lib.ml
new file mode 100644 (file)
index 0000000..eff2822
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr13099/lib2/lib.ml
@@ -0,0 +1 @@
+type t = bool

diff --git a/testsuite/tests/typing-modules/pr13099/lib2_client.ml b/testsuite/tests/typing-modules/pr13099/lib2_client.ml
new file mode 100644 (file)
index 0000000..27894b2
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr13099/lib2_client.ml
@@ -0,0 +1,19 @@
+let f (_ : Lib.t) = ()
+
+(* The naming of this module is important: When the error reporting
+   is running in a mode where it can load new cmis from disk, this
+   module leads the compiler to try to load a cmi file [lib1_client.cmi].
+   That's because the compiler tries to be smart about double-underscore
+   paths, rewriting [Foo__Bar] to [Foo.Bar] when these names are aliases.
+ *)
+module Lib1_client__X = struct
+  type t = A
+end
+
+module F (T : sig type t end) = struct
+  type t = Lib1_client__X.t
+
+  let f (_ : T.t) = ()
+end
+
+module _ = F (struct type t = T end)

diff --git a/testsuite/tests/typing-modules/pr13099/test.compilers.reference b/testsuite/tests/typing-modules/pr13099/test.compilers.reference
new file mode 100644 (file)
index 0000000..095c842
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr13099/test.compilers.reference
@@ -0,0 +1,8 @@
+File "lib2_client.ml", line 19, characters 11-36:
+19 | module _ = F (struct type t = T end)
+                ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This functor has type
+       "(T : sig type t end) ->
+         sig type t = Lib1_client__X.t val f : T.t -> unit end"
+       The parameter cannot be eliminated in the result type.
+       Please bind the argument to a module identifier.

diff --git a/testsuite/tests/typing-modules/pr13099/test.ml b/testsuite/tests/typing-modules/pr13099/test.ml
new file mode 100644 (file)
index 0000000..4067038
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr13099/test.ml
@@ -0,0 +1,33 @@
+(* TEST
+ subdirectories = "lib1 lib2";
+ readonly_files = "lib1_client.ml lib2_client.ml";
+ compile_only = "true";
+ setup-ocamlopt.byte-build-env;
+
+ (* Set up the Lib modules that the client modules depend on *)
+ all_modules = "lib1/lib.ml";
+ ocamlopt.byte;
+ all_modules = "lib2/lib.ml";
+ ocamlopt.byte;
+
+ (* Compile Lib1_client against Lib1 *)
+ flags = "-I lib1";
+ all_modules = "lib1_client.ml";
+ ocamlopt.byte;
+
+ (* Compile Lib2_client against Lib2 *)
+ flags = "-I lib2";
+ all_modules = "lib2_client.ml";
+ ocamlopt_byte_exit_status = "2";
+ ocamlopt.byte;
+ check-ocamlopt.byte-output;
+*)
+
+(* This test is a regression test. The bug was in the last step: the compiler crashed
+   with an exception and backtrace instead of printing a useful error message. The
+   issue was that the compiler was erroneously running in a mode where its error reporting
+   is allowed to load cmi files from disk. This mode is undesirable because it means
+   that the compiler can encounter new exceptions (e.g. that the new cmi file it loads
+   is not consistent with other cmi files) while doing error reporting for the old
+   exception.
+ *)

diff --git a/testsuite/tests/typing-modules/pr13185.ml b/testsuite/tests/typing-modules/pr13185.ml
new file mode 100644 (file)
index 0000000..a4e5257
--- /dev/null
+++ b/testsuite/tests/typing-modules/pr13185.ml
@@ -0,0 +1,15 @@
+(* TEST
+ expect;
+*)
+
+(* #13185 *)
+
+module type S1 = sig end
+module type S2 = functor (X : S1) -> sig module M = X end
+[%%expect{|
+module type S1 = sig end
+Line 2, characters 41-53:
+2 | module type S2 = functor (X : S1) -> sig module M = X end
+                                             ^^^^^^^^^^^^
+Error: Functor arguments, such as "X", cannot be aliased
+|}]

diff --git a/testsuite/tests/typing-modules/pr5911.ml b/testsuite/tests/typing-modules/pr5911.ml
index 44f141e583162a595305f8593637220872976ce6..1f2725f87bbd5776a6e714d3ce2678169328620e 100644 (file)
--- a/testsuite/tests/typing-modules/pr5911.ml
+++ b/testsuite/tests/typing-modules/pr5911.ml
@@ -12,7 +12,7 @@ module Good (X : S with type t := unit) = struct
 end;;
 [%%expect{|
 module type S = sig type t val x : t end
-module Good : functor (X : sig val x : unit end) -> sig end
+module Good : (X : sig val x : unit end) -> sig end
 |}];;
 
 module type T = sig module M : S end;;
@@ -23,5 +23,5 @@ end;;
 [%%expect{|
 module type T = sig module M : S end
 module Bad :
-  functor (X : sig module M : sig type t = unit val x : t end end) -> sig end
+  (X : sig module M : sig type t = unit val x : t end end) -> sig end
 |}];;

diff --git a/testsuite/tests/typing-modules/pr7207.ml b/testsuite/tests/typing-modules/pr7207.ml
index 3b3815cd5d30f0c268ca180a6513236e29f3ae3f..193deceb8f01d258aa8ab8eca93d02d6f4017702 100644 (file)
--- a/testsuite/tests/typing-modules/pr7207.ml
+++ b/testsuite/tests/typing-modules/pr7207.ml
@@ -5,7 +5,7 @@
 module F (X : sig end) = struct type t = int end;;
 type t = F(Does_not_exist).t;;
 [%%expect{|
-module F : functor (X : sig end) -> sig type t = int end
+module F : (X : sig end) -> sig type t = int end
 Line 2, characters 9-28:
 2 | type t = F(Does_not_exist).t;;
              ^^^^^^^^^^^^^^^^^^^

diff --git a/testsuite/tests/typing-modules/pr7348.ml b/testsuite/tests/typing-modules/pr7348.ml
index 4cd0671e3e9a01a532898095fd8b5ec572e8c722..4d95b12c7f4bd9dfaacce3844302dffa9ee35450 100644 (file)
--- a/testsuite/tests/typing-modules/pr7348.ml
+++ b/testsuite/tests/typing-modules/pr7348.ml
@@ -7,7 +7,7 @@ module F (X : sig type t = private < foo:int; ..> val x : t end) = struct
 end;;
 [%%expect{|
 module F :
-  functor (X : sig type t = private < foo : int; .. > val x : t end) ->
+  (X : sig type t = private < foo : int; .. > val x : t end) ->
     sig val x : X.t end
 |}]
 

diff --git a/testsuite/tests/typing-modules/pr7726.ml b/testsuite/tests/typing-modules/pr7726.ml
index 22fa4eff09bc0c33a5e5ad9ddfa328d276301b84..f6dde342bf400c71d2bc56ce23d92ce3ddaa34e7 100644 (file)
--- a/testsuite/tests/typing-modules/pr7726.ml
+++ b/testsuite/tests/typing-modules/pr7726.ml
@@ -9,8 +9,7 @@ end;;
 [%%expect{|
 module type T = sig type t end
 module Fix :
-  functor (F : T -> T) ->
-    sig module rec Fixed : sig type t = F(Fixed).t end end
+  (F : T -> T) -> sig module rec Fixed : sig type t = F(Fixed).t end end
 |}]
 
 module T1 = Fix(functor (X:sig type t end) -> struct type t = X.t option end);;
@@ -42,7 +41,7 @@ module F3(X:T) = struct type t = Z | S of X.t end;;
 module T3 = Fix(F3);;
 let x : T3.Fixed.t = S Z;;
 [%%expect{|
-module F3 : functor (X : T) -> sig type t = Z | S of X.t end
+module F3 : (X : T) -> sig type t = Z | S of X.t end
 module T3 : sig module rec Fixed : sig type t = F3(Fixed).t end end
 val x : T3.Fixed.t = F3(T3.Fixed).S F3(T3.Fixed).Z
 |}]
@@ -57,15 +56,15 @@ module Id (X : T) = X;;
 [%%expect{|
 module M :
   sig
-    module F : functor (X : T) -> T
+    module F : (X : T) -> T
     module rec Fixed : sig type t = F(Fixed).t end
   end
 module type S =
   sig
-    module F : functor (X : T) -> T
+    module F : (X : T) -> T
     module rec Fixed : sig type t = F(Fixed).t end
   end
-module Id : functor (X : T) -> sig type t = X.t end
+module Id : (X : T) -> sig type t = X.t end
 |}]
 
 module type Bad = S with module F = Id;;
@@ -121,8 +120,7 @@ module Foo (F : T -> T) = struct
 module M = Foo(Id);;
 M.f 5;;
 [%%expect{|
-module Foo :
-  functor (F : T -> T) -> sig val f : Fix(F).Fixed.t -> Fix(F).Fixed.t end
+module Foo : (F : T -> T) -> sig val f : Fix(F).Fixed.t -> Fix(F).Fixed.t end
 module M : sig val f : Fix(Id).Fixed.t -> Fix(Id).Fixed.t end
 Line 1:
 Error: In the signature of Fix(Id):
@@ -137,7 +135,7 @@ module F() = struct type t end
 module M = struct end;;
 type t = F(M).t;;
 [%%expect{|
-module F : functor () -> sig type t end
+module F : () -> sig type t end
 module M : sig end
 Line 3, characters 9-15:
 3 | type t = F(M).t;;
@@ -152,10 +150,10 @@ end;;
 let f (x : Fix2(Id).R(M).t) = x;;
 [%%expect{|
 module Fix2 :
-  functor (F : T -> T) ->
+  (F : T -> T) ->
     sig
       module rec Fixed : sig type t = F(Fixed).t end
-      module R : functor (X : sig end) -> sig type t = Fixed.t end
+      module R : (X : sig end) -> sig type t = Fixed.t end
     end
 Line 5, characters 11-26:
 5 | let f (x : Fix2(Id).R(M).t) = x;;

diff --git a/testsuite/tests/typing-modules/pr7787.ml b/testsuite/tests/typing-modules/pr7787.ml
index ccb32cfd8db55422b18e4e59cda5cb6609ca00c6..87f5638c639c46961be0f4706da6695eeae13bc9 100644 (file)
--- a/testsuite/tests/typing-modules/pr7787.ml
+++ b/testsuite/tests/typing-modules/pr7787.ml
@@ -20,7 +20,7 @@ module T = struct
 end;;
 [%%expect{|
 module O :
-  functor (T : sig module N : sig val foo : int -> int end end) ->
+  (T : sig module N : sig val foo : int -> int end end) ->
     sig val go : unit -> int end
 module T : sig module N : sig val foo : int -> int end end
 |}]

diff --git a/testsuite/tests/typing-modules/pr7818.ml b/testsuite/tests/typing-modules/pr7818.ml
index fa984998b4101da8e88030a254e6a7c2025cee93..1283f6572007ffde18ff709227856f036b7a0013 100644 (file)
--- a/testsuite/tests/typing-modules/pr7818.ml
+++ b/testsuite/tests/typing-modules/pr7818.ml
@@ -33,11 +33,10 @@ module Make1 (T' : Termsig.Term.S) = struct
 end;;
 [%%expect{|
 module Make1 :
-  functor
-    (T' : sig
-            module Term0 : Termsig.Term0.S
-            module T : sig module Id : sig end end
-          end)
+  (T' : sig
+          module Term0 : Termsig.Term0.S
+          module T : sig module Id : sig end end
+        end)
     -> sig module T : sig module Id : sig end val u : int end end
 |}]
 
@@ -50,11 +49,10 @@ module Make2 (T' : Termsig.Term.S) = struct
 end;;
 [%%expect{|
 module Make2 :
-  functor
-    (T' : sig
-            module Term0 : Termsig.Term0.S
-            module T : sig module Id : sig end end
-          end)
+  (T' : sig
+          module Term0 : Termsig.Term0.S
+          module T : sig module Id : sig end end
+        end)
     ->
     sig
       module T : sig module Id : sig end module Id2 = Id val u : int end
@@ -71,11 +69,10 @@ module Make3 (T' : Termsig.Term.S) = struct
 end;;
 [%%expect{|
 module Make3 :
-  functor
-    (T' : sig
-            module Term0 : Termsig.Term0.S
-            module T : sig module Id : sig end end
-          end)
+  (T' : sig
+          module Term0 : Termsig.Term0.S
+          module T : sig module Id : sig end end
+        end)
     ->
     sig
       module T : sig module Id : sig end module Id2 = Id val u : int end
@@ -96,11 +93,10 @@ end;;
 module type S =
   sig module Term0 : sig module Id : sig end end module T = Term0 end
 module Make1 :
-  functor
-    (T' : sig
-            module Term0 : sig module Id : sig end end
-            module T : sig module Id : sig end end
-          end)
+  (T' : sig
+          module Term0 : sig module Id : sig end end
+          module T : sig module Id : sig end end
+        end)
     -> sig module Id : sig end module Id2 = Id end
 |}]
 
@@ -134,11 +130,10 @@ module Make3 (T' : S) = struct
 end;;
 [%%expect{|
 module Make3 :
-  functor
-    (T' : sig
-            module Term0 : sig module Id : sig end end
-            module T : sig module Id : sig end end
-          end)
+  (T' : sig
+          module Term0 : sig module Id : sig end end
+          module T : sig module Id : sig end end
+        end)
     ->
     sig
       module T : sig module Id : sig end module Id2 = Id val u : int end
@@ -180,7 +175,7 @@ end;;
 
 module M = Make1(IS);;
 [%%expect{|
-module MkT : functor (X : sig end) -> sig type t end
+module MkT : (X : sig end) -> sig type t end
 module type S =
   sig
     module Term0 : sig module Id : sig end end
@@ -188,12 +183,11 @@ module type S =
     type t = MkT(T).t
   end
 module Make1 :
-  functor
-    (T' : sig
-            module Term0 : sig module Id : sig end end
-            module T : sig module Id : sig end end
-            type t = MkT(T).t
-          end)
+  (T' : sig
+          module Term0 : sig module Id : sig end end
+          module T : sig module Id : sig end end
+          type t = MkT(T).t
+        end)
     -> sig module Id : sig end module Id2 = Id type t = T'.t end
 module IS :
   sig
@@ -231,7 +225,7 @@ let (E eq : M1.u) = (E Eq : M1.t);;
 [%%expect{|
 type (_, _) eq = Eq : ('a, 'a) eq
 module MkT :
-  functor (X : Set.OrderedType) ->
+  (X : Set.OrderedType) ->
     sig
       type elt = X.t
       type t = Set.Make(X).t
@@ -287,13 +281,12 @@ module type S =
     type u = t = E of (MkT(Term0).t, MkT(T).t) eq
   end
 module F :
-  functor
-    (X : sig
-           module Term0 : sig type t = int val compare : t -> t -> int end
-           module T : sig type t = int val compare : t -> t -> int end
-           type t = E of (MkT(T).t, MkT(T).t) eq
-           type u = t = E of (MkT(Term0).t, MkT(T).t) eq
-         end)
+  (X : sig
+         module Term0 : sig type t = int val compare : t -> t -> int end
+         module T : sig type t = int val compare : t -> t -> int end
+         type t = E of (MkT(T).t, MkT(T).t) eq
+         type u = t = E of (MkT(Term0).t, MkT(T).t) eq
+       end)
     ->
     sig
       module Term0 : sig type t = int val compare : t -> t -> int end

diff --git a/testsuite/tests/typing-modules/pr7851.ml b/testsuite/tests/typing-modules/pr7851.ml
index c7dfb221cac2608a76e78a58373d6ecb772e0727..53172f2f80245fd3acd695466f9817ea4db7505b 100644 (file)
--- a/testsuite/tests/typing-modules/pr7851.ml
+++ b/testsuite/tests/typing-modules/pr7851.ml
@@ -15,7 +15,7 @@ module M = F(struct type t end);;
 module type S = module type of M;;
 [%%expect{|
 module F :
-  functor (X : sig type t end) ->
+  (X : sig type t end) ->
     sig type x = X.t type y = X.t type t = E of x type u = t = E of y end
 module M : sig type x type y type t = E of x type u = t = E of y end
 module type S = sig type x type y type t = E of x type u = t = E of y end
@@ -58,7 +58,7 @@ module type S = module type of M;;
 [%%expect{|
 type (_, _) eq = Eq : ('a, 'a) eq
 module F :
-  functor (X : Set.OrderedType) ->
+  (X : Set.OrderedType) ->
     sig
       type x = Set.Make(X).t
       and y = Set.Make(X).t

diff --git a/testsuite/tests/typing-modules/pr9384.ml b/testsuite/tests/typing-modules/pr9384.ml
index ba55288c80b1c55eafb9507f13a4e4d3ac89310b..20b74f6e49f4aa38c14fc012199306a46488b2aa 100644 (file)
--- a/testsuite/tests/typing-modules/pr9384.ml
+++ b/testsuite/tests/typing-modules/pr9384.ml
@@ -40,7 +40,6 @@ end;;
 [%%expect{|
 type bar = { bar : 'a. ([< `A ] as 'a) -> 'a; }
 module Bar :
-  functor
-    (X : sig type bar2 = bar = { bar : 'a. ([< `A ] as 'a) -> 'a; } end) ->
+  (X : sig type bar2 = bar = { bar : 'a. ([< `A ] as 'a) -> 'a; } end) ->
     sig val f : X.bar2 -> ([< `A ] as 'a) -> 'a end
 |}]

diff --git a/testsuite/tests/typing-modules/printing.ml b/testsuite/tests/typing-modules/printing.ml
index 1cd554ef00d15bc1c1194258a3f18728694f4acb..a7b7af1aac64ca2e258c615ea351e0842e29d3e7 100644 (file)
--- a/testsuite/tests/typing-modules/printing.ml
+++ b/testsuite/tests/typing-modules/printing.ml
@@ -17,7 +17,7 @@ module type S =
     class type c = object method m : int end
     module M : sig class type d = c end
   end
-module F : functor (X : S) -> sig class type d = X.c end
+module F : (X : S) -> sig class type d = X.c end
 |}];;
 
 (* PR#6648 *)
@@ -44,15 +44,15 @@ module type C
 module type D
 module type E
 module type F
-module Test : functor (X : (A -> (B -> C) -> D) -> E -> F) -> sig end
+module Test : (X : (A -> (B -> C) -> D) -> E -> F) -> sig end
 |}]
 
 (* test reprinting of functors *)
 module type LongFunctor1 = functor (X : A) () (_ : B) () -> C -> D -> sig end
 [%%expect {|
-module type LongFunctor1 = functor (X : A) () (_ : B) () -> C -> D -> sig end
+module type LongFunctor1 = (X : A) () (_ : B) () -> C -> D -> sig end
 |}]
 module type LongFunctor2 = functor (_ : A) () (_ : B) () -> C -> D -> sig end
 [%%expect {|
-module type LongFunctor2 = A -> functor () (_ : B) () -> C -> D -> sig end
+module type LongFunctor2 = A -> () (_ : B) () -> C -> D -> sig end
 |}]

diff --git a/testsuite/tests/typing-modules/records_errors_test.ml b/testsuite/tests/typing-modules/records_errors_test.ml
index 94edbd27289981de304b657bbf3d23922610f173..887616c3accb4be9696b8c60a9c7930fbb3e0d46 100644 (file)
--- a/testsuite/tests/typing-modules/records_errors_test.ml
+++ b/testsuite/tests/typing-modules/records_errors_test.ml
@@ -502,3 +502,63 @@ Error: Signature mismatch:
          "A : { a : 'a; b : 'b; x : 'b; } -> t"
        Field "x" has been moved from position 3 to 1.
 |}]
+
+
+module Imperfect_match: sig
+  type t = { a:unit; b:int }
+end = struct
+ type t = { a:unit; r:unit; c:int; s:unit; b:float }
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |  type t = { a:unit; r:unit; c:int; s:unit; b:float }
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           type t = { a : unit; r : unit; c : int; s : unit; b : float; }
+         end
+       is not included in
+         sig type t = { a : unit; b : int; } end
+       Type declarations do not match:
+         type t = { a : unit; r : unit; c : int; s : unit; b : float; }
+       is not included in
+         type t = { a : unit; b : int; }
+       2. An extra field, "r", is provided in the first declaration.
+       3. An extra field, "c", is provided in the first declaration.
+       4. An extra field, "s", is provided in the first declaration.
+       5. Fields do not match:
+         "b : float;"
+       is not the same as:
+         "b : int;"
+       The type "float" is not equal to the type "int"
+|}]
+
+
+module Very_imperfect_match: sig
+  type t = { a:unit; b:int }
+end = struct
+ type t = { a:unit; r:unit; c:float; s:unit; d:int }
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |  type t = { a:unit; r:unit; c:float; s:unit; d:int }
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig
+           type t = { a : unit; r : unit; c : float; s : unit; d : int; }
+         end
+       is not included in
+         sig type t = { a : unit; b : int; } end
+       Type declarations do not match:
+         type t = { a : unit; r : unit; c : float; s : unit; d : int; }
+       is not included in
+         type t = { a : unit; b : int; }
+       2. An extra field, "r", is provided in the first declaration.
+       3. An extra field, "c", is provided in the first declaration.
+       4. An extra field, "s", is provided in the first declaration.
+       5. Fields have different names, "d" and "b".
+|}]

diff --git a/testsuite/tests/typing-modules/unroll_private_abbrev.ml b/testsuite/tests/typing-modules/unroll_private_abbrev.ml
index 1249fdfd5a2a92696aa4e79076591f417841cc31..59f392aca8a600c691f4d1e32ba20f33291abb38 100644 (file)
--- a/testsuite/tests/typing-modules/unroll_private_abbrev.ml
+++ b/testsuite/tests/typing-modules/unroll_private_abbrev.ml
@@ -48,7 +48,7 @@ end = struct
 end;;
 [%%expect{|
 module F :
-  functor (X : sig end) ->
+  (X : sig end) ->
     sig
       type s = private [ `Bar of 'a | `Foo ] as 'a
       val from : M.t -> s

diff --git a/testsuite/tests/typing-modules/variants_errors_test.ml b/testsuite/tests/typing-modules/variants_errors_test.ml
index ca6e06f1329988ea449522701810c1441f4094c0..21c7150488a7e9519a88ffff131bb3edc60554d1 100644 (file)
--- a/testsuite/tests/typing-modules/variants_errors_test.ml
+++ b/testsuite/tests/typing-modules/variants_errors_test.ml
@@ -410,3 +410,58 @@ Error: Signature mismatch:
        The type "float" is not equal to the type "int"
        3->6. Constructor "C" has been moved from position 3 to 6.
 |}]
+
+
+module Imperfect_match: sig
+  type t = A | B of int
+end = struct
+ type t = A | R | C of int | S | B of float
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |  type t = A | R | C of int | S | B of float
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A | R | C of int | S | B of float end
+       is not included in
+         sig type t = A | B of int end
+       Type declarations do not match:
+         type t = A | R | C of int | S | B of float
+       is not included in
+         type t = A | B of int
+       2. An extra constructor, "R", is provided in the first declaration.
+       3. An extra constructor, "C", is provided in the first declaration.
+       4. An extra constructor, "S", is provided in the first declaration.
+       5. Constructors do not match:
+         "B of float"
+       is not the same as:
+         "B of int"
+       The type "float" is not equal to the type "int"
+|}]
+
+module Very_imperfect_match: sig
+  type t = A | B of int
+end = struct
+ type t = A | R | C of float | S | D of int
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |  type t = A | R | C of float | S | D of int
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = A | R | C of float | S | D of int end
+       is not included in
+         sig type t = A | B of int end
+       Type declarations do not match:
+         type t = A | R | C of float | S | D of int
+       is not included in
+         type t = A | B of int
+       2. An extra constructor, "R", is provided in the first declaration.
+       3. An extra constructor, "C", is provided in the first declaration.
+       4. An extra constructor, "S", is provided in the first declaration.
+       5. Constructors have different names, "D" and "B".
+|}]

diff --git a/testsuite/tests/typing-objects/Exemples.ml b/testsuite/tests/typing-objects/Exemples.ml
index 01f754e3aea1f5914195c6f1045a03e16b0316f3..b54165e8079d514c843d28e49180ff114106cd35 100644 (file)
--- a/testsuite/tests/typing-objects/Exemples.ml
+++ b/testsuite/tests/typing-objects/Exemples.ml
@@ -207,7 +207,7 @@ let c'' = new color_circle p;;
 Line 1, characters 27-28:
 1 | let c'' = new color_circle p;;
                                ^
-Error: This expression has type "point" but an expression was expected of type
+Error: The value "p" has type "point" but an expression was expected of type
          "#color_point"
        The first object type has no method "color"
 |}];;
@@ -270,8 +270,9 @@ let p = new printable_point 7;;
 [%%expect{|
 val p : printable_point = <obj>
 |}];;
-p#print;;
+p#print; Format.print_newline ();;
 [%%expect{|
+7
 - : unit = ()
 |}];;
 
@@ -309,8 +310,9 @@ let p' = new printable_color_point 7 "red";;
 [%%expect{|
 val p' : printable_color_point = <obj>
 |}];;
-p'#print;;
+p'#print; Format.print_newline ();;
 [%%expect{|
+(7, red)
 - : unit = ()
 |}];;
 
@@ -424,8 +426,9 @@ let l1 = new cons 3 (new cons 10 (new nil ()));;
 val l1 : int lst = <obj>
 |}];;
 
-l1#print Format.print_int;;
+l1#print Format.print_int; Format.print_newline ();;
 [%%expect{|
+(3::10::[])
 - : unit = ()
 |}];;
 
@@ -433,8 +436,9 @@ let l2 = l1#map (fun x -> x + 1);;
 [%%expect{|
 val l2 : int lst = <obj>
 |}];;
-l2#print Format.print_int;;
+l2#print Format.print_int; Format.print_newline ();;
 [%%expect{|
+(4::11::[])
 - : unit = ()
 |}];;
 
@@ -449,8 +453,9 @@ let p1 = (map_list (fun x -> new printable_color_point x "red") l1);;
 [%%expect{|
 val p1 : printable_color_point lst = <obj>
 |}];;
-p1#print (fun x -> x#print);;
+p1#print (fun x -> x#print); Format.print_newline () ;;
 [%%expect{|
+((3, red)::(10, red)::[])
 - : unit = ()
 |}];;
 
@@ -583,7 +588,7 @@ l#add (c3 :> int_comparable);;
 Line 1, characters 25-27:
 1 | (new sorted_list ())#add c3;;
                              ^^
-Error: This expression has type
+Error: The value "c3" has type
          "int_comparable3" =
            "< cmp : int_comparable -> int; setx : int -> unit; x : int >"
        but an expression was expected of type
@@ -616,7 +621,7 @@ val l : int_comparable list = [<obj>; <obj>; <obj>]
 |}];;
 pr l;;
 [%%expect{|
-7(7, red)(3::10::[])(4::11::[])((3, red)::(10, red)::[])5 2 4
+5 2 4
 - : unit = ()
 |}];;
 pr (sort l);;

diff --git a/testsuite/tests/typing-objects/Tests.ml b/testsuite/tests/typing-objects/Tests.ml
index 3d917da45a71f0e1cb2735d872a25f6ed38c75d1..3f9a7073c148722970fef051df3c368b5072a711 100644 (file)
--- a/testsuite/tests/typing-objects/Tests.ml
+++ b/testsuite/tests/typing-objects/Tests.ml
@@ -77,7 +77,7 @@ class ['a] c = object
 end
 [%%expect {|
 module F :
-  functor (X : sig type t end) ->
+  (X : sig type t end) ->
     sig class type ['a] c = object method m : 'a -> X.t end end
 class ['a] c : object constraint 'a = < m : 'a -> Int.t; .. > end
 |}]
@@ -416,8 +416,8 @@ class c () = object val x = - true val y = -. () end;;
 Line 1, characters 30-34:
 1 | class c () = object val x = - true val y = -. () end;;
                                   ^^^^
-Error: This expression has type "bool" but an expression was expected of type
-         "int"
+Error: The constructor "true" has type "bool"
+       but an expression was expected of type "int"
 |}];;
 
 class c () = object method f = 1 method g = 1 method h = 1 end;;
@@ -765,7 +765,7 @@ val x : '_weak2 list ref = {contents = []}
 module F(X : sig end) =
   struct type t = int let _ = (x : < m : t> list ref) end;;
 [%%expect{|
-module F : functor (X : sig end) -> sig type t = int end
+module F : (X : sig end) -> sig type t = int end
 |}];;
 x;;
 [%%expect{|
@@ -789,8 +789,7 @@ fun (x : 'a t) -> (x : 'a); ();;
 Line 1, characters 19-20:
 1 | fun (x : 'a t) -> (x : 'a); ();;
                        ^
-Error: This expression has type "'a t" but an expression was expected of type
-         "'a"
+Error: The value "x" has type "'a t" but an expression was expected of type "'a"
        The type variable "'a" occurs inside "'a t"
 |}];;
 fun ((x : 'a) | (x : 'a t)) -> ();;
@@ -1143,7 +1142,7 @@ val is_empty : <  > -> unit = <fun>
 Line 2, characters 54-58:
 2 | class c = object (self) method private foo = is_empty self end;;
                                                           ^^^^
-Error: This expression has type "< .. >" but an expression was expected of type
+Error: The value "self" has type "< .. >" but an expression was expected of type
          "<  >"
        Self type cannot be unified with a closed object type
 |}];;
@@ -1237,7 +1236,7 @@ let o = object(self) initializer has_foo self end;;
 Line 1, characters 41-45:
 1 | let o = object(self) initializer has_foo self end;;
                                              ^^^^
-Error: This expression has type "<  >" but an expression was expected of type
+Error: The value "self" has type "<  >" but an expression was expected of type
          "< foo : int; .. >"
        The first object type has no method "foo"
 |}];;

diff --git a/testsuite/tests/typing-objects/abstract_rows.ml b/testsuite/tests/typing-objects/abstract_rows.ml
index 2371ca399ab83ef73f06939958f4ea38383a2af4..9dbf2d550c4408a032d5cfdfa87663594143b656 100644 (file)
--- a/testsuite/tests/typing-objects/abstract_rows.ml
+++ b/testsuite/tests/typing-objects/abstract_rows.ml
@@ -11,7 +11,7 @@ type t = private < x : int; .. >
 Line 4, characters 24-25:
 4 | let f (x:t) (y:u) = x = y;;
                             ^
-Error: This expression has type "u" but an expression was expected of type "t"
+Error: The value "y" has type "u" but an expression was expected of type "t"
        The second object type has an abstract row, it cannot be closed
 |}]
 
@@ -21,6 +21,6 @@ let g (x:u) (y:t) = x = y;;
 Line 1, characters 24-25:
 1 | let g (x:u) (y:t) = x = y;;
                             ^
-Error: This expression has type "t" but an expression was expected of type "u"
+Error: The value "y" has type "t" but an expression was expected of type "u"
        The first object type has an abstract row, it cannot be closed
 |}]

diff --git a/testsuite/tests/typing-objects/dummy.ml b/testsuite/tests/typing-objects/dummy.ml
index d0a27f5382105d4d7345d8ab045fd568c36e0791..c8475df789dce2ff6775ed1466fdb5d62bf683a9 100644 (file)
--- a/testsuite/tests/typing-objects/dummy.ml
+++ b/testsuite/tests/typing-objects/dummy.ml
@@ -45,7 +45,7 @@ end;;
 Line 16, characters 22-26:
 16 |       inherit child1' self
                            ^^^^
-Error: This expression has type "< child : 'a; previous : 'b option; .. >"
+Error: The value "self" has type "< child : 'a; previous : 'b option; .. >"
        but an expression was expected of type "'c"
        Self type cannot escape its class
 |}]
@@ -193,7 +193,7 @@ class closes_via_inheritance param =
 Line 3, characters 36-41:
 3 |     inherit parameter_contains_self param
                                         ^^^^^
-Error: This expression has type
+Error: The value "param" has type
          "< redrawWidget : parameter_contains_self -> unit; .. >"
        but an expression was expected of type
          "< redrawWidget : < invalidate : unit; .. > -> unit; .. >"
@@ -209,7 +209,7 @@ class closes_via_application param =
 Line 3, characters 26-31:
 3 |   parameter_contains_self param;;
                               ^^^^^
-Error: This expression has type
+Error: The value "param" has type
          "< redrawWidget : parameter_contains_self -> unit; .. >"
        but an expression was expected of type
          "< redrawWidget : < invalidate : unit; .. > -> unit; .. >"
@@ -229,7 +229,7 @@ let escapes_via_inheritance param =
 Line 4, characters 38-43:
 4 |       inherit parameter_contains_self param
                                           ^^^^^
-Error: This expression has type "'a" but an expression was expected of type
+Error: The value "param" has type "'a" but an expression was expected of type
          "< redrawWidget : < invalidate : unit; .. > -> unit; .. >"
        Self type cannot escape its class
 |}]
@@ -243,7 +243,7 @@ let escapes_via_application param =
 Line 3, characters 38-43:
 3 |     class c = parameter_contains_self param
                                           ^^^^^
-Error: This expression has type "'a" but an expression was expected of type
+Error: The value "param" has type "'a" but an expression was expected of type
          "< redrawWidget : < invalidate : unit; .. > -> unit; .. >"
        Self type cannot escape its class
 |}]
@@ -256,7 +256,7 @@ let can_close_object_via_inheritance param =
 Line 3, characters 36-41:
 3 |     inherit parameter_contains_self param
                                         ^^^^^
-Error: This expression has type
+Error: The value "param" has type
          "< redrawWidget : parameter_contains_self -> unit; .. >"
        but an expression was expected of type
          "< redrawWidget : < invalidate : unit; .. > -> unit; .. >"

diff --git a/testsuite/tests/typing-objects/pr13495.ml b/testsuite/tests/typing-objects/pr13495.ml
new file mode 100644 (file)
index 0000000..79c306f
--- /dev/null
+++ b/testsuite/tests/typing-objects/pr13495.ml
@@ -0,0 +1,26 @@
+(* TEST
+ expect;
+*)
+
+class type gui =
+  object
+    method sub: 'b. 'b -> 'b
+  end
+
+class virtual local_sub =
+  object
+    method virtual sub: 'b. 'b -> 'b option
+  end
+[%%expect{|
+class type gui = object method sub : 'b -> 'b end
+class virtual local_sub : object method virtual sub : 'b -> 'b option end
+|}]
+
+class virtual ['a] compound_gui =
+  object (_: #gui)
+    constraint 'a = #local_sub
+  end
+[%%expect{|
+class virtual ['a] compound_gui :
+  object constraint 'a = #local_sub method virtual sub : 'b -> 'b end
+|}]

diff --git a/testsuite/tests/typing-objects/pr6123_bad.ml b/testsuite/tests/typing-objects/pr6123_bad.ml
index 482083d5c6c78b985ae5f44ad337f4c590c0cb58..f0fa8e00b247a03f8f5b1f57fb7495fe9180a213 100644 (file)
--- a/testsuite/tests/typing-objects/pr6123_bad.ml
+++ b/testsuite/tests/typing-objects/pr6123_bad.ml
@@ -29,7 +29,7 @@ end
 Line 15, characters 50-54:
 15 |       let args = List.map (fun ty -> new argument(self, ty)) args_ty in
                                                        ^^^^
-Error: This expression has type "< arguments : 'a; .. >"
+Error: The value "self" has type "< arguments : 'a; .. >"
        but an expression was expected of type "'b"
        Self type cannot escape its class
 |}]

diff --git a/testsuite/tests/typing-objects/self_cannot_be_closed.ml b/testsuite/tests/typing-objects/self_cannot_be_closed.ml
index 89ee4c635dce2113e7e88d8f9e7f710fcaf80338..4f8675d724cf662ad73a61bd92af863b0c128767 100644 (file)
--- a/testsuite/tests/typing-objects/self_cannot_be_closed.ml
+++ b/testsuite/tests/typing-objects/self_cannot_be_closed.ml
@@ -11,7 +11,7 @@ class c = object (self) method private foo = is_empty self end;;
 Line 1, characters 54-58:
 1 | class c = object (self) method private foo = is_empty self end;;
                                                           ^^^^
-Error: This expression has type "< .. >" but an expression was expected of type
+Error: The value "self" has type "< .. >" but an expression was expected of type
          "<  >"
        Self type cannot be unified with a closed object type
 |}]

diff --git a/testsuite/tests/typing-poly/error_messages.ml b/testsuite/tests/typing-poly/error_messages.ml
index 391fb8c3e8fee4c05b859185f3928ab945a05876..88034341c19838031f3be482811cf876a7c59ca9 100644 (file)
--- a/testsuite/tests/typing-poly/error_messages.ml
+++ b/testsuite/tests/typing-poly/error_messages.ml
@@ -36,7 +36,7 @@ let f (x:<a:'a; b:'a. 'a>) (y:<a:'a;b:'a>) = x = y
 Line 4, characters 49-50:
 4 | let f (x:<a:'a; b:'a. 'a>) (y:<a:'a;b:'a>) = x = y
                                                      ^
-Error: This expression has type "< a : 'a; b : 'a >"
+Error: The value "y" has type "< a : 'a; b : 'a >"
        but an expression was expected of type "< a : 'a; b : 'a0. 'a0 >"
        The method "b" has type "'a", but the expected method type was "'a0. 'a0"
        The universal variable "'a0" would escape its scope
@@ -58,11 +58,11 @@ Lines 5-7, characters 10-5:
 5 | ..........(object
 6 |     method f _ = 0
 7 |  end)..
-Error: This expression has type "< f : 'b -> int >"
+Error: This expression has type "< f : 'a -> int >"
        but an expression was expected of type "t_a"
-       The method "f" has type "'b -> int", but the expected method type was
-       "'a. 'a -> int"
-       The universal variable "'a" would escape its scope
+       The method "f" has type "'a -> int", but the expected method type was
+       "'a0. 'a0 -> int"
+       The universal variable "'a0" would escape its scope
 |}
 ]
 
@@ -77,11 +77,11 @@ val f : uv -> int = <fun>
 Line 4, characters 11-49:
 4 | let () = f ( `A (object method f _ = 0 end): _ v);;
                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This expression has type "'b v" but an expression was expected of type
+Error: This expression has type "'a v" but an expression was expected of type
          "uv"
-       The method "f" has type "'b -> int", but the expected method type was
-       "'a. 'a -> int"
-       The universal variable "'a" would escape its scope
+       The method "f" has type "'a -> int", but the expected method type was
+       "'a0. 'a0 -> int"
+       The universal variable "'a0" would escape its scope
 |}]
 
 (* Issue #8702: row types unified with universally quantified types*)
@@ -91,8 +91,8 @@ let f: 'a. ([> `A ] as 'a) -> [ `A ] = fun x -> x
 Line 1, characters 48-49:
 1 | let f: 'a. ([> `A ] as 'a) -> [ `A ] = fun x -> x
                                                     ^
-Error: This expression has type "[> `A ]"
-       but an expression was expected of type "[ `A ]"
+Error: The value "x" has type "[> `A ]" but an expression was expected of type
+         "[ `A ]"
        The first variant type is bound to the universal type variable "'a",
        it cannot be closed
 |}]
@@ -102,7 +102,7 @@ let f: 'a. [ `A ] -> ([> `A ] as 'a) = fun x -> x
 Line 1, characters 48-49:
 1 | let f: 'a. [ `A ] -> ([> `A ] as 'a) = fun x -> x
                                                     ^
-Error: This expression has type "[ `A ]" but an expression was expected of type
+Error: The value "x" has type "[ `A ]" but an expression was expected of type
          "[> `A ]"
        The second variant type is bound to the universal type variable "'a",
        it cannot be closed
@@ -114,7 +114,7 @@ let f: 'a. [ `A | `B ] -> ([> `A ] as 'a) = fun x -> x
 Line 1, characters 53-54:
 1 | let f: 'a. [ `A | `B ] -> ([> `A ] as 'a) = fun x -> x
                                                          ^
-Error: This expression has type "[ `A | `B ]"
+Error: The value "x" has type "[ `A | `B ]"
        but an expression was expected of type "[> `A ]"
        The second variant type is bound to the universal type variable "'a",
        it cannot be closed
@@ -126,7 +126,7 @@ let f: 'a. [> `A | `B | `C ] -> ([> `A ] as 'a) = fun x -> x
 Line 1, characters 59-60:
 1 | let f: 'a. [> `A | `B | `C ] -> ([> `A ] as 'a) = fun x -> x
                                                                ^
-Error: This expression has type "[> `A | `B | `C ]"
+Error: The value "x" has type "[> `A | `B | `C ]"
        but an expression was expected of type "[> `A ]"
        The second variant type is bound to the universal type variable "'a",
        it may not allow the tag(s) "`B", "`C"

diff --git a/testsuite/tests/typing-poly/poly.ml b/testsuite/tests/typing-poly/poly.ml
index 47b02db0f5338837a92e43db5bfe1b47d517d80c..b494eae3f1d4ac2b041ceb081b2aac695208e0e9 100644 (file)
--- a/testsuite/tests/typing-poly/poly.ml
+++ b/testsuite/tests/typing-poly/poly.ml
@@ -466,7 +466,7 @@ val f : < m : 'a. 'a -> 'a > -> < m : 'b. 'b -> 'b > = <fun>
 Line 9, characters 41-42:
 9 | let f (x : < m : 'a. 'a -> 'a list >) = (x : < m : 'b. 'b -> 'c >)
                                              ^
-Error: This expression has type "< m : 'b. 'b -> 'b list >"
+Error: The value "x" has type "< m : 'b. 'b -> 'b list >"
        but an expression was expected of type "< m : 'b. 'b -> 'c >"
        The method "m" has type "'b. 'b -> 'b list",
        but the expected method type was "'b. 'b -> 'c"
@@ -590,8 +590,8 @@ val f2 : id -> int * bool = <fun>
 Line 5, characters 24-28:
 5 | let f3 f = f#id 1, f#id true
                             ^^^^
-Error: This expression has type "bool" but an expression was expected of type
-         "int"
+Error: The constructor "true" has type "bool"
+       but an expression was expected of type "int"
 |}];;
 
 class c = object
@@ -640,7 +640,7 @@ let f x = (x : < m : 'a. 'b * (< n : 'a; .. > as 'a) > as 'b)#m;;
 fun (x : < p : 'a. < m : 'a ; n : 'b ; .. > as 'a > as 'b) -> x#p;;
 fun (x : <m:'a. 'a * <p:'b. 'b * 'c * 'd> as 'c> as 'd) -> x#m;;
 (* printer is wrong on the next (no official syntax) *)
-fun (x : <m:'a.<p:'a;..> >) -> x#m;;
+fun (x : <m:'a. <p:'a;..> >) -> x#m;;
 [%%expect {|
 - : (< m : 'a. 'a * 'b > as 'b) -> 'c * 'b = <fun>
 - : (< m : 'a. 'b * 'a list > as 'b) -> 'b * 'c list = <fun>
@@ -838,7 +838,7 @@ Error: This field value has type "'b option ref" which is less general than
 
 (* Type variable scope *)
 
-let f (x: <m:'a.<p: 'a * 'b> as 'b>) (y : 'b) = ();;
+let f (x: <m:'a. <p: 'a * 'b> as 'b>) (y : 'b) = ();;
 let f (x: <m:'a. 'a * (<p:int*'b> as 'b)>) (y : 'b) = ();;
 [%%expect {|
 val f : < m : 'a. < p : 'a * 'c > as 'c > -> 'b -> unit = <fun>
@@ -1134,7 +1134,7 @@ let f (x : foo') = (x : bar');;
 Line 2, characters 3-4:
 2 |   (x : <m : 'a. 'a * (<m:'b. 'a * <m:'c. 'c * 'bar> > as 'bar) >);;
        ^
-Error: This expression has type "< m : 'a. 'a * < m : 'a * 'b > > as 'b"
+Error: The value "x" has type "< m : 'a. 'a * < m : 'a * 'b > > as 'b"
        but an expression was expected of type
          "< m : 'a. 'a * (< m : 'a * < m : 'c. 'c * 'd > > as 'd) >"
        The method "m" has type
@@ -1157,8 +1157,7 @@ let f x =
 Line 2, characters 3-4:
 2 |   (x : <m : 'b. 'b * ('b * <m : 'c. 'c * ('c * 'bar)>)> as 'bar);;
        ^
-Error: This expression has type
-         "< m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >"
+Error: The value "x" has type "< m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >"
        but an expression was expected of type
          "< m : 'b. 'b * ('b * < m : 'c. 'c * ('c * 'd) >) > as 'd"
        The method "m" has type "'c. 'c * ('b * < m : 'c. 'e >) as 'e",
@@ -1399,7 +1398,7 @@ type t = { f : 'a. [< `Int of int ] as 'a; }
 Line 4, characters 16-22:
 4 | let zero = {f = `Int 0} ;; (* fails *)
                     ^^^^^^
-Error: This expression has type "[> `Int of int ]"
+Error: This constructor has type "[> `Int of int ]"
        but an expression was expected of type "[< `Int of int ]"
        The second variant type is bound to the universal type variable "'a",
        it may not allow the tag(s) "`Int"
@@ -1572,8 +1571,7 @@ let f (n : < m : 'a 'r. [< `Foo of 'a & int | `Bar] as 'r >) =
 Line 2, characters 3-4:
 2 |   (n : < m : 'b 'r. [< `Foo of int & 'b | `Bar] as 'r >)
        ^
-Error: This expression has type
-         "< m : 'a 'c. [< `Bar | `Foo of 'a & int ] as 'c >"
+Error: The value "n" has type "< m : 'a 'c. [< `Bar | `Foo of 'a & int ] as 'c >"
        but an expression was expected of type
          "< m : 'b 'd. [< `Bar | `Foo of int & 'b ] as 'd >"
        Types for tag "`Foo" are incompatible
@@ -1595,7 +1593,8 @@ let f b (x: 'x) =
 Line 3, characters 19-22:
 3 |   if b then x else M.A;;
                        ^^^
-Error: This expression has type "M.t" but an expression was expected of type "'x"
+Error: The constructor "M.A" has type "M.t"
+       but an expression was expected of type "'x"
        The type constructor "M.t" would escape its scope
 |}];;
 
@@ -1793,7 +1792,7 @@ end
 [%%expect{|
 external reraise : exn -> 'a = "%reraise"
 module M :
-  functor () ->
+  () ->
     sig
       val f : 'a -> 'a
       val g : 'a -> 'a
@@ -1891,7 +1890,7 @@ let f (x : u) = (x : v)
 Line 1, characters 17-18:
 1 | let f (x : u) = (x : v)
                      ^
-Error: This expression has type "u" but an expression was expected of type "v"
+Error: The value "x" has type "u" but an expression was expected of type "v"
        The method "m" has type "'a s list * < m : 'b > as 'b",
        but the expected method type was "'a. 'a s list * < m : 'a. 'c > as 'c"
        The universal variable "'a" would escape its scope

diff --git a/testsuite/tests/typing-poly/pr9603.ml b/testsuite/tests/typing-poly/pr9603.ml
index b6a17fe8e5e61c7b2edc8dd5179b525a4cabe37a..9ccc6c6611608fab522cc9c1f71291e0eba31286 100644 (file)
--- a/testsuite/tests/typing-poly/pr9603.ml
+++ b/testsuite/tests/typing-poly/pr9603.ml
@@ -25,7 +25,7 @@ let foo :
 Line 4, characters 11-12:
 4 | = fun x -> x
                ^
-Error: This expression has type
+Error: The value "x" has type
          "< m : 'left 'right. < left : 'left; right : 'right > pair >"
        but an expression was expected of type
          "< m : 'left 'right. < left : 'left; right : 'right > pair >"

diff --git a/testsuite/tests/typing-polyvariants-bugs-2/pr3918c.compilers.reference b/testsuite/tests/typing-polyvariants-bugs-2/pr3918c.compilers.reference
index c638fffe15e08a3893a9ff45374606e3aee11744..3b63f5a314b5988798cda9653171582227c3e6da 100644 (file)
--- a/testsuite/tests/typing-polyvariants-bugs-2/pr3918c.compilers.reference
+++ b/testsuite/tests/typing-polyvariants-bugs-2/pr3918c.compilers.reference
@@ -1,5 +1,5 @@
 File "pr3918c.ml", line 24, characters 11-12:
 24 | let f x = (x : 'a vlist :> 'b vlist)
                 ^
-Error: This expression has type "'b Pr3918b.vlist"
+Error: The value "x" has type "'b Pr3918b.vlist"
        but an expression was expected of type "'b Pr3918b.vlist"

diff --git a/testsuite/tests/typing-polyvariants-bugs/pr10664.reference~ b/testsuite/tests/typing-polyvariants-bugs/pr10664.reference~
deleted file mode 100644 (file)
index f70f10e..0000000
--- a/testsuite/tests/typing-polyvariants-bugs/pr10664.reference~
+++ /dev/null
@@ -1 +0,0 @@
-A

diff --git a/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.compilers.reference b/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.compilers.reference
index 66584fdb1b61fe55ddd5f1928dbd8a34409d2863..7e1b450947fc1547630caa5b158d6085692f5e43 100644 (file)
--- a/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.compilers.reference
+++ b/testsuite/tests/typing-polyvariants-bugs/pr5057a_bad.compilers.reference
@@ -1,6 +1,6 @@
 File "pr5057a_bad.ml", line 14, characters 48-49:
 14 |   let _ = match flag with `A -> T.mem | `B r -> r in
                                                      ^
-Error: This expression has type "'a" but an expression was expected of type
+Error: The value "r" has type "'a" but an expression was expected of type
          "int -> T.t -> bool"
        The type constructor "T.t" would escape its scope

diff --git a/testsuite/tests/typing-private/private.compilers.principal.reference b/testsuite/tests/typing-private/private.compilers.principal.reference
index a43f5ff29ccf9081ad3050d111fd720795d80871..480e6f929c6ce52028da2a9337d52baada7db198 100644 (file)
--- a/testsuite/tests/typing-private/private.compilers.principal.reference
+++ b/testsuite/tests/typing-private/private.compilers.principal.reference
@@ -3,7 +3,7 @@ module F0 : sig type t = private int end
 Line 2, characters 20-21:
 2 | let f (x : F0.t) = (x : Foobar.t);; (* fails *)
                         ^
-Error: This expression has type "F0.t" but an expression was expected of type
+Error: The value "x" has type "F0.t" but an expression was expected of type
          "Foobar.t"
 module F = Foobar
 val f : F.t -> Foobar.t = <fun>
@@ -13,8 +13,7 @@ module M2 : sig type t = private < m : int; .. > end
 Line 1, characters 19-20:
 1 | fun (x : M1.t) -> (x : M2.t);; (* fails *)
                        ^
-Error: This expression has type "M1.t" but an expression was expected of type
-         "M2.t"
+Error: The value "x" has type "M1.t" but an expression was expected of type "M2.t"
 module M3 : sig type t = private M1.t end
 - : M3.t -> M1.t = <fun>
 - : M3.t -> M.t = <fun>

diff --git a/testsuite/tests/typing-private/private.compilers.reference b/testsuite/tests/typing-private/private.compilers.reference
index 2dcc8fbfdfda0f202394bc1870a2a93e7533aefb..8ef031abd5dd7e756aef0e21df8ab5fec927f667 100644 (file)
--- a/testsuite/tests/typing-private/private.compilers.reference
+++ b/testsuite/tests/typing-private/private.compilers.reference
@@ -3,7 +3,7 @@ module F0 : sig type t = private int end
 Line 2, characters 20-21:
 2 | let f (x : F0.t) = (x : Foobar.t);; (* fails *)
                         ^
-Error: This expression has type "F0.t" but an expression was expected of type
+Error: The value "x" has type "F0.t" but an expression was expected of type
          "Foobar.t"
 module F = Foobar
 val f : F.t -> Foobar.t = <fun>
@@ -13,8 +13,7 @@ module M2 : sig type t = private < m : int; .. > end
 Line 1, characters 19-20:
 1 | fun (x : M1.t) -> (x : M2.t);; (* fails *)
                        ^
-Error: This expression has type "M1.t" but an expression was expected of type
-         "M2.t"
+Error: The value "x" has type "M1.t" but an expression was expected of type "M2.t"
 module M3 : sig type t = private M1.t end
 - : M3.t -> M1.t = <fun>
 - : M3.t -> M.t = <fun>

diff --git a/testsuite/tests/typing-recmod/inconsistent_types.ml b/testsuite/tests/typing-recmod/inconsistent_types.ml
new file mode 100644 (file)
index 0000000..05ddbc2
--- /dev/null
+++ b/testsuite/tests/typing-recmod/inconsistent_types.ml
@@ -0,0 +1,92 @@
+(* TEST
+  expect;
+*)
+
+(* PR#12959  *)
+
+module rec A: sig
+  val x: 'a B.t -> unit
+end = struct
+  let x _ = ()
+end
+and B: sig
+  type +'a t
+end = struct
+  type t
+end
+  [%%expect {|
+Line 1:
+Error: Modules do not match:
+         sig type t end
+       is not included in
+         sig type +'a t end
+       Type declarations do not match: type t is not included in type +'a t
+       They have different arities.
+|}]
+
+module rec A: sig
+  val x: 'a F(B).t -> unit
+end = struct
+  let x _ = ()
+end
+and B: sig
+  type 'a t
+  type x
+end = struct
+  type 'a t
+  type x
+end
+and F: functor(X:sig type x end) -> sig type 'a t = 'a * X.x end =
+  functor(X:sig type y end) -> struct type t = int end
+  [%%expect {|
+Line 1:
+Error: Modules do not match:
+         (X : $S1) -> ...
+       is not included in
+         (X : $T1) -> ...
+       Module types do not match:
+         $S1 = sig type y end
+       does not include
+         $T1 = sig type x end
+       The type "y" is required but not provided
+|}]
+
+module type S = sig type 'a t end
+module rec A: sig val x: 'a B.t -> unit end = struct
+        let x _ = ()
+end
+and B : S = struct type t end;;
+[%%expect {|
+module type S = sig type 'a t end
+Line 1:
+Error: Modules do not match: sig type t end is not included in S
+       Type declarations do not match: type t is not included in type 'a t
+       They have different arities.
+|}]
+
+module rec A: sig val x: 'a B.M.t -> unit end = struct
+  let x _ = ()
+end
+and B: sig module type S=sig type 'a t end module M:S end = struct
+        module type S = sig type t end
+        module M: S = struct type t end
+       end
+[%%expect {|
+Line 1:
+Error: Modules do not match:
+         sig module type S = sig type t end module M : S end
+       is not included in
+         sig module type S = sig type 'a t end module M : S end
+       Module type declarations do not match:
+         module type S = sig type t end
+       does not match
+         module type S = sig type 'a t end
+       At position "module type S = <here>"
+       Module types do not match:
+         sig type t end
+       is not equal to
+         sig type 'a t end
+       At position "module type S = <here>"
+       Type declarations do not match: type t is not included in type 'a t
+       They have different arities.
+|}]

diff --git a/testsuite/tests/typing-recmod/pr13514.ml b/testsuite/tests/typing-recmod/pr13514.ml
new file mode 100644 (file)
index 0000000..a15a8b7
--- /dev/null
+++ b/testsuite/tests/typing-recmod/pr13514.ml
@@ -0,0 +1,17 @@
+(* TEST
+ expect;
+*)
+
+module rec M: sig
+  type t = { r: 'a 'b. 'a -> ' b -> 'a }
+  val f: t -> t
+end = struct
+  type t = { r : 'a. 'a -> 'a -> 'a }
+  let f: t -> M.t = fun x -> x
+end
+[%%expect{|
+Line 6, characters 29-30:
+6 |   let f: t -> M.t = fun x -> x
+                                 ^
+Error: The value "x" has type "t" but an expression was expected of type "M.t"
+|}]

diff --git a/testsuite/tests/typing-rectypes-bugs/pr6174_bad.compilers.reference b/testsuite/tests/typing-rectypes-bugs/pr6174_bad.compilers.reference
index c0bb0ed732f1809a1b710f5e39d3e7acc019847a..c19e73d9f1006c503bc60063fd10e60075574df7 100644 (file)
--- a/testsuite/tests/typing-rectypes-bugs/pr6174_bad.compilers.reference
+++ b/testsuite/tests/typing-rectypes-bugs/pr6174_bad.compilers.reference
@@ -1,5 +1,5 @@
 File "pr6174_bad.ml", line 11, characters 24-25:
 11 |  fun C k -> k (fun x -> x);;
                              ^
-Error: This expression has type "$0" but an expression was expected of type
+Error: The value "x" has type "$0" but an expression was expected of type
          "$1" = "($2 -> $1) -> $1"

diff --git a/testsuite/tests/typing-short-paths/errors.ml b/testsuite/tests/typing-short-paths/errors.ml
index a9929570bfacdc312aafde586eab2232b6139669..eda19331097488467bf162b21c8c07fbce4d1339 100644 (file)
--- a/testsuite/tests/typing-short-paths/errors.ml
+++ b/testsuite/tests/typing-short-paths/errors.ml
@@ -51,7 +51,7 @@ type pair = Pair : 'a ty * 'a -> pair
 Line 9, characters 22-23:
 9 |   | Pair (Char, x) -> x + 1
                           ^
-Error: This expression has type "$a" but an expression was expected of type "int"
+Error: The value "x" has type "$a" but an expression was expected of type "int"
        Hint: "$a" is an existential type bound by the constructor "Pair".
 |}]
 
@@ -68,7 +68,7 @@ type pair = Pair : 'a ty * 'a -> pair
 Line 7, characters 35-36:
 7 |   | Pair (Char, x) -> if true then x else 'd'
                                        ^
-Error: This expression has type "$a" but an expression was expected of type "'a"
+Error: The value "x" has type "$a" but an expression was expected of type "'a"
        This instance of "$a" is ambiguous:
        it would escape the scope of its equation
        Hint: "$a" is an existential type bound by the constructor "Pair".

diff --git a/testsuite/tests/typing-short-paths/short-paths.compilers.reference b/testsuite/tests/typing-short-paths/short-paths.compilers.reference
index 004d82bb7e6c409340f1b6ece8335a413b0b3c8b..bdcc25422c406382d744581e9de265002740b48a 100644 (file)
--- a/testsuite/tests/typing-short-paths/short-paths.compilers.reference
+++ b/testsuite/tests/typing-short-paths/short-paths.compilers.reference
@@ -69,7 +69,7 @@ val x : 'a Int.Map.t = <abstr>
 Line 1, characters 8-9:
 1 | let y = x + x ;;
             ^
-Error: This expression has type "'a Int.Map.t"
+Error: The value "x" has type "'a Int.Map.t"
        but an expression was expected of type "int"
 module M : sig type t = A type u = C end
 module N : sig type t = B end

diff --git a/testsuite/tests/typing-signatures/els.ocaml.reference b/testsuite/tests/typing-signatures/els.ocaml.reference
index 6ed436effe0242094f872c104a6bb8004a0b9964..480755ece657fc418c11c64a0f75ec6201e5cdcd 100644 (file)
--- a/testsuite/tests/typing-signatures/els.ocaml.reference
+++ b/testsuite/tests/typing-signatures/els.ocaml.reference
@@ -62,16 +62,15 @@ module type COMBINED_TYPE =
   end
 module type BARECODE = sig type state val init : state -> unit end
 module USERCODE :
-  functor (X : TYPEVIEW) ->
+  (X : TYPEVIEW) ->
     sig
       module type F =
-        functor
-          (C : sig
-                 module V :
-                   sig type value type state type usert = X.combined end
-                 val setglobal : V.state -> string -> V.value -> unit
-                 val apply : V.value -> V.state -> V.value list -> V.value
-               end)
+        (C : sig
+               module V :
+                 sig type value type state type usert = X.combined end
+               val setglobal : V.state -> string -> V.value -> unit
+               val apply : V.value -> V.state -> V.value list -> V.value
+             end)
           -> sig val init : C.V.state -> unit end
     end
 module Weapon : sig type t end
@@ -85,14 +84,13 @@ module type WEAPON_LIB =
         val to_string : t -> string
       end
     module Make :
-      functor
-        (TV : sig
-                type combined
-                type t = t/2
-                val map : (combined -> t) * (t -> combined)
-              end)
+      (TV : sig
+              type combined
+              type t = t/2
+              val map : (combined -> t) * (t -> combined)
+            end)
         -> USERCODE(TV).F
   end
-module type X = functor (X : CORE) -> BARECODE
+module type X = (X : CORE) -> BARECODE
 module type X = CORE -> BARECODE
 

diff --git a/testsuite/tests/typing-signatures/nondep_regression.ml b/testsuite/tests/typing-signatures/nondep_regression.ml
index 2e446b44e50e47cadc8cb6b8f8df2fda1dea66b1..77f13ee6379e2d42b4b68488c961aae26f8bb0fe 100644 (file)
--- a/testsuite/tests/typing-signatures/nondep_regression.ml
+++ b/testsuite/tests/typing-signatures/nondep_regression.ml
@@ -12,6 +12,6 @@ module H = Make (struct type t end)
 
 [%%expect{|
 type 'a seq = 'a list
-module Make : functor (A : sig type t end) -> sig type t = A.t seq end
+module Make : (A : sig type t end) -> sig type t = A.t seq end
 module H : sig type t end
 |}]

diff --git a/testsuite/tests/typing-sigsubst/sig_local_aliases.ml b/testsuite/tests/typing-sigsubst/sig_local_aliases.ml
index 283d85fa3ddb2e8edbe87827a961fcf82d31f00d..5b101a91a72ef5417f7aac22b8692b6c1d4bdf3e 100644 (file)
--- a/testsuite/tests/typing-sigsubst/sig_local_aliases.ml
+++ b/testsuite/tests/typing-sigsubst/sig_local_aliases.ml
@@ -30,7 +30,7 @@ module F(X : sig type t end) = struct
   type t = X.t
 end;;
 [%%expect{|
-module F : functor (X : sig type t end) -> sig type t = X.t end
+module F : (X : sig type t end) -> sig type t = X.t end
 |}]
 
 module type Accepted2 = sig

diff --git a/testsuite/tests/typing-sigsubst/sig_local_aliases_syntax_errors.compilers.reference b/testsuite/tests/typing-sigsubst/sig_local_aliases_syntax_errors.compilers.reference
index b2469b7c697b8d885f138d972958a3d59cdfbe4b..0a9fac908ac52279d1404fa074aba298afc27296 100644 (file)
--- a/testsuite/tests/typing-sigsubst/sig_local_aliases_syntax_errors.compilers.reference
+++ b/testsuite/tests/typing-sigsubst/sig_local_aliases_syntax_errors.compilers.reference
@@ -10,7 +10,7 @@ Line 3, characters 15-18:
 3 |   module M1 := sig end
                    ^^^
 Error: Syntax error: "module path" expected.
-module F : functor (X : sig type t end) -> sig type t = X.t end
+module F : (X : sig type t end) -> sig type t = X.t end
 Line 3, characters 17-23:
 3 |   module M2 := F(struct type t = int end)
                      ^^^^^^

diff --git a/testsuite/tests/typing-sigsubst/sigsubst.ml b/testsuite/tests/typing-sigsubst/sigsubst.ml
index 50a18aac13f4916e1649ffb0e3f71d4d32d289d5..cbb908ad95b256c997c9b7eae3c26becd49993bc 100644 (file)
--- a/testsuite/tests/typing-sigsubst/sigsubst.ml
+++ b/testsuite/tests/typing-sigsubst/sigsubst.ml
@@ -182,7 +182,7 @@ module type S =
     module M1 : sig type t = int end
     module M2 = M1
     module M3 : sig module M = M2 end
-    module F : functor (X : sig module M = M1 end) -> sig type t end
+    module F : (X : sig module M = M1 end) -> sig type t end
     type t = F(M3).t
   end
 |}]
@@ -205,15 +205,10 @@ end = struct
 end;;
 [%%expect {|
 type (_, _) eq = Refl : ('a, 'a) eq
-Line 11, characters 18-58:
-11 |   module type T = S with type N.t = M.t with module N := N;;
-                       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: In this "with" constraint, the new definition of "N"
-       does not match its original definition in the constrained signature:
-       Modules do not match:
-         sig type t = M.t val compare : t -> t -> int end
-       is not included in
-         (module M)
+Line 8, characters 4-16:
+8 |     module N = M
+        ^^^^^^^^^^^^
+Error: Functor arguments, such as "M", cannot be aliased
 |}]
 
 (* Checking that the uses of M.t are rewritten regardless of how they
@@ -281,7 +276,7 @@ end
 module type S =
   sig
     module M : sig type t type u end
-    module F : functor (X : sig type t end) -> sig type t end
+    module F : (X : sig type t end) -> sig type t end
     type t = F(M).t
   end
 |}]
@@ -308,7 +303,7 @@ module type S2 = S with type M.u := float
 module type S2 =
   sig
     module M : sig type t end
-    module F : functor (X : sig type t end) -> sig type t end
+    module F : (X : sig type t end) -> sig type t end
     type t = F(M).t
   end
 |}]
@@ -322,7 +317,7 @@ module type S3 = sig
   and M2 : sig type t end
 end with type M2.t := int
 [%%expect {|
-module Id : functor (X : sig type t end) -> sig type t = X.t end
+module Id : (X : sig type t end) -> sig type t = X.t end
 Lines 2-5, characters 17-25:
 2 | .................sig
 3 |   module rec M : sig type t = A of Id(M2).t end

diff --git a/testsuite/tests/typing-typeparam/newtype.ocaml.reference b/testsuite/tests/typing-typeparam/newtype.ocaml.reference
index 735babb2287661cfcd60df916bed7719c8ba6967..1ec602828833dd2da1d76abf17bdfcbf8b55a627 100644 (file)
--- a/testsuite/tests/typing-typeparam/newtype.ocaml.reference
+++ b/testsuite/tests/typing-typeparam/newtype.ocaml.reference
@@ -8,11 +8,11 @@ abc,xyz
 Line 2, characters 32-33:
 2 | let f x (type a) (y : a) = (x = y);; (* Fails *)
                                     ^
-Error: This expression has type "a" but an expression was expected of type "'a"
+Error: The value "y" has type "a" but an expression was expected of type "'a"
        The type constructor "a" would escape its scope
 Line 3, characters 53-54:
 3 |   method n : 'a -> 'a = fun (type g) (x:g) -> self#m x
                                                          ^
-Error: This expression has type "g" but an expression was expected of type "'a"
+Error: The value "x" has type "g" but an expression was expected of type "'a"
        The type constructor "g" would escape its scope
 

diff --git a/testsuite/tests/typing-unicode/genfiles.ml b/testsuite/tests/typing-unicode/genfiles.ml
new file mode 100644 (file)
index 0000000..1475ed4
--- /dev/null
+++ b/testsuite/tests/typing-unicode/genfiles.ml
@@ -0,0 +1,8 @@
+let create_file name contents =
+  Out_channel.with_open_text name (fun oc -> output_string oc contents)
+
+let _ =
+  (* File name in NFC *)
+  create_file "été.ml" "let x = 1\n";
+  (* File name in NFD *)
+  create_file "\u{0063}\u{0327}a.ml"  "let x = 2\n"

diff --git a/testsuite/tests/typing-unicode/test.ml b/testsuite/tests/typing-unicode/test.ml
new file mode 100644 (file)
index 0000000..b9c8cb0
--- /dev/null
+++ b/testsuite/tests/typing-unicode/test.ml
@@ -0,0 +1,18 @@
+(* TEST
+readonly_files = "genfiles.ml";
+setup-ocamlc.byte-build-env;
+all_modules = "genfiles.ml";
+program = "./genfiles.byte.exe";
+ocamlc.byte;
+run;
+all_modules = "été.ml ça.ml test.ml";
+program = "./main.byte.exe";
+ocamlc.byte;
+run;
+*)
+
+let _ =
+  (* Source is NFC *)
+  assert (Été.x + Ça.x = 3);
+  (* Source is NFD *)
+  assert (Été.x + Ça.x = 3)

diff --git a/testsuite/tests/typing-warnings/pr7085.ml b/testsuite/tests/typing-warnings/pr7085.ml
index 642fba03f929379e30e77084246ad703b6f9a64d..f0b478934d4650fe78e29aa2702d38b98532b8ac 100644 (file)
--- a/testsuite/tests/typing-warnings/pr7085.ml
+++ b/testsuite/tests/typing-warnings/pr7085.ml
@@ -35,7 +35,7 @@ Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some (Is Eq)
 
-module Make : functor (M : T) -> sig val f : unit -> int end
+module Make : (M : T) -> sig val f : unit -> int end
 |}]
 
 module Make2 (M : T) = struct

diff --git a/testsuite/tests/typing-warnings/pr9244.ml b/testsuite/tests/typing-warnings/pr9244.ml
index 282123cd337ea36c3b04481e429fb6e7d60209d9..e2161dad17aede45ec4dcee41e2530058cbb5e93 100644 (file)
--- a/testsuite/tests/typing-warnings/pr9244.ml
+++ b/testsuite/tests/typing-warnings/pr9244.ml
@@ -54,5 +54,5 @@ Line 1, characters 25-31:
                              ^^^^^^
 Warning 34 [unused-type-declaration]: unused type s.
 
-module F : functor (X : sig type t type s end) -> sig type t = X.t end
+module F : (X : sig type t type s end) -> sig type t = X.t end
 |}]

diff --git a/testsuite/tests/typing-warnings/records.ml b/testsuite/tests/typing-warnings/records.ml
index ca8256c3a44bb8d3a7e237a0ac0bdeed0cea2e9d..34bcb288cee86ab240f9ee2c7701700f5cbc278b 100644 (file)
--- a/testsuite/tests/typing-warnings/records.ml
+++ b/testsuite/tests/typing-warnings/records.ml
@@ -106,8 +106,7 @@ The first one was selected. Please disambiguate if this is wrong.
 Line 3, characters 35-36:
 3 |   let f r = match r with {x; y} -> y + y
                                        ^
-Error: This expression has type "bool" but an expression was expected of type
-         "int"
+Error: The value "y" has type "bool" but an expression was expected of type "int"
 |}]
 
 module F2 = struct

diff --git a/testsuite/tests/typing-warnings/unused_functor_parameter.ml b/testsuite/tests/typing-warnings/unused_functor_parameter.ml
index a0905b0db80a492a43b5131a6049a07d0fded679..ed9ac6936c5481f321197c071f3c3e573801b6a9 100644 (file)
--- a/testsuite/tests/typing-warnings/unused_functor_parameter.ml
+++ b/testsuite/tests/typing-warnings/unused_functor_parameter.ml
@@ -10,7 +10,7 @@ Line 1, characters 11-17:
                ^^^^^^
 Warning 60 [unused-module]: unused module Unused.
 
-module Foo : functor (Unused : sig end) -> sig end
+module Foo : (Unused : sig end) -> sig end
 |}]
 
 module type S = functor (Unused : sig end) -> sig end;;
@@ -20,7 +20,7 @@ Line 1, characters 25-31:
                              ^^^^^^
 Warning 67 [unused-functor-parameter]: unused functor parameter Unused.
 
-module type S = functor (Unused : sig end) -> sig end
+module type S = (Unused : sig end) -> sig end
 |}]
 
 module type S = sig
@@ -32,5 +32,5 @@ Line 2, characters 12-18:
                 ^^^^^^
 Warning 67 [unused-functor-parameter]: unused functor parameter Unused.
 
-module type S = sig module M : functor (Unused : sig end) -> sig end end
+module type S = sig module M : (Unused : sig end) -> sig end end
 |}]

diff --git a/testsuite/tests/typing-warnings/unused_types.ml b/testsuite/tests/typing-warnings/unused_types.ml
index c000d27bb1c12c4a016ed4163fff258794b0fd33..08cada670da9cebd03a4ff33a38de19deeb70c65 100644 (file)
--- a/testsuite/tests/typing-warnings/unused_types.ml
+++ b/testsuite/tests/typing-warnings/unused_types.ml
@@ -530,3 +530,144 @@ Warning 69 [unused-field]: unused record field b.
 
 module Unused_field_disable_one_warning : sig end
 |}]
+
+(* Locally abstract types *)
+
+let u (type unused) = ()
+[%%expect {|
+Line 1, characters 12-18:
+1 | let u (type unused) = ()
+                ^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused.
+
+val u : unit = ()
+|}]
+
+let u = fun (type unused) -> ()
+[%%expect {|
+Line 1, characters 18-24:
+1 | let u = fun (type unused) -> ()
+                      ^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused.
+
+val u : unit = ()
+|}]
+
+let u : type unused. unit = ()
+[%%expect {|
+Line 1, characters 13-19:
+1 | let u : type unused. unit = ()
+                 ^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused.
+
+val u : unit = ()
+|}]
+
+let f (type unused) x = x
+[%%expect {|
+Line 1, characters 12-18:
+1 | let f (type unused) x = x
+                ^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused.
+
+val f : 'a -> 'a = <fun>
+|}]
+
+let f = fun (type unused) x -> x
+[%%expect {|
+Line 1, characters 18-24:
+1 | let f = fun (type unused) x -> x
+                      ^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused.
+
+val f : 'a -> 'a = <fun>
+|}]
+
+let f = fun (type unused) x -> x
+[%%expect {|
+Line 1, characters 18-24:
+1 | let f = fun (type unused) x -> x
+                      ^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused.
+
+val f : 'a -> 'a = <fun>
+|}]
+
+let f (type used unused) (x : used) = x
+[%%expect {|
+Line 1, characters 17-23:
+1 | let f (type used unused) (x : used) = x
+                     ^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused.
+
+val f : 'used -> 'used = <fun>
+|}]
+
+let f = fun (type used unused) (x : used) -> x
+
+[%%expect{|
+Line 1, characters 23-29:
+1 | let f = fun (type used unused) (x : used) -> x
+                           ^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused.
+
+val f : 'used -> 'used = <fun>
+|}]
+
+let f : type used unused. used -> used = fun x -> x
+
+[%%expect{|
+Line 1, characters 18-24:
+1 | let f : type used unused. used -> used = fun x -> x
+                      ^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused.
+
+val f : 'used -> 'used = <fun>
+|}]
+
+let f (type unused1 unused2) x = x
+[%%expect {|
+Line 1, characters 12-19:
+1 | let f (type unused1 unused2) x = x
+                ^^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused1.
+
+Line 1, characters 20-27:
+1 | let f (type unused1 unused2) x = x
+                        ^^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused2.
+
+val f : 'a -> 'a = <fun>
+|}]
+
+let f = fun (type unused1 unused2) x -> x
+
+[%%expect{|
+Line 1, characters 18-25:
+1 | let f = fun (type unused1 unused2) x -> x
+                      ^^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused1.
+
+Line 1, characters 26-33:
+1 | let f = fun (type unused1 unused2) x -> x
+                              ^^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused2.
+
+val f : 'a -> 'a = <fun>
+|}]
+
+let f : type unused1 unused2. 'a -> 'a = fun x -> x
+
+[%%expect{|
+Line 1, characters 13-20:
+1 | let f : type unused1 unused2. 'a -> 'a = fun x -> x
+                 ^^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused1.
+
+Line 1, characters 21-28:
+1 | let f : type unused1 unused2. 'a -> 'a = fun x -> x
+                         ^^^^^^^
+Warning 34 [unused-type-declaration]: unused type unused2.
+
+val f : 'a -> 'a = <fun>
+|}]

diff --git a/testsuite/tests/uid-deps/link_intf_impl.ml b/testsuite/tests/uid-deps/link_intf_impl.ml
new file mode 100644 (file)
index 0000000..6d2090a
--- /dev/null
+++ b/testsuite/tests/uid-deps/link_intf_impl.ml
@@ -0,0 +1,59 @@
+(* TEST
+
+flags = "-bin-annot -bin-annot-occurrences";
+compile_only = "true";
+setup-ocamlc.byte-build-env;
+all_modules = "link_intf_impl.mli link_intf_impl.ml";
+ocamlc.byte;
+check-ocamlc.byte-output;
+
+program = "-quiet -uid-deps link_intf_impl.cmt";
+output = "out_objinfo";
+ocamlobjinfo;
+
+check-program-output;
+*)
+
+let x (* 0 *) = 42
+
+type t (* 1 *) = int
+
+module type S (* 3 *) = sig
+  val y (* 2 *) : t
+end
+
+module M (* 5 *) : S = struct
+  let y (* 4 *) = 36
+end
+
+module N (* 8 *) : sig
+  val y (* 7 *) : int
+end = struct
+  let y (* 6 *) = 2
+end
+
+let _ = (module N : S)
+
+module P (* 10 *)= struct
+  let y (* 9 *) = 12
+end
+
+module F (* 12 *) (X (* 11 *) : S) = X
+
+module G (* 13 *) = F(P)
+
+module type Initial (* 16 *) = sig
+  module type Nested (* 15 *) = sig
+    type t (* 14 *)
+  end
+end
+
+module MF (* 23 *) : sig
+   module F (* 22 *) (X (* 21 *) : sig val x (* 20 *) : int end) : sig end
+end = struct
+  module F (* 19 *) (X (* 18 *) : sig val x (* 17 *) : int end) = struct end
+end
+
+module FMT (* 27 *) (X (* 26 *) : sig
+  module type MT (* 25 *) = sig val x (* 24 *) : int end
+end) : sig end = struct end

diff --git a/testsuite/tests/uid-deps/link_intf_impl.mli b/testsuite/tests/uid-deps/link_intf_impl.mli
new file mode 100644 (file)
index 0000000..fa4403c
--- /dev/null
+++ b/testsuite/tests/uid-deps/link_intf_impl.mli
@@ -0,0 +1,19 @@
+type t (* 0 *)
+
+val x (* 1 *) : t
+
+module type S (* 3 *) = sig
+  val y (* 2 *) : t
+end
+
+module M (* 4 *) : S
+
+module type Initial (* 7 *) = sig
+  module type Nested (* 6 *) = sig
+    type t (* 5 *)
+  end
+end
+
+module FMT (* 11 *) (X (* 10 *) : sig
+  module type MT (* 9 *) = sig val x (* 8 *) : int end
+end) : sig end

diff --git a/testsuite/tests/uid-deps/link_intf_impl.reference b/testsuite/tests/uid-deps/link_intf_impl.reference
new file mode 100644 (file)
index 0000000..3e6ffa2
--- /dev/null
+++ b/testsuite/tests/uid-deps/link_intf_impl.reference
@@ -0,0 +1,19 @@
+
+Uid dependencies:
+Link_intf_impl.0 <- [intf]Link_intf_impl.1
+Link_intf_impl.1 <- [intf]Link_intf_impl.0
+Link_intf_impl.2 <-> [intf]Link_intf_impl.2
+Link_intf_impl.3 <- [intf]Link_intf_impl.3
+Link_intf_impl.4 <- Link_intf_impl.2
+Link_intf_impl.5 <- [intf]Link_intf_impl.4
+Link_intf_impl.6 <- Link_intf_impl.7
+Link_intf_impl.7 <-> Link_intf_impl.2
+Link_intf_impl.9 <-> Link_intf_impl.2
+Link_intf_impl.14 <-> [intf]Link_intf_impl.5
+Link_intf_impl.15 <-> [intf]Link_intf_impl.6
+Link_intf_impl.16 <- [intf]Link_intf_impl.7
+Link_intf_impl.17 <-> Link_intf_impl.20
+Link_intf_impl.19 <- Link_intf_impl.22
+Link_intf_impl.24 <-> [intf]Link_intf_impl.8
+Link_intf_impl.25 <-> [intf]Link_intf_impl.9
+Link_intf_impl.27 <- [intf]Link_intf_impl.11

diff --git a/testsuite/tests/uids/intf_uids.ml b/testsuite/tests/uids/intf_uids.ml
new file mode 100644 (file)
index 0000000..af315bf
--- /dev/null
+++ b/testsuite/tests/uids/intf_uids.ml
@@ -0,0 +1,3 @@
+type u (* has uid Intf_uids.0 *)
+
+type t (* has uid Intf_uids.1 *)

diff --git a/testsuite/tests/uids/intf_uids.mli b/testsuite/tests/uids/intf_uids.mli
new file mode 100644 (file)
index 0000000..21cfde3
--- /dev/null
+++ b/testsuite/tests/uids/intf_uids.mli
@@ -0,0 +1,3 @@
+type t (* has uid [intf]Intf_uids.0 *)
+
+type u (* has uid [intf]Intf_uids.1 *)

diff --git a/testsuite/tests/uids/intf_uids_test.ml b/testsuite/tests/uids/intf_uids_test.ml
new file mode 100644 (file)
index 0000000..a5faf8e
--- /dev/null
+++ b/testsuite/tests/uids/intf_uids_test.ml
@@ -0,0 +1,22 @@
+(* TEST
+
+flags = "-bin-annot";
+compile_only = "true";
+modules = "intf_uids.ml";
+
+setup-ocamlc.byte-build-env;
+all_modules = "intf_uids.mli intf_uids.ml";
+ocamlc.byte;
+check-ocamlc.byte-output;
+
+program = "-quiet -decls intf_uids.cmti intf_uids.cmt";
+output = "out_objinfo";
+ocamlobjinfo;
+
+check-program-output;
+*)
+
+(* This test illustrates the fact that uids are tagged to indicate if they
+  originate from an interface of an implementation: it prints the delcarations
+  written in the cmt file for the interface and then for the implementation.
+  These should not overlap.  *)

diff --git a/testsuite/tests/uids/intf_uids_test.reference b/testsuite/tests/uids/intf_uids_test.reference
new file mode 100644 (file)
index 0000000..a196321
--- /dev/null
+++ b/testsuite/tests/uids/intf_uids_test.reference
@@ -0,0 +1,8 @@
+
+Uid of decls:
+[intf]Intf_uids.0: t (File "intf_uids.mli", line 1, characters 5-6)
+[intf]Intf_uids.1: u (File "intf_uids.mli", line 3, characters 5-6)
+
+Uid of decls:
+Intf_uids.0: u (File "intf_uids.ml", line 1, characters 5-6)
+Intf_uids.1: t (File "intf_uids.ml", line 3, characters 5-6)

diff --git a/testsuite/tests/unicode/néant.ml b/testsuite/tests/unicode/néant.ml
new file mode 100644 (file)
index 0000000..e17ba6d
--- /dev/null
+++ b/testsuite/tests/unicode/néant.ml
@@ -0,0 +1 @@
+let x = ()

diff --git a/testsuite/tests/unicode/見.ml b/testsuite/tests/unicode/見.ml
new file mode 100644 (file)
index 0000000..7edfb9d
--- /dev/null
+++ b/testsuite/tests/unicode/見.ml
@@ -0,0 +1,6 @@
+(* TEST
+   modules="néant.ml";
+   flags = "-w -bad-module-name";
+*)
+
+let nothing = Néant.x

diff --git a/testsuite/tests/unwind/stack_walker.c b/testsuite/tests/unwind/stack_walker.c
index c0323ddb43b2b37e6ab0f63eb311858c3067308a..acf36eb87953493f0173f910d6206bb081616439 100644 (file)
--- a/testsuite/tests/unwind/stack_walker.c
+++ b/testsuite/tests/unwind/stack_walker.c
@@ -63,6 +63,10 @@ value ml_perform_stack_walk(value unused) {
     return Val_unit;
 }
 
-value ml_do_no_alloc(value unused) {
-    return ml_perform_stack_walk(unused);
+value ml_do_no_alloc(value unit) {
+    (void) ml_perform_stack_walk(unit);
+    /* In order to prevent the C compiler from performing tail-call
+       optimization, we return the argument rather than the constant
+       Val_unit. */
+    return unit;
 }

diff --git a/testsuite/tests/utils/edit_distance.ml b/testsuite/tests/utils/edit_distance.ml
index cf2e60cba9143229cbe6ca7d1a2125a1eda7b422..dd36db85ab4f2fe82f5b67c178fa8254e50f0cba 100644 (file)
--- a/testsuite/tests/utils/edit_distance.ml
+++ b/testsuite/tests/utils/edit_distance.ml
@@ -1,7 +1,7 @@
 (* TEST
  include config;
  include testing;
- binary_modules = "config build_path_prefix_map misc identifiable numbers";
+ binary_modules = "config build_path_prefix_map format_doc misc identifiable numbers";
  bytecode;
 *)
 

diff --git a/testsuite/tests/utils/find_first_mono.ml b/testsuite/tests/utils/find_first_mono.ml
index 1970eb9e400d2e811cb6b4952971af036cbcc906..c00aba288b242d556b032b556dca1f932ab0c8b0 100644 (file)
--- a/testsuite/tests/utils/find_first_mono.ml
+++ b/testsuite/tests/utils/find_first_mono.ml
@@ -1,7 +1,7 @@
 (* TEST
  include config;
  include testing;
- binary_modules = "config build_path_prefix_map misc";
+ binary_modules = "config build_path_prefix_map format_doc misc";
  bytecode;
 *)
 

diff --git a/testsuite/tests/utils/magic_number.ml b/testsuite/tests/utils/magic_number.ml
index 42664ec80b556240f1999da1d4fcbbdf82fd72fb..bfbf2206730deadffb8103c7ef031d7cc556921f 100644 (file)
--- a/testsuite/tests/utils/magic_number.ml
+++ b/testsuite/tests/utils/magic_number.ml
@@ -1,6 +1,6 @@
 (* TEST
  include config;
- binary_modules = "config build_path_prefix_map misc";
+ binary_modules = "config build_path_prefix_map format_doc misc";
  bytecode;
 *)
 

diff --git a/testsuite/tests/utils/overflow_detection.ml b/testsuite/tests/utils/overflow_detection.ml
index c9d984b55bf442013f53661aaab703d3bfa81867..67f1bbf82ef270a0e73e2c0ae206312ce7b3024b 100644 (file)
--- a/testsuite/tests/utils/overflow_detection.ml
+++ b/testsuite/tests/utils/overflow_detection.ml
@@ -1,7 +1,7 @@
 (* TEST
  include config;
  include testing;
- binary_modules = "config build_path_prefix_map misc identifiable numbers";
+ binary_modules = "config build_path_prefix_map format_doc misc identifiable numbers";
  bytecode;
 *)
 

diff --git a/testsuite/tests/utils/test_strongly_connected_components.ml b/testsuite/tests/utils/test_strongly_connected_components.ml
index 32cdc6bb250cf4879efbf517a61cf88bc1d1ae36..d1a91968833a0438a7c0225baa060f51d7f86efa 100644 (file)
--- a/testsuite/tests/utils/test_strongly_connected_components.ml
+++ b/testsuite/tests/utils/test_strongly_connected_components.ml
@@ -1,7 +1,7 @@
 (* TEST
  include config;
  include testing;
- binary_modules = "config build_path_prefix_map misc identifiable numbers strongly_connected_components";
+ binary_modules = "config build_path_prefix_map format_doc misc identifiable numbers strongly_connected_components";
  bytecode;
 *)
 

diff --git a/testsuite/tests/warnings/w53.compilers.reference b/testsuite/tests/warnings/w53.compilers.reference
index fec632304b2dc6b7a1bcfeceb3a4fbda811e1b73..ac91465c18cdb602ad5b454408975aa2f03798ec 100644 (file)
--- a/testsuite/tests/warnings/w53.compilers.reference
+++ b/testsuite/tests/warnings/w53.compilers.reference
@@ -23,882 +23,887 @@ File "w53.ml", line 26, characters 6-11:
            ^^^^^
 Warning 53 [misplaced-attribute]: the "alert" attribute cannot appear in this context
 
-File "w53.ml", line 31, characters 24-29:
-31 |   type t1 = { x : int [@boxed] } (* rejected *)
+File "w53.ml", line 34, characters 24-29:
+34 |   type t1 = { x : int [@boxed] } (* rejected *)
                              ^^^^^
 Warning 53 [misplaced-attribute]: the "boxed" attribute cannot appear in this context
 
-File "w53.ml", line 33, characters 16-21:
-33 |   val x : int [@boxed] (* rejected *)
+File "w53.ml", line 36, characters 16-21:
+36 |   val x : int [@boxed] (* rejected *)
                      ^^^^^
 Warning 53 [misplaced-attribute]: the "boxed" attribute cannot appear in this context
 
-File "w53.ml", line 37, characters 17-22:
-37 |   val y : int [@@boxed] (* rejected *)
+File "w53.ml", line 40, characters 17-22:
+40 |   val y : int [@@boxed] (* rejected *)
                       ^^^^^
 Warning 53 [misplaced-attribute]: the "boxed" attribute cannot appear in this context
 
-File "w53.ml", line 39, characters 6-11:
-39 |   [@@@boxed] (* rejected *)
+File "w53.ml", line 42, characters 6-11:
+42 |   [@@@boxed] (* rejected *)
            ^^^^^
 Warning 53 [misplaced-attribute]: the "boxed" attribute cannot appear in this context
 
-File "w53.ml", line 43, characters 16-21:
-43 |   let x = (42 [@boxed], 84) (* rejected *)
+File "w53.ml", line 46, characters 16-21:
+46 |   let x = (42 [@boxed], 84) (* rejected *)
                      ^^^^^
 Warning 53 [misplaced-attribute]: the "boxed" attribute cannot appear in this context
 
-File "w53.ml", line 45, characters 16-21:
-45 |   let y = 10 [@@boxed] (* rejected *)
+File "w53.ml", line 48, characters 16-21:
+48 |   let y = 10 [@@boxed] (* rejected *)
                      ^^^^^
 Warning 53 [misplaced-attribute]: the "boxed" attribute cannot appear in this context
 
-File "w53.ml", line 47, characters 6-11:
-47 |   [@@@boxed] (* rejected *)
+File "w53.ml", line 50, characters 6-11:
+50 |   [@@@boxed] (* rejected *)
            ^^^^^
 Warning 53 [misplaced-attribute]: the "boxed" attribute cannot appear in this context
 
-File "w53.ml", line 54, characters 16-26:
-54 |   val x : int [@deprecated] (* rejected *)
+File "w53.ml", line 57, characters 16-26:
+57 |   val x : int [@deprecated] (* rejected *)
                      ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated" attribute cannot appear in this context
 
-File "w53.ml", line 60, characters 6-16:
-60 |   [@@@deprecated] (* rejected *)
+File "w53.ml", line 63, characters 6-16:
+63 |   [@@@deprecated] (* rejected *)
            ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated" attribute cannot appear in this context
 
-File "w53.ml", line 64, characters 14-24:
-64 |   let x = 5 [@deprecated] (* rejected *)
+File "w53.ml", line 67, characters 14-24:
+67 |   let x = 5 [@deprecated] (* rejected *)
                    ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated" attribute cannot appear in this context
 
-File "w53.ml", line 66, characters 16-26:
-66 |   let y = 10 [@@deprecated] (* rejected *)
+File "w53.ml", line 69, characters 16-26:
+69 |   let y = 10 [@@deprecated] (* rejected *)
                      ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated" attribute cannot appear in this context
 
-File "w53.ml", line 68, characters 6-16:
-68 |   [@@@deprecated] (* rejected *)
+File "w53.ml", line 71, characters 6-16:
+71 |   [@@@deprecated] (* rejected *)
            ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated" attribute cannot appear in this context
 
-File "w53.ml", line 73, characters 19-37:
-73 |   type t1 = Foo1 [@deprecated_mutable] (* rejected *)
+File "w53.ml", line 76, characters 19-37:
+76 |   type t1 = Foo1 [@deprecated_mutable] (* rejected *)
                         ^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated_mutable" attribute cannot appear in this context
 
-File "w53.ml", line 75, characters 16-34:
-75 |   val x : int [@deprecated_mutable] (* rejected *)
+File "w53.ml", line 78, characters 16-34:
+78 |   val x : int [@deprecated_mutable] (* rejected *)
                      ^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated_mutable" attribute cannot appear in this context
 
-File "w53.ml", line 77, characters 21-39:
-77 |   type 'a t2 = 'a [@@deprecated_mutable] (* rejected *)
+File "w53.ml", line 80, characters 21-39:
+80 |   type 'a t2 = 'a [@@deprecated_mutable] (* rejected *)
                           ^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated_mutable" attribute cannot appear in this context
 
-File "w53.ml", line 81, characters 24-42:
-81 |   type t4 = { x : int [@deprecated_mutable] } (* rejected *)
+File "w53.ml", line 84, characters 24-42:
+84 |   type t4 = { x : int [@deprecated_mutable] } (* rejected *)
                              ^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated_mutable" attribute cannot appear in this context
 
-File "w53.ml", line 83, characters 17-35:
-83 |   val y : int [@@deprecated_mutable] (* rejected *)
+File "w53.ml", line 86, characters 17-35:
+86 |   val y : int [@@deprecated_mutable] (* rejected *)
                       ^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated_mutable" attribute cannot appear in this context
 
-File "w53.ml", line 85, characters 6-24:
-85 |   [@@@deprecated_mutable] (* rejected *)
+File "w53.ml", line 88, characters 6-24:
+88 |   [@@@deprecated_mutable] (* rejected *)
            ^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated_mutable" attribute cannot appear in this context
 
-File "w53.ml", line 89, characters 14-32:
-89 |   let x = 5 [@deprecated_mutable] (* rejected *)
+File "w53.ml", line 92, characters 14-32:
+92 |   let x = 5 [@deprecated_mutable] (* rejected *)
                    ^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated_mutable" attribute cannot appear in this context
 
-File "w53.ml", line 91, characters 16-34:
-91 |   let y = 10 [@@deprecated_mutable] (* rejected *)
+File "w53.ml", line 94, characters 16-34:
+94 |   let y = 10 [@@deprecated_mutable] (* rejected *)
                      ^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated_mutable" attribute cannot appear in this context
 
-File "w53.ml", line 93, characters 6-24:
-93 |   [@@@deprecated_mutable] (* rejected *)
+File "w53.ml", line 96, characters 6-24:
+96 |   [@@@deprecated_mutable] (* rejected *)
            ^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "deprecated_mutable" attribute cannot appear in this context
 
-File "w53.ml", line 98, characters 32-46:
-98 |   type t1 = Foo1 of int * int [@explicit_arity] (* rejected *)
-                                     ^^^^^^^^^^^^^^
+File "w53.ml", line 101, characters 32-46:
+101 |   type t1 = Foo1 of int * int [@explicit_arity] (* rejected *)
+                                      ^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "explicit_arity" attribute cannot appear in this context
 
-File "w53.ml", line 100, characters 16-30:
-100 |   val x : int [@explicit_arity] (* rejected *)
+File "w53.ml", line 103, characters 16-30:
+103 |   val x : int [@explicit_arity] (* rejected *)
                       ^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "explicit_arity" attribute cannot appear in this context
 
-File "w53.ml", line 102, characters 20-34:
-102 |   type 'a t2 = 'a [@explicit_arity] (* rejected *)
+File "w53.ml", line 105, characters 20-34:
+105 |   type 'a t2 = 'a [@explicit_arity] (* rejected *)
                           ^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "explicit_arity" attribute cannot appear in this context
 
-File "w53.ml", line 104, characters 17-31:
-104 |   val y : int [@@explicit_arity] (* rejected *)
+File "w53.ml", line 107, characters 17-31:
+107 |   val y : int [@@explicit_arity] (* rejected *)
                        ^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "explicit_arity" attribute cannot appear in this context
 
-File "w53.ml", line 106, characters 6-20:
-106 |   [@@@explicit_arity] (* rejected *)
+File "w53.ml", line 109, characters 6-20:
+109 |   [@@@explicit_arity] (* rejected *)
             ^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "explicit_arity" attribute cannot appear in this context
 
-File "w53.ml", line 110, characters 14-28:
-110 |   let x = 5 [@explicit_arity] (* rejected *)
+File "w53.ml", line 113, characters 14-28:
+113 |   let x = 5 [@explicit_arity] (* rejected *)
                     ^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "explicit_arity" attribute cannot appear in this context
 
-File "w53.ml", line 112, characters 16-30:
-112 |   let y = 10 [@@explicit_arity] (* rejected *)
+File "w53.ml", line 115, characters 16-30:
+115 |   let y = 10 [@@explicit_arity] (* rejected *)
                       ^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "explicit_arity" attribute cannot appear in this context
 
-File "w53.ml", line 114, characters 6-20:
-114 |   [@@@explicit_arity] (* rejected *)
+File "w53.ml", line 117, characters 6-20:
+117 |   [@@@explicit_arity] (* rejected *)
             ^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "explicit_arity" attribute cannot appear in this context
 
-File "w53.ml", line 119, characters 18-27:
-119 |   type t1 = int [@immediate] (* rejected *)
+File "w53.ml", line 122, characters 18-27:
+122 |   type t1 = int [@immediate] (* rejected *)
                         ^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context
 
-File "w53.ml", line 123, characters 16-25:
-123 |   val x : int [@immediate] (* rejected *)
+File "w53.ml", line 126, characters 16-25:
+126 |   val x : int [@immediate] (* rejected *)
                       ^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context
 
-File "w53.ml", line 124, characters 17-26:
-124 |   val x : int [@@immediate] (* rejected *)
+File "w53.ml", line 127, characters 17-26:
+127 |   val x : int [@@immediate] (* rejected *)
                        ^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context
 
-File "w53.ml", line 126, characters 6-15:
-126 |   [@@@immediate] (* rejected *)
+File "w53.ml", line 129, characters 6-15:
+129 |   [@@@immediate] (* rejected *)
             ^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context
 
-File "w53.ml", line 127, characters 6-17:
-127 |   [@@@immediate64] (* rejected *)
+File "w53.ml", line 130, characters 6-17:
+130 |   [@@@immediate64] (* rejected *)
             ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate64" attribute cannot appear in this context
 
-File "w53.ml", line 131, characters 15-24:
-131 |   let x = (4 [@immediate], 42 [@immediate64]) (* rejected *)
+File "w53.ml", line 134, characters 15-24:
+134 |   let x = (4 [@immediate], 42 [@immediate64]) (* rejected *)
                      ^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context
 
-File "w53.ml", line 131, characters 32-43:
-131 |   let x = (4 [@immediate], 42 [@immediate64]) (* rejected *)
+File "w53.ml", line 134, characters 32-43:
+134 |   let x = (4 [@immediate], 42 [@immediate64]) (* rejected *)
                                       ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate64" attribute cannot appear in this context
 
-File "w53.ml", line 132, characters 21-30:
-132 |   let y = (4, 42) [@@immediate] (* rejected *)
+File "w53.ml", line 135, characters 21-30:
+135 |   let y = (4, 42) [@@immediate] (* rejected *)
                            ^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context
 
-File "w53.ml", line 133, characters 21-32:
-133 |   let z = (4, 42) [@@immediate64] (* rejected *)
+File "w53.ml", line 136, characters 21-32:
+136 |   let z = (4, 42) [@@immediate64] (* rejected *)
                            ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate64" attribute cannot appear in this context
 
-File "w53.ml", line 135, characters 18-27:
-135 |   type t1 = int [@immediate] (* rejected *)
+File "w53.ml", line 138, characters 18-27:
+138 |   type t1 = int [@immediate] (* rejected *)
                         ^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context
 
-File "w53.ml", line 139, characters 6-15:
-139 |   [@@@immediate] (* rejected *)
+File "w53.ml", line 142, characters 6-15:
+142 |   [@@@immediate] (* rejected *)
             ^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate" attribute cannot appear in this context
 
-File "w53.ml", line 140, characters 6-17:
-140 |   [@@@immediate64] (* rejected *)
+File "w53.ml", line 143, characters 6-17:
+143 |   [@@@immediate64] (* rejected *)
             ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "immediate64" attribute cannot appear in this context
 
-File "w53.ml", line 145, characters 25-31:
-145 |   type t1 = int -> int [@inline] (* rejected *)
+File "w53.ml", line 148, characters 25-31:
+148 |   type t1 = int -> int [@inline] (* rejected *)
                                ^^^^^^
 Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 
-File "w53.ml", line 146, characters 26-32:
-146 |   type t2 = int -> int [@@inline] (* rejected *)
+File "w53.ml", line 149, characters 26-32:
+149 |   type t2 = int -> int [@@inline] (* rejected *)
                                 ^^^^^^
 Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 
-File "w53.ml", line 147, characters 25-32:
-147 |   type t3 = int -> int [@inlined] (* rejected *)
+File "w53.ml", line 150, characters 25-32:
+150 |   type t3 = int -> int [@inlined] (* rejected *)
                                ^^^^^^^
 Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 
-File "w53.ml", line 148, characters 26-33:
-148 |   type t4 = int -> int [@@inlined] (* rejected *)
+File "w53.ml", line 151, characters 26-33:
+151 |   type t4 = int -> int [@@inlined] (* rejected *)
                                 ^^^^^^^
 Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 
-File "w53.ml", line 150, characters 24-30:
-150 |   val f1 : int -> int [@inline] (* rejected *)
+File "w53.ml", line 153, characters 24-30:
+153 |   val f1 : int -> int [@inline] (* rejected *)
                               ^^^^^^
 Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 
-File "w53.ml", line 151, characters 25-31:
-151 |   val f2 : int -> int [@@inline] (* rejected *)
+File "w53.ml", line 154, characters 25-31:
+154 |   val f2 : int -> int [@@inline] (* rejected *)
                                ^^^^^^
 Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 
-File "w53.ml", line 152, characters 24-31:
-152 |   val f3 : int -> int [@inlined] (* rejected *)
+File "w53.ml", line 155, characters 24-31:
+155 |   val f3 : int -> int [@inlined] (* rejected *)
                               ^^^^^^^
 Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 
-File "w53.ml", line 153, characters 25-32:
-153 |   val f4 : int -> int [@@inlined] (* rejected *)
+File "w53.ml", line 156, characters 25-32:
+156 |   val f4 : int -> int [@@inlined] (* rejected *)
                                ^^^^^^^
 Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 
-File "w53.ml", line 155, characters 53-59:
-155 |   module type F = functor (X : sig end) -> sig end [@inline] (* rejected *)
+File "w53.ml", line 158, characters 53-59:
+158 |   module type F = functor (X : sig end) -> sig end [@inline] (* rejected *)
                                                            ^^^^^^
 Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 
-File "w53.ml", line 156, characters 54-60:
-156 |   module type G = functor (X : sig end) -> sig end [@@inline] (* rejected *)
+File "w53.ml", line 159, characters 54-60:
+159 |   module type G = functor (X : sig end) -> sig end [@@inline] (* rejected *)
                                                             ^^^^^^
 Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 
-File "w53.ml", line 158, characters 6-12:
-158 |   [@@@inline] (* rejected *)
+File "w53.ml", line 161, characters 6-12:
+161 |   [@@@inline] (* rejected *)
             ^^^^^^
 Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 
-File "w53.ml", line 159, characters 6-13:
-159 |   [@@@inlined] (* rejected *)
+File "w53.ml", line 162, characters 6-13:
+162 |   [@@@inlined] (* rejected *)
             ^^^^^^^
 Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 
-File "w53.ml", line 163, characters 16-22:
-163 |   let h x = x [@inline] (* rejected *)
+File "w53.ml", line 166, characters 16-22:
+166 |   let h x = x [@inline] (* rejected *)
                       ^^^^^^
 Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 
-File "w53.ml", line 164, characters 16-28:
-164 |   let h x = x [@ocaml.inline] (* rejected *)
+File "w53.ml", line 167, characters 16-28:
+167 |   let h x = x [@ocaml.inline] (* rejected *)
                       ^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "ocaml.inline" attribute cannot appear in this context
 
-File "w53.ml", line 166, characters 16-23:
-166 |   let i x = x [@inlined] (* rejected *)
+File "w53.ml", line 169, characters 16-23:
+169 |   let i x = x [@inlined] (* rejected *)
                       ^^^^^^^
 Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 
-File "w53.ml", line 167, characters 16-29:
-167 |   let j x = x [@ocaml.inlined] (* rejected *)
+File "w53.ml", line 170, characters 16-29:
+170 |   let j x = x [@ocaml.inlined] (* rejected *)
                       ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "ocaml.inlined" attribute cannot appear in this context
 
-File "w53.ml", line 170, characters 18-25:
-170 |   let l x = h x [@inlined] (* rejected *)
+File "w53.ml", line 173, characters 18-25:
+173 |   let l x = h x [@inlined] (* rejected *)
                         ^^^^^^^
 Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 
-File "w53.ml", line 178, characters 27-33:
-178 |   module C = struct end [@@inline] (* rejected *)
+File "w53.ml", line 181, characters 27-33:
+181 |   module C = struct end [@@inline] (* rejected *)
                                  ^^^^^^
 Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 
-File "w53.ml", line 179, characters 28-40:
-179 |   module C' = struct end [@@ocaml.inline] (* rejected *)
+File "w53.ml", line 182, characters 28-40:
+182 |   module C' = struct end [@@ocaml.inline] (* rejected *)
                                   ^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "ocaml.inline" attribute cannot appear in this context
 
-File "w53.ml", line 180, characters 27-34:
-180 |   module D = struct end [@@inlined] (* rejected *)
+File "w53.ml", line 183, characters 27-34:
+183 |   module D = struct end [@@inlined] (* rejected *)
                                  ^^^^^^^
 Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 
-File "w53.ml", line 181, characters 28-41:
-181 |   module D' = struct end [@@ocaml.inlined] (* rejected *)
+File "w53.ml", line 184, characters 28-41:
+184 |   module D' = struct end [@@ocaml.inlined] (* rejected *)
                                   ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "ocaml.inlined" attribute cannot appear in this context
 
-File "w53.ml", line 185, characters 18-24:
-185 |   module G = (A [@inline])(struct end) (* rejected *)
+File "w53.ml", line 188, characters 18-24:
+188 |   module G = (A [@inline])(struct end) (* rejected *)
                         ^^^^^^
 Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 
-File "w53.ml", line 186, characters 19-31:
-186 |   module G' = (A [@ocaml.inline])(struct end) (* rejected *)
+File "w53.ml", line 189, characters 19-31:
+189 |   module G' = (A [@ocaml.inline])(struct end) (* rejected *)
                          ^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "ocaml.inline" attribute cannot appear in this context
 
-File "w53.ml", line 190, characters 24-31:
-190 |   module I = Set.Make [@inlined] (* rejected *)
+File "w53.ml", line 193, characters 24-31:
+193 |   module I = Set.Make [@inlined] (* rejected *)
                               ^^^^^^^
 Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 
-File "w53.ml", line 191, characters 25-38:
-191 |   module I' = Set.Make [@ocaml.inlined] (* rejected *)
+File "w53.ml", line 194, characters 25-38:
+194 |   module I' = Set.Make [@ocaml.inlined] (* rejected *)
                                ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "ocaml.inlined" attribute cannot appear in this context
 
-File "w53.ml", line 193, characters 25-32:
-193 |   module J = Set.Make [@@inlined] (* rejected *)
+File "w53.ml", line 196, characters 25-32:
+196 |   module J = Set.Make [@@inlined] (* rejected *)
                                ^^^^^^^
 Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 
-File "w53.ml", line 194, characters 26-39:
-194 |   module J' = Set.Make [@@ocaml.inlined] (* rejected *)
+File "w53.ml", line 197, characters 26-39:
+197 |   module J' = Set.Make [@@ocaml.inlined] (* rejected *)
                                 ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "ocaml.inlined" attribute cannot appear in this context
 
-File "w53.ml", line 199, characters 21-28:
-199 |   type 'a t1 = 'a [@@noalloc] (* rejected *)
+File "w53.ml", line 202, characters 21-28:
+202 |   type 'a t1 = 'a [@@noalloc] (* rejected *)
                            ^^^^^^^
 Warning 53 [misplaced-attribute]: the "noalloc" attribute cannot appear in this context
 
-File "w53.ml", line 200, characters 19-26:
-200 |   type s1 = Foo1 [@noalloc] (* rejected *)
+File "w53.ml", line 203, characters 19-26:
+203 |   type s1 = Foo1 [@noalloc] (* rejected *)
                          ^^^^^^^
 Warning 53 [misplaced-attribute]: the "noalloc" attribute cannot appear in this context
 
-File "w53.ml", line 201, characters 19-26:
-201 |   val x : int64 [@@noalloc] (* rejected *)
+File "w53.ml", line 204, characters 19-26:
+204 |   val x : int64 [@@noalloc] (* rejected *)
                          ^^^^^^^
 Warning 53 [misplaced-attribute]: the "noalloc" attribute cannot appear in this context
 
-File "w53.ml", line 203, characters 24-31:
-203 |   external y : (int64 [@noalloc]) -> (int64 [@noalloc]) = "x" (* rejected *)
+File "w53.ml", line 206, characters 24-31:
+206 |   external y : (int64 [@noalloc]) -> (int64 [@noalloc]) = "x" (* rejected *)
                               ^^^^^^^
 Warning 53 [misplaced-attribute]: the "noalloc" attribute cannot appear in this context
 
-File "w53.ml", line 203, characters 46-53:
-203 |   external y : (int64 [@noalloc]) -> (int64 [@noalloc]) = "x" (* rejected *)
+File "w53.ml", line 206, characters 46-53:
+206 |   external y : (int64 [@noalloc]) -> (int64 [@noalloc]) = "x" (* rejected *)
                                                     ^^^^^^^
 Warning 53 [misplaced-attribute]: the "noalloc" attribute cannot appear in this context
 
-File "w53.ml", line 208, characters 21-28:
-208 |   type 'a t1 = 'a [@@noalloc] (* rejected *)
+File "w53.ml", line 211, characters 21-28:
+211 |   type 'a t1 = 'a [@@noalloc] (* rejected *)
                            ^^^^^^^
 Warning 53 [misplaced-attribute]: the "noalloc" attribute cannot appear in this context
 
-File "w53.ml", line 209, characters 19-26:
-209 |   type s1 = Foo1 [@noalloc] (* rejected *)
+File "w53.ml", line 212, characters 19-26:
+212 |   type s1 = Foo1 [@noalloc] (* rejected *)
                          ^^^^^^^
 Warning 53 [misplaced-attribute]: the "noalloc" attribute cannot appear in this context
 
-File "w53.ml", line 210, characters 25-32:
-210 |   let x : int64 = 42L [@@noalloc] (* rejected *)
+File "w53.ml", line 213, characters 25-32:
+213 |   let x : int64 = 42L [@@noalloc] (* rejected *)
                                ^^^^^^^
 Warning 53 [misplaced-attribute]: the "noalloc" attribute cannot appear in this context
 
-File "w53.ml", line 212, characters 24-31:
-212 |   external y : (int64 [@noalloc]) -> (int64 [@noalloc]) = "x" (* rejected *)
+File "w53.ml", line 215, characters 24-31:
+215 |   external y : (int64 [@noalloc]) -> (int64 [@noalloc]) = "x" (* rejected *)
                               ^^^^^^^
 Warning 53 [misplaced-attribute]: the "noalloc" attribute cannot appear in this context
 
-File "w53.ml", line 212, characters 46-53:
-212 |   external y : (int64 [@noalloc]) -> (int64 [@noalloc]) = "x" (* rejected *)
+File "w53.ml", line 215, characters 46-53:
+215 |   external y : (int64 [@noalloc]) -> (int64 [@noalloc]) = "x" (* rejected *)
                                                     ^^^^^^^
 Warning 53 [misplaced-attribute]: the "noalloc" attribute cannot appear in this context
 
-File "w53.ml", line 241, characters 21-29:
-241 |   type 'a t1 = 'a [@@tailcall] (* rejected *)
+File "w53.ml", line 244, characters 21-29:
+244 |   type 'a t1 = 'a [@@tailcall] (* rejected *)
                            ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 242, characters 19-27:
-242 |   type s1 = Foo1 [@tailcall] (* rejected *)
+File "w53.ml", line 245, characters 19-27:
+245 |   type s1 = Foo1 [@tailcall] (* rejected *)
                          ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 243, characters 16-24:
-243 |   val x : int [@tailcall] (* rejected *)
+File "w53.ml", line 246, characters 16-24:
+246 |   val x : int [@tailcall] (* rejected *)
                       ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 245, characters 35-43:
-245 |   external z : int -> int = "x" [@@tailcall] (* rejected *)
+File "w53.ml", line 248, characters 35-43:
+248 |   external z : int -> int = "x" [@@tailcall] (* rejected *)
                                          ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 247, characters 6-14:
-247 |   [@@@tailcall] (* rejected *)
+File "w53.ml", line 250, characters 6-14:
+250 |   [@@@tailcall] (* rejected *)
             ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 251, characters 21-29:
-251 |   type 'a t1 = 'a [@@tailcall] (* rejected *)
+File "w53.ml", line 254, characters 21-29:
+254 |   type 'a t1 = 'a [@@tailcall] (* rejected *)
                            ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 252, characters 19-27:
-252 |   type s1 = Foo1 [@tailcall] (* rejected *)
+File "w53.ml", line 255, characters 19-27:
+255 |   type s1 = Foo1 [@tailcall] (* rejected *)
                          ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 254, characters 16-24:
-254 |   let m x = x [@tailcall] (* rejected *)
+File "w53.ml", line 257, characters 16-24:
+257 |   let m x = x [@tailcall] (* rejected *)
                       ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 255, characters 16-30:
-255 |   let n x = x [@ocaml.tailcall] (* rejected *)
+File "w53.ml", line 258, characters 16-30:
+258 |   let n x = x [@ocaml.tailcall] (* rejected *)
                       ^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "ocaml.tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 258, characters 18-26:
-258 |   let q x = m x [@tailcall] (* rejected *)
+File "w53.ml", line 261, characters 18-26:
+261 |   let q x = m x [@tailcall] (* rejected *)
                         ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 260, characters 35-43:
-260 |   external z : int -> int = "x" [@@tailcall] (* rejected *)
+File "w53.ml", line 263, characters 35-43:
+263 |   external z : int -> int = "x" [@@tailcall] (* rejected *)
                                          ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 262, characters 6-14:
-262 |   [@@@tailcall] (* rejected *)
+File "w53.ml", line 265, characters 6-14:
+265 |   [@@@tailcall] (* rejected *)
             ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 
-File "w53.ml", line 267, characters 24-31:
-267 |   type t1 = { x : int [@unboxed] } (* rejected *)
+File "w53.ml", line 270, characters 24-31:
+270 |   type t1 = { x : int [@unboxed] } (* rejected *)
                               ^^^^^^^
 Warning 53 [misplaced-attribute]: the "unboxed" attribute cannot appear in this context
 
-File "w53.ml", line 269, characters 16-23:
-269 |   val x : int [@unboxed] (* rejected *)
+File "w53.ml", line 272, characters 16-23:
+272 |   val x : int [@unboxed] (* rejected *)
                       ^^^^^^^
 Warning 53 [misplaced-attribute]: the "unboxed" attribute cannot appear in this context
 
-File "w53.ml", line 273, characters 17-24:
-273 |   val y : int [@@unboxed] (* rejected *)
+File "w53.ml", line 276, characters 17-24:
+276 |   val y : int [@@unboxed] (* rejected *)
                        ^^^^^^^
 Warning 53 [misplaced-attribute]: the "unboxed" attribute cannot appear in this context
 
-File "w53.ml", line 277, characters 6-13:
-277 |   [@@@unboxed] (* rejected *)
+File "w53.ml", line 280, characters 6-13:
+280 |   [@@@unboxed] (* rejected *)
             ^^^^^^^
 Warning 53 [misplaced-attribute]: the "unboxed" attribute cannot appear in this context
 
-File "w53.ml", line 281, characters 16-23:
-281 |   let x = (42 [@unboxed], 84) (* rejected *)
+File "w53.ml", line 284, characters 16-23:
+284 |   let x = (42 [@unboxed], 84) (* rejected *)
                       ^^^^^^^
 Warning 53 [misplaced-attribute]: the "unboxed" attribute cannot appear in this context
 
-File "w53.ml", line 283, characters 16-23:
-283 |   let y = 10 [@@unboxed] (* rejected *)
+File "w53.ml", line 286, characters 16-23:
+286 |   let y = 10 [@@unboxed] (* rejected *)
                       ^^^^^^^
 Warning 53 [misplaced-attribute]: the "unboxed" attribute cannot appear in this context
 
-File "w53.ml", line 287, characters 6-13:
-287 |   [@@@unboxed] (* rejected *)
+File "w53.ml", line 290, characters 6-13:
+290 |   [@@@unboxed] (* rejected *)
             ^^^^^^^
 Warning 53 [misplaced-attribute]: the "unboxed" attribute cannot appear in this context
 
-File "w53.ml", line 292, characters 21-29:
-292 |   type 'a t1 = 'a [@@untagged] (* rejected *)
+File "w53.ml", line 295, characters 21-29:
+295 |   type 'a t1 = 'a [@@untagged] (* rejected *)
                            ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "untagged" attribute cannot appear in this context
 
-File "w53.ml", line 293, characters 19-27:
-293 |   type s1 = Foo1 [@untagged] (* rejected *)
+File "w53.ml", line 296, characters 19-27:
+296 |   type s1 = Foo1 [@untagged] (* rejected *)
                          ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "untagged" attribute cannot appear in this context
 
-File "w53.ml", line 294, characters 17-25:
-294 |   val x : int [@@untagged] (* rejected *)
+File "w53.ml", line 297, characters 17-25:
+297 |   val x : int [@@untagged] (* rejected *)
                        ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "untagged" attribute cannot appear in this context
 
-File "w53.ml", line 301, characters 21-29:
-301 |   type 'a t1 = 'a [@@untagged] (* rejected *)
+File "w53.ml", line 304, characters 21-29:
+304 |   type 'a t1 = 'a [@@untagged] (* rejected *)
                            ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "untagged" attribute cannot appear in this context
 
-File "w53.ml", line 302, characters 19-27:
-302 |   type s1 = Foo1 [@untagged] (* rejected *)
+File "w53.ml", line 305, characters 19-27:
+305 |   type s1 = Foo1 [@untagged] (* rejected *)
                          ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "untagged" attribute cannot appear in this context
 
-File "w53.ml", line 303, characters 22-30:
-303 |   let x : int = 42 [@@untagged] (* rejected *)
+File "w53.ml", line 306, characters 22-30:
+306 |   let x : int = 42 [@@untagged] (* rejected *)
                             ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "untagged" attribute cannot appear in this context
 
-File "w53.ml", line 311, characters 24-32:
-311 |   type t1 = { x : int [@unrolled 42] } (* rejected *)
+File "w53.ml", line 314, characters 24-32:
+314 |   type t1 = { x : int [@unrolled 42] } (* rejected *)
                               ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 312, characters 27-35:
-312 |   type t2 = { x : int } [@@unrolled 42] (* rejected *)
+File "w53.ml", line 315, characters 27-35:
+315 |   type t2 = { x : int } [@@unrolled 42] (* rejected *)
                                  ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 314, characters 23-31:
-314 |   val f : int -> int [@unrolled 42] (* rejected *)
+File "w53.ml", line 317, characters 23-31:
+317 |   val f : int -> int [@unrolled 42] (* rejected *)
                              ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 315, characters 24-32:
-315 |   val g : int -> int [@@unrolled 42] (* rejected *)
+File "w53.ml", line 318, characters 24-32:
+318 |   val g : int -> int [@@unrolled 42] (* rejected *)
                               ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 317, characters 39-47:
-317 |   external z : float -> float = "x" [@@unrolled 42] (* rejected *)
+File "w53.ml", line 320, characters 39-47:
+320 |   external z : float -> float = "x" [@@unrolled 42] (* rejected *)
                                              ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 319, characters 6-14:
-319 |   [@@@unrolled 42] (* rejected *)
+File "w53.ml", line 322, characters 6-14:
+322 |   [@@@unrolled 42] (* rejected *)
             ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 323, characters 8-16:
-323 |   let [@unrolled 42] rec test_unrolled x = (* rejected *)
+File "w53.ml", line 326, characters 8-16:
+326 |   let [@unrolled 42] rec test_unrolled x = (* rejected *)
               ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 330, characters 24-32:
-330 |   type t1 = { x : int [@unrolled 42] } (* rejected *)
+File "w53.ml", line 333, characters 24-32:
+333 |   type t1 = { x : int [@unrolled 42] } (* rejected *)
                               ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 331, characters 27-35:
-331 |   type t2 = { x : int } [@@unrolled 42] (* rejected *)
+File "w53.ml", line 334, characters 27-35:
+334 |   type t2 = { x : int } [@@unrolled 42] (* rejected *)
                                  ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 333, characters 22-30:
-333 |   let rec f x = f x [@unrolled 42] (* rejected *)
+File "w53.ml", line 336, characters 22-30:
+336 |   let rec f x = f x [@unrolled 42] (* rejected *)
                             ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 334, characters 23-31:
-334 |   let rec f x = f x [@@unrolled 42] (* rejected *)
+File "w53.ml", line 337, characters 23-31:
+337 |   let rec f x = f x [@@unrolled 42] (* rejected *)
                              ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 336, characters 39-47:
-336 |   external z : int -> int = "x" "y" [@@unrolled 42] (* rejected *)
+File "w53.ml", line 339, characters 39-47:
+339 |   external z : int -> int = "x" "y" [@@unrolled 42] (* rejected *)
                                              ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 338, characters 6-14:
-338 |   [@@@unrolled 42] (* rejected *)
+File "w53.ml", line 341, characters 6-14:
+341 |   [@@@unrolled 42] (* rejected *)
             ^^^^^^^^
 Warning 53 [misplaced-attribute]: the "unrolled" attribute cannot appear in this context
 
-File "w53.ml", line 387, characters 25-48:
-387 |     | Lit_pat2 of int [@@warn_on_literal_pattern] (* rejected *)
+File "w53.ml", line 390, characters 25-48:
+390 |     | Lit_pat2 of int [@@warn_on_literal_pattern] (* rejected *)
                                ^^^^^^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "warn_on_literal_pattern" attribute cannot appear in this context
 
-File "w53.ml", line 391, characters 16-39:
-391 |   val x : int [@warn_on_literal_pattern] (* rejected *)
+File "w53.ml", line 394, characters 16-39:
+394 |   val x : int [@warn_on_literal_pattern] (* rejected *)
                       ^^^^^^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "warn_on_literal_pattern" attribute cannot appear in this context
 
-File "w53.ml", line 393, characters 21-44:
-393 |   type 'a t2 = 'a [@@warn_on_literal_pattern] (* rejected *)
+File "w53.ml", line 396, characters 21-44:
+396 |   type 'a t2 = 'a [@@warn_on_literal_pattern] (* rejected *)
                            ^^^^^^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "warn_on_literal_pattern" attribute cannot appear in this context
 
-File "w53.ml", line 395, characters 17-40:
-395 |   val y : int [@@warn_on_literal_pattern] (* rejected *)
+File "w53.ml", line 398, characters 17-40:
+398 |   val y : int [@@warn_on_literal_pattern] (* rejected *)
                        ^^^^^^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "warn_on_literal_pattern" attribute cannot appear in this context
 
-File "w53.ml", line 397, characters 6-29:
-397 |   [@@@warn_on_literal_pattern] (* rejected *)
+File "w53.ml", line 400, characters 6-29:
+400 |   [@@@warn_on_literal_pattern] (* rejected *)
             ^^^^^^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "warn_on_literal_pattern" attribute cannot appear in this context
 
-File "w53.ml", line 403, characters 25-48:
-403 |     | Lit_pat2 of int [@@warn_on_literal_pattern] (* rejected *)
+File "w53.ml", line 406, characters 25-48:
+406 |     | Lit_pat2 of int [@@warn_on_literal_pattern] (* rejected *)
                                ^^^^^^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "warn_on_literal_pattern" attribute cannot appear in this context
 
-File "w53.ml", line 405, characters 14-37:
-405 |   let x = 5 [@warn_on_literal_pattern] (* rejected *)
+File "w53.ml", line 408, characters 14-37:
+408 |   let x = 5 [@warn_on_literal_pattern] (* rejected *)
                     ^^^^^^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "warn_on_literal_pattern" attribute cannot appear in this context
 
-File "w53.ml", line 407, characters 16-39:
-407 |   let y = 10 [@@warn_on_literal_pattern] (* rejected *)
+File "w53.ml", line 410, characters 16-39:
+410 |   let y = 10 [@@warn_on_literal_pattern] (* rejected *)
                       ^^^^^^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "warn_on_literal_pattern" attribute cannot appear in this context
 
-File "w53.ml", line 409, characters 6-29:
-409 |   [@@@warn_on_literal_pattern] (* rejected *)
+File "w53.ml", line 412, characters 6-29:
+412 |   [@@@warn_on_literal_pattern] (* rejected *)
             ^^^^^^^^^^^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "warn_on_literal_pattern" attribute cannot appear in this context
 
-File "w53.ml", line 418, characters 21-25:
-418 |   type 'a t1 = 'a [@@poll error] (* rejected *)
+File "w53.ml", line 421, characters 21-25:
+421 |   type 'a t1 = 'a [@@poll error] (* rejected *)
                            ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 419, characters 19-23:
-419 |   type s1 = Foo1 [@poll error] (* rejected *)
+File "w53.ml", line 422, characters 19-23:
+422 |   type s1 = Foo1 [@poll error] (* rejected *)
                          ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 420, characters 19-23:
-420 |   val x : int64 [@@poll error] (* rejected *)
+File "w53.ml", line 423, characters 19-23:
+423 |   val x : int64 [@@poll error] (* rejected *)
                          ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 422, characters 24-28:
-422 |   external y : (int64 [@poll error]) -> (int64 [@poll error]) = (* rejected *)
+File "w53.ml", line 425, characters 24-28:
+425 |   external y : (int64 [@poll error]) -> (int64 [@poll error]) = (* rejected *)
                               ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 422, characters 49-53:
-422 |   external y : (int64 [@poll error]) -> (int64 [@poll error]) = (* rejected *)
+File "w53.ml", line 425, characters 49-53:
+425 |   external y : (int64 [@poll error]) -> (int64 [@poll error]) = (* rejected *)
                                                        ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 424, characters 39-43:
-424 |   external z : int64 -> int64 = "x" [@@poll error] (* rejected *)
+File "w53.ml", line 427, characters 39-43:
+427 |   external z : int64 -> int64 = "x" [@@poll error] (* rejected *)
                                              ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 428, characters 21-25:
-428 |   type 'a t1 = 'a [@@poll error] (* rejected *)
+File "w53.ml", line 431, characters 21-25:
+431 |   type 'a t1 = 'a [@@poll error] (* rejected *)
                            ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 429, characters 19-23:
-429 |   type s1 = Foo1 [@poll error] (* rejected *)
+File "w53.ml", line 432, characters 19-23:
+432 |   type s1 = Foo1 [@poll error] (* rejected *)
                          ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 430, characters 25-29:
-430 |   let x : int64 = 42L [@@poll error] (* rejected *)
+File "w53.ml", line 433, characters 25-29:
+433 |   let x : int64 = 42L [@@poll error] (* rejected *)
                                ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 433, characters 24-28:
-433 |   external y : (int64 [@poll error]) -> (int64 [@poll error]) =  (* rejected *)
+File "w53.ml", line 436, characters 24-28:
+436 |   external y : (int64 [@poll error]) -> (int64 [@poll error]) =  (* rejected *)
                               ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 433, characters 49-53:
-433 |   external y : (int64 [@poll error]) -> (int64 [@poll error]) =  (* rejected *)
+File "w53.ml", line 436, characters 49-53:
+436 |   external y : (int64 [@poll error]) -> (int64 [@poll error]) =  (* rejected *)
                                                        ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 435, characters 39-43:
-435 |   external z : int64 -> int64 = "x" [@@poll error] (* rejected *)
+File "w53.ml", line 438, characters 39-43:
+438 |   external z : int64 -> int64 = "x" [@@poll error] (* rejected *)
                                              ^^^^
 Warning 53 [misplaced-attribute]: the "poll" attribute cannot appear in this context
 
-File "w53.ml", line 440, characters 21-31:
-440 |   type 'a t1 = 'a [@@specialise] (* rejected *)
+File "w53.ml", line 443, characters 21-31:
+443 |   type 'a t1 = 'a [@@specialise] (* rejected *)
                            ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 441, characters 19-29:
-441 |   type s1 = Foo1 [@specialise] (* rejected *)
+File "w53.ml", line 444, characters 19-29:
+444 |   type s1 = Foo1 [@specialise] (* rejected *)
                          ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 442, characters 19-29:
-442 |   val x : int64 [@@specialise] (* rejected *)
+File "w53.ml", line 445, characters 19-29:
+445 |   val x : int64 [@@specialise] (* rejected *)
                          ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 444, characters 24-34:
-444 |   external y : (int64 [@specialise]) -> (int64 [@specialise]) = (* rejected *)
+File "w53.ml", line 447, characters 24-34:
+447 |   external y : (int64 [@specialise]) -> (int64 [@specialise]) = (* rejected *)
                               ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 444, characters 49-59:
-444 |   external y : (int64 [@specialise]) -> (int64 [@specialise]) = (* rejected *)
+File "w53.ml", line 447, characters 49-59:
+447 |   external y : (int64 [@specialise]) -> (int64 [@specialise]) = (* rejected *)
                                                        ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 446, characters 39-49:
-446 |   external z : int64 -> int64 = "x" [@@specialise] (* rejected *)
+File "w53.ml", line 449, characters 39-49:
+449 |   external z : int64 -> int64 = "x" [@@specialise] (* rejected *)
                                              ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 450, characters 21-31:
-450 |   type 'a t1 = 'a [@@specialise] (* rejected *)
+File "w53.ml", line 453, characters 21-31:
+453 |   type 'a t1 = 'a [@@specialise] (* rejected *)
                            ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 451, characters 19-29:
-451 |   type s1 = Foo1 [@specialise] (* rejected *)
+File "w53.ml", line 454, characters 19-29:
+454 |   type s1 = Foo1 [@specialise] (* rejected *)
                          ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 452, characters 25-35:
-452 |   let x : int64 = 42L [@@specialise] (* rejected *)
+File "w53.ml", line 455, characters 25-35:
+455 |   let x : int64 = 42L [@@specialise] (* rejected *)
                                ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 454, characters 16-26:
-454 |   let g x = (f[@specialise]) x (* rejected *)
+File "w53.ml", line 457, characters 16-26:
+457 |   let g x = (f[@specialise]) x (* rejected *)
                       ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 456, characters 24-34:
-456 |   external y : (int64 [@specialise]) -> (int64 [@specialise]) = (* rejected *)
+File "w53.ml", line 459, characters 24-34:
+459 |   external y : (int64 [@specialise]) -> (int64 [@specialise]) = (* rejected *)
                               ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 456, characters 49-59:
-456 |   external y : (int64 [@specialise]) -> (int64 [@specialise]) = (* rejected *)
+File "w53.ml", line 459, characters 49-59:
+459 |   external y : (int64 [@specialise]) -> (int64 [@specialise]) = (* rejected *)
                                                        ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 458, characters 39-49:
-458 |   external z : int64 -> int64 = "x" [@@specialise] (* rejected *)
+File "w53.ml", line 461, characters 39-49:
+461 |   external z : int64 -> int64 = "x" [@@specialise] (* rejected *)
                                              ^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialise" attribute cannot appear in this context
 
-File "w53.ml", line 463, characters 21-32:
-463 |   type 'a t1 = 'a [@@specialised] (* rejected *)
+File "w53.ml", line 466, characters 21-32:
+466 |   type 'a t1 = 'a [@@specialised] (* rejected *)
                            ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 464, characters 19-30:
-464 |   type s1 = Foo1 [@specialised] (* rejected *)
+File "w53.ml", line 467, characters 19-30:
+467 |   type s1 = Foo1 [@specialised] (* rejected *)
                          ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 465, characters 19-30:
-465 |   val x : int64 [@@specialised] (* rejected *)
+File "w53.ml", line 468, characters 19-30:
+468 |   val x : int64 [@@specialised] (* rejected *)
                          ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 467, characters 24-35:
-467 |   external y : (int64 [@specialised]) -> (int64 [@specialised]) = (* rejected *)
+File "w53.ml", line 470, characters 24-35:
+470 |   external y : (int64 [@specialised]) -> (int64 [@specialised]) = (* rejected *)
                               ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 467, characters 50-61:
-467 |   external y : (int64 [@specialised]) -> (int64 [@specialised]) = (* rejected *)
+File "w53.ml", line 470, characters 50-61:
+470 |   external y : (int64 [@specialised]) -> (int64 [@specialised]) = (* rejected *)
                                                         ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 469, characters 39-50:
-469 |   external z : int64 -> int64 = "x" [@@specialised] (* rejected *)
+File "w53.ml", line 472, characters 39-50:
+472 |   external z : int64 -> int64 = "x" [@@specialised] (* rejected *)
                                              ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 473, characters 21-32:
-473 |   type 'a t1 = 'a [@@specialised] (* rejected *)
+File "w53.ml", line 476, characters 21-32:
+476 |   type 'a t1 = 'a [@@specialised] (* rejected *)
                            ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 474, characters 19-30:
-474 |   type s1 = Foo1 [@specialised] (* rejected *)
+File "w53.ml", line 477, characters 19-30:
+477 |   type s1 = Foo1 [@specialised] (* rejected *)
                          ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 475, characters 25-36:
-475 |   let x : int64 = 42L [@@specialised] (* rejected *)
+File "w53.ml", line 478, characters 25-36:
+478 |   let x : int64 = 42L [@@specialised] (* rejected *)
                                ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 476, characters 8-19:
-476 |   let [@specialised] f x = x (* rejected *)
+File "w53.ml", line 479, characters 8-19:
+479 |   let [@specialised] f x = x (* rejected *)
               ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 479, characters 24-35:
-479 |   external y : (int64 [@specialised]) -> (int64 [@specialised]) = (* rejected *)
+File "w53.ml", line 482, characters 24-35:
+482 |   external y : (int64 [@specialised]) -> (int64 [@specialised]) = (* rejected *)
                               ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 479, characters 50-61:
-479 |   external y : (int64 [@specialised]) -> (int64 [@specialised]) = (* rejected *)
+File "w53.ml", line 482, characters 50-61:
+482 |   external y : (int64 [@specialised]) -> (int64 [@specialised]) = (* rejected *)
                                                         ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 481, characters 39-50:
-481 |   external z : int64 -> int64 = "x" [@@specialised] (* rejected *)
+File "w53.ml", line 484, characters 39-50:
+484 |   external z : int64 -> int64 = "x" [@@specialised] (* rejected *)
                                              ^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "specialised" attribute cannot appear in this context
 
-File "w53.ml", line 486, characters 21-34:
-486 |   type 'a t1 = 'a [@@tail_mod_cons] (* rejected *)
+File "w53.ml", line 489, characters 21-34:
+489 |   type 'a t1 = 'a [@@tail_mod_cons] (* rejected *)
                            ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 487, characters 19-32:
-487 |   type s1 = Foo1 [@tail_mod_cons] (* rejected *)
+File "w53.ml", line 490, characters 19-32:
+490 |   type s1 = Foo1 [@tail_mod_cons] (* rejected *)
                          ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 488, characters 19-32:
-488 |   val x : int64 [@@tail_mod_cons] (* rejected *)
+File "w53.ml", line 491, characters 19-32:
+491 |   val x : int64 [@@tail_mod_cons] (* rejected *)
                          ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 490, characters 24-37:
-490 |   external y : (int64 [@tail_mod_cons]) -> (int64 [@tail_mod_cons]) =
+File "w53.ml", line 493, characters 24-37:
+493 |   external y : (int64 [@tail_mod_cons]) -> (int64 [@tail_mod_cons]) =
                               ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 490, characters 52-65:
-490 |   external y : (int64 [@tail_mod_cons]) -> (int64 [@tail_mod_cons]) =
+File "w53.ml", line 493, characters 52-65:
+493 |   external y : (int64 [@tail_mod_cons]) -> (int64 [@tail_mod_cons]) =
                                                           ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 493, characters 39-52:
-493 |   external z : int64 -> int64 = "x" [@@tail_mod_cons] (* rejected *)
+File "w53.ml", line 496, characters 39-52:
+496 |   external z : int64 -> int64 = "x" [@@tail_mod_cons] (* rejected *)
                                              ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 497, characters 21-34:
-497 |   type 'a t1 = 'a [@@tail_mod_cons] (* rejected *)
+File "w53.ml", line 500, characters 21-34:
+500 |   type 'a t1 = 'a [@@tail_mod_cons] (* rejected *)
                            ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 498, characters 19-32:
-498 |   type s1 = Foo1 [@tail_mod_cons] (* rejected *)
+File "w53.ml", line 501, characters 19-32:
+501 |   type s1 = Foo1 [@tail_mod_cons] (* rejected *)
                          ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 499, characters 25-38:
-499 |   let x : int64 = 42L [@@tail_mod_cons] (* rejected *)
+File "w53.ml", line 502, characters 25-38:
+502 |   let x : int64 = 42L [@@tail_mod_cons] (* rejected *)
                                ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 501, characters 16-29:
-501 |   let g x = (f[@tail_mod_cons]) x (* rejected *)
+File "w53.ml", line 504, characters 16-29:
+504 |   let g x = (f[@tail_mod_cons]) x (* rejected *)
                       ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 503, characters 24-37:
-503 |   external y : (int64 [@tail_mod_cons]) -> (int64 [@tail_mod_cons]) =
+File "w53.ml", line 506, characters 24-37:
+506 |   external y : (int64 [@tail_mod_cons]) -> (int64 [@tail_mod_cons]) =
                               ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 503, characters 52-65:
-503 |   external y : (int64 [@tail_mod_cons]) -> (int64 [@tail_mod_cons]) =
+File "w53.ml", line 506, characters 52-65:
+506 |   external y : (int64 [@tail_mod_cons]) -> (int64 [@tail_mod_cons]) =
                                                           ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
 
-File "w53.ml", line 506, characters 39-52:
-506 |   external z : int64 -> int64 = "x" [@@tail_mod_cons] (* rejected *)
+File "w53.ml", line 509, characters 39-52:
+509 |   external z : int64 -> int64 = "x" [@@tail_mod_cons] (* rejected *)
                                              ^^^^^^^^^^^^^
 Warning 53 [misplaced-attribute]: the "tail_mod_cons" attribute cannot appear in this context
+
+File "w53.ml", line 515, characters 10-15:
+515 |       [@@@alert foo "foo"] (* rejected *)
+                ^^^^^
+Warning 53 [misplaced-attribute]: the "alert" attribute cannot appear in this context

diff --git a/testsuite/tests/warnings/w53.ml b/testsuite/tests/warnings/w53.ml
index dbfe3e3d45a11ecf4156e467b90c32376d0c5052..5e71c5486623ce24d7aa33119cad42c21c4c4979 100644 (file)
--- a/testsuite/tests/warnings/w53.ml
+++ b/testsuite/tests/warnings/w53.ml
@@ -24,6 +24,9 @@ module TestAlertStruct = struct
   let y = 10 [@@alert foo "foo"] (* rejected *)
 
   [@@@alert foo "foo"] (* rejected *)
+
+  [@@@warning "-53"]
+  [@@@alert foo "foo"] (* accepted *)
 end
 
 
@@ -505,3 +508,16 @@ module TestTailModConsStruct = struct
     "x"
   external z : int64 -> int64 = "x" [@@tail_mod_cons] (* rejected *)
 end
+
+module TestAlertClass = struct
+  class c1 =
+    object
+      [@@@alert foo "foo"] (* rejected *)
+    end
+
+  class c2 =
+    object
+      [@@@warning "-53"]
+      [@@@alert foo "foo"] (* accepted *)
+    end
+end

diff --git a/testsuite/tests/warnings/w53_across_cmi.compilers.reference b/testsuite/tests/warnings/w53_across_cmi.compilers.reference
new file mode 100644 (file)
index 0000000..6bd061b
--- /dev/null
+++ b/testsuite/tests/warnings/w53_across_cmi.compilers.reference
@@ -0,0 +1,52 @@
+File "w53_without_cmi.ml", line 6, characters 4-9:
+6 | [@@@alert xyz "xyz"] (* rejected *)
+        ^^^^^
+Warning 53 [misplaced-attribute]: the "alert" attribute cannot appear in this context
+
+File "w53_without_cmi.ml", line 9, characters 6-11:
+9 |   [@@@alert foo "foo"] (* rejected *)
+          ^^^^^
+Warning 53 [misplaced-attribute]: the "alert" attribute cannot appear in this context
+
+File "w53_with_cmi.mli", line 6, characters 4-9:
+6 | [@@@alert xyz "xyz"] (* rejected *)
+        ^^^^^
+Warning 53 [misplaced-attribute]: the "alert" attribute cannot appear in this context
+
+File "w53_with_cmi.ml", line 1, characters 4-9:
+1 | [@@@alert foo "foo"] (* rejected *)
+        ^^^^^
+Warning 53 [misplaced-attribute]: the "alert" attribute cannot appear in this context
+
+File "w53_with_cmi.ml", line 2, characters 4-9:
+2 | [@@@alert bar "bar"] (* rejected *)
+        ^^^^^
+Warning 53 [misplaced-attribute]: the "alert" attribute cannot appear in this context
+
+File "w53_with_cmi.ml", line 6, characters 4-9:
+6 | [@@@alert xyz "xyz"] (* rejected *)
+        ^^^^^
+Warning 53 [misplaced-attribute]: the "alert" attribute cannot appear in this context
+File "w53_across_cmi.ml", line 17, characters 5-20:
+17 | open W53_without_cmi
+          ^^^^^^^^^^^^^^^
+Alert bar: module W53_without_cmi
+bar
+
+File "w53_across_cmi.ml", line 17, characters 5-20:
+17 | open W53_without_cmi
+          ^^^^^^^^^^^^^^^
+Alert foo: module W53_without_cmi
+foo
+
+File "w53_across_cmi.ml", line 18, characters 5-17:
+18 | open W53_with_cmi
+          ^^^^^^^^^^^^
+Alert bar: module W53_with_cmi
+bar(I)
+
+File "w53_across_cmi.ml", line 18, characters 5-17:
+18 | open W53_with_cmi
+          ^^^^^^^^^^^^
+Alert foo: module W53_with_cmi
+foo(I)

diff --git a/testsuite/tests/warnings/w53_across_cmi.ml b/testsuite/tests/warnings/w53_across_cmi.ml
new file mode 100644 (file)
index 0000000..f574dc5
--- /dev/null
+++ b/testsuite/tests/warnings/w53_across_cmi.ml
@@ -0,0 +1,18 @@
+(* TEST
+   readonly_files = "w53_without_cmi.ml w53_with_cmi.mli w53_with_cmi.ml";
+   setup-ocamlc.byte-build-env;
+   all_modules = "w53_without_cmi.ml w53_with_cmi.mli w53_with_cmi.ml";
+   flags = "-w +A-70";
+   compile_only = "true";
+   ocamlc.byte;
+   all_modules = "w53_across_cmi.ml";
+   flags = "-alert +all -w +A-33-70";
+   ocamlc.byte;
+   check-ocamlc.byte-output;
+*)
+
+(* This tests checks that alerts are correctly triggered across compilation
+   units. *)
+
+open W53_without_cmi
+open W53_with_cmi

diff --git a/testsuite/tests/warnings/w53_flags.ml b/testsuite/tests/warnings/w53_flags.ml
new file mode 100644 (file)
index 0000000..de3f605
--- /dev/null
+++ b/testsuite/tests/warnings/w53_flags.ml
@@ -0,0 +1,39 @@
+(* TEST
+   readonly_files = "w53.ml";
+   setup-ocamlc.byte-build-env;
+   module = "w53.ml";
+
+   (* We don't issue warning 53 when -i is passed *)
+   {
+     flags = "-warn-error +53 -i -w +A-22-27-32-60-67-70-71-72";
+     compile_only = "true";
+     ocamlc_byte_exit_status = "0";
+     ocamlc.byte;
+   }
+
+   (* We don't issue warning 53 when -stop-after parsing or -stop-after typing
+      is passed *)
+   {
+     flags =
+       "-warn-error +53 -stop-after parsing -w +A-22-27-32-60-67-70-71-72";
+     compile_only = "true";
+     ocamlc_byte_exit_status = "0";
+     ocamlc.byte;
+   }
+   {
+     flags =
+       "-warn-error +53 -stop-after typing -w +A-22-27-32-60-67-70-71-72";
+     compile_only = "true";
+     ocamlc_byte_exit_status = "0";
+     ocamlc.byte;
+   }
+
+   (* We do issue warning 53 when -stop-after lambda (or later) is passed *)
+   {
+     flags =
+       "-warn-error +53 -stop-after lambda -w +A-22-27-32-60-67-70-71-72";
+     compile_only = "true";
+     ocamlc_byte_exit_status = "2";
+     ocamlc.byte;
+   }
+*)

diff --git a/testsuite/tests/warnings/w53_with_cmi.ml b/testsuite/tests/warnings/w53_with_cmi.ml
new file mode 100644 (file)
index 0000000..c1f0088
--- /dev/null
+++ b/testsuite/tests/warnings/w53_with_cmi.ml
@@ -0,0 +1,6 @@
+[@@@alert foo "foo"] (* rejected *)
+[@@@alert bar "bar"] (* rejected *)
+
+let x = 42
+
+[@@@alert xyz "xyz"] (* rejected *)

diff --git a/testsuite/tests/warnings/w53_with_cmi.mli b/testsuite/tests/warnings/w53_with_cmi.mli
new file mode 100644 (file)
index 0000000..e398a06
--- /dev/null
+++ b/testsuite/tests/warnings/w53_with_cmi.mli
@@ -0,0 +1,6 @@
+[@@@alert foo "foo(I)"] (* accepted *)
+[@@@alert bar "bar(I)"] (* accepted *)
+
+val x: int
+
+[@@@alert xyz "xyz"] (* rejected *)

diff --git a/testsuite/tests/warnings/w53_without_cmi.ml b/testsuite/tests/warnings/w53_without_cmi.ml
new file mode 100644 (file)
index 0000000..51c3a9e
--- /dev/null
+++ b/testsuite/tests/warnings/w53_without_cmi.ml
@@ -0,0 +1,11 @@
+[@@@alert foo "foo"] (* accepted *)
+[@@@alert bar "bar"] (* accepted *)
+
+let x = 42
+
+[@@@alert xyz "xyz"] (* rejected *)
+
+module Sub = struct
+  [@@@alert foo "foo"] (* rejected *)
+  let x = 42
+end

diff --git a/testsuite/tests/warnings/w74.ml b/testsuite/tests/warnings/w74.ml
new file mode 100644 (file)
index 0000000..b75acdb
--- /dev/null
+++ b/testsuite/tests/warnings/w74.ml
@@ -0,0 +1,105 @@
+(* TEST
+   flags = "-w +74";
+   expect;
+*)
+
+#debug true;;
+(* Being in debug mode is important here, because otherwise OCaml
+   compilers the pattern-matching differently (it shares more actions)
+   and does not introduce a Match_failure case in some examples
+   ('f' below), so those don't warn anymore. *)
+
+(* Warning expected. *)
+let f : bool * bool ref -> unit = function
+| (true, {contents = true}) -> ()
+| (_, r) when (r.contents <- true; false) -> assert false
+| (false, _) -> ()
+| (_, {contents = false}) -> ()
+[%%expect {|
+Lines 1-5, characters 34-31:
+1 | ..................................function
+2 | | (true, {contents = true}) -> ()
+3 | | (_, r) when (r.contents <- true; false) -> assert false
+4 | | (false, _) -> ()
+5 | | (_, {contents = false}) -> ()
+Warning 74 [degraded-to-partial-match]: This pattern-matching is compiled
+as partial, even if it appears to be total. It may generate a Match_failure
+exception. This typically occurs due to complex matches on mutable fields.
+(see manual section 13.5.5)
+
+val f : bool * bool ref -> unit = <fun>
+|}];;
+
+(* warning expected (concurrent mutations) *)
+let g : bool * bool ref -> unit = function
+| (true, {contents = true}) -> ()
+| (false, _) -> ()
+| (_, {contents = false}) -> ()
+[%%expect {|
+Lines 1-4, characters 34-31:
+1 | ..................................function
+2 | | (true, {contents = true}) -> ()
+3 | | (false, _) -> ()
+4 | | (_, {contents = false}) -> ()
+Warning 74 [degraded-to-partial-match]: This pattern-matching is compiled
+as partial, even if it appears to be total. It may generate a Match_failure
+exception. This typically occurs due to complex matches on mutable fields.
+(see manual section 13.5.5)
+
+val g : bool * bool ref -> unit = <fun>
+|}];;
+
+(* no warning expected (single read of the 'contents' field) *)
+let h : bool ref -> unit = function
+| {contents = true} -> ()
+| r when (r.contents <- true; false) -> assert false
+| {contents = false} -> ()
+[%%expect {|
+val h : bool ref -> unit = <fun>
+|}];;
+
+(* Check that the warning can be disabled.
+
+   FAIL: currently one cannot locally disable the warnings emitted
+   during Lambda production, only the type-checking warnings.
+*)
+let f : bool * bool ref -> unit = fun p ->
+  match[@warning "-74"] p with
+  | (true, {contents = true}) -> ()
+  | (_, r) when (r.contents <- true; false) -> assert false
+  | (false, _) -> ()
+  | (_, {contents = false}) -> ()
+[%%expect {|
+Lines 2-6, characters 2-33:
+2 | ..match[@warning "-74"] p with
+3 |   | (true, {contents = true}) -> ()
+4 |   | (_, r) when (r.contents <- true; false) -> assert false
+5 |   | (false, _) -> ()
+6 |   | (_, {contents = false}) -> ()
+Warning 74 [degraded-to-partial-match]: This pattern-matching is compiled
+as partial, even if it appears to be total. It may generate a Match_failure
+exception. This typically occurs due to complex matches on mutable fields.
+(see manual section 13.5.5)
+
+val f : bool * bool ref -> unit = <fun>
+|}];;
+
+let f : bool * bool ref -> unit = function[@warning "-74"]
+| (true, {contents = true}) -> ()
+| (_, r) when (r.contents <- true; false) -> assert false
+| (false, _) -> ()
+| (_, {contents = false}) -> ()
+[%%expect {|
+Lines 1-5, characters 34-31:
+1 | ..................................function[@warning "-74"]
+2 | | (true, {contents = true}) -> ()
+3 | | (_, r) when (r.contents <- true; false) -> assert false
+4 | | (false, _) -> ()
+5 | | (_, {contents = false}) -> ()
+Warning 74 [degraded-to-partial-match]: This pattern-matching is compiled
+as partial, even if it appears to be total. It may generate a Match_failure
+exception. This typically occurs due to complex matches on mutable fields.
+(see manual section 13.5.5)
+
+val f : bool * bool ref -> unit = <fun>
+|}];;

diff --git a/testsuite/tools/expect.ml b/testsuite/tools/expect.ml
index be0e5dbd4a5d24cd8c967a79a3b70be769f8161c..3de4baad1f07cdd9714bd4e3be8ad3f315c5cbae 100644 (file)
--- a/testsuite/tools/expect.ml
+++ b/testsuite/tools/expect.ml
@@ -66,7 +66,7 @@ let match_expect_extension (ext : Parsetree.extension) =
     in
     let string_constant (e : Parsetree.expression) =
       match e.pexp_desc with
-      | Pexp_constant (Pconst_string (str, _, Some tag)) ->
+      | Pexp_constant {pconst_desc = Pconst_string (str, _, Some tag); _} ->
         { str; tag }
       | _ -> invalid_payload ()
     in

diff --git a/tools/bump-magic-numbers b/tools/bump-magic-numbers
index e4d5de9336efa23729ba400568146d06fd3e041b..de29e27bba240df259124507e2ce4cc9aa1123c6 100755 (executable)
--- a/tools/bump-magic-numbers
+++ b/tools/bump-magic-numbers
@@ -51,6 +51,12 @@ sed -e s/'...|magic}'/"$new_num|magic}"/ \
   utils/config.common.ml > utils/config.common.ml.tmp
 mv utils/config.common.ml.tmp utils/config.common.ml
 
+# Bump magic numbers in otherlibs/dynlink/dynlink_config.ml
+
+sed -e s/'...|magic}'/"$new_num|magic}"/ \
+  otherlibs/dynlink/dynlink_config.ml > otherlibs/dynlink/dynlink_config.ml.tmp
+mv otherlibs/dynlink/dynlink_config.ml.tmp otherlibs/dynlink/dynlink_config.ml
+
 # Bump magic numbers in build-aux/ocaml_version.m4
 
 sed -e s/'m4_define(\[MAGIC_NUMBER__VERSION\], \[...\])'/"m4_define([MAGIC_NUMBER__VERSION], [$new_num])"/ \

diff --git a/tools/check-typo-since b/tools/check-typo-since
index fcd01457a58e49a22c7ae3d9db7baf12e0e53c89..ab0fb5c147fc4ec7d67e9c797bad221344aff0e5 100755 (executable)
--- a/tools/check-typo-since
+++ b/tools/check-typo-since
@@ -20,7 +20,7 @@
 
 check_typo_since() {
   CHECK_TYPO=$(dirname $0)/check-typo
-  git diff --name-only $1 \
+  git -c core.quotePath=false diff --name-only $1 \
   | (while IFS= read -r path
   do
     if test -e "$path"; then :; else continue; fi

diff --git a/tools/ci/actions/runner.sh b/tools/ci/actions/runner.sh
index 10f593ef26052d02a3de46f5941a59fbbe05ba64..b78b53f8a3192801acd6db5b9707a234cb8c6ced 100755 (executable)
--- a/tools/ci/actions/runner.sh
+++ b/tools/ci/actions/runner.sh
@@ -181,6 +181,7 @@ BasicCompiler () {
   ./configure --disable-dependency-generation \
               --disable-debug-runtime \
               --disable-instrumented-runtime \
+              --enable-ocamltest \
       || failed=$?
   if ((failed)) ; then cat config.log ; exit $failed ; fi
 

diff --git a/tools/ci/inria/main b/tools/ci/inria/main
index 67d27aac53a4fb5b48e0e93d58bda9458972988b..5ece025cb4fc71a4e7df9fa19ce0826fe402a831 100755 (executable)
--- a/tools/ci/inria/main
+++ b/tools/ci/inria/main
@@ -161,7 +161,8 @@ cleanup=false
 check_make_alldepend=false
 jobs=''
 bootstrap=false
-init_submodule=false
+init_submodule_flexdll=false
+init_submodule_winpthreads=false
 
 memory_model_tests="tests/memory-model/forbidden.ml \
 tests/memory-model/publish.ml"
@@ -192,7 +193,7 @@ case "${OCAML_ARCH}" in
     instdir='C:/ocamlmgw'
     cleanup=true
     check_make_alldepend=true
-    init_submodule=true
+    init_submodule_flexdll=true
   ;;
   mingw64)
     build='--build=x86_64-pc-cygwin'
@@ -200,21 +201,23 @@ case "${OCAML_ARCH}" in
     instdir='C:/ocamlmgw64'
     cleanup=true
     check_make_alldepend=true
-    init_submodule=true
+    init_submodule_flexdll=true
   ;;
   msvc)
     build='--build=i686-pc-cygwin'
     host='--host=i686-pc-windows'
     instdir='C:/ocamlms'
     cleanup=true
-    init_submodule=true
+    init_submodule_flexdll=true
+    init_submodule_winpthreads=true
   ;;
   msvc64)
     build='--build=x86_64-pc-cygwin'
     host='--host=x86_64-pc-windows'
     instdir='C:/ocamlms64'
     cleanup=true
-    init_submodule=true
+    init_submodule_flexdll=true
+    init_submodule_winpthreads=true
   ;;
   *) arch_error;;
 esac
@@ -240,10 +243,20 @@ fi
 pwd
 cd "$jenkinsdir"
 
-if $init_submodule; then
+if $init_submodule_flexdll; then
   git submodule update --init flexdll
 elif [ -f flexdll/Makefile ]; then
-  git submodule deinit --force flexdll
+  if grep -Fq flexdll .gitmodules; then
+    git submodule deinit --force flexdll
+  fi
+fi
+
+if $init_submodule_winpthreads; then
+  git submodule update --init winpthreads
+elif [ -f winpthreads/Makefile.in ]; then
+  if grep -Fq winpthreads .gitmodules; then
+    git submodule deinit --force winpthreads
+  fi
 fi
 
 #########################################################################

diff --git a/tools/ci/inria/sanitizers/script b/tools/ci/inria/sanitizers/script
index 20e36f1e1ab7213f4f99fa14006967c742db8dad..c406f529ce273e9c8981dee7723330776810a6ca 100755 (executable)
--- a/tools/ci/inria/sanitizers/script
+++ b/tools/ci/inria/sanitizers/script
@@ -47,20 +47,24 @@ else
   run_testsuite="$make -C testsuite all"
 fi
 
+# Figure out which version of llvm/clang to use
+llvm_version=$(clang -dumpversion | cut -d . -f 1)
+clang=clang-${llvm_version}
+llvm_bin_dir=/usr/lib/llvm-${llvm_version}/bin
+
 # A tool that makes error backtraces nicer
-# Need to pick the one that matches clang-14 and is named "llvm-symbolizer"
-# (/usr/bin/llvm-symbolizer-14 doesn't work, that would be too easy)
-export ASAN_SYMBOLIZER_PATH=/usr/lib/llvm-14/bin/llvm-symbolizer
+# Need to pick the one that matches clang's version and is named
+# "llvm-symbolizer" (/usr/bin/llvm-symbolizer-xx doesn't work,
+# that would be too easy)
+export ASAN_SYMBOLIZER_PATH=${llvm_bin_dir}/llvm-symbolizer
 export TSAN_SYMBOLIZER_PATH="$ASAN_SYMBOLIZER_PATH"
 
 #########################################################################
 
-echo "======== clang 14, address sanitizer, UB sanitizer =========="
+echo "======== clang ${llvm_version}, address sanitizer, UB sanitizer ========"
 
 git clean -q -f -d -x
 
-# # Use clang 14
-
 # These are the undefined behaviors we want to check
 # Others occur on purpose e.g. signed arithmetic overflow
 ubsan="\
@@ -77,13 +81,56 @@ shift-exponent,\
 unreachable"
 
 # Select address sanitizer and UB sanitizer, with trap-on-error behavior
-sanitizers="-fsanitize=address -fsanitize-trap=$ubsan"
-
+sanitizers="-fsanitize=address -fsanitize=$ubsan -fno-sanitize-recover=all"
+export UBSAN_OPTIONS="print_stacktrace=1"
 # Don't optimize too much to get better backtraces of errors
+CFLAGS="-Og -g -fno-omit-frame-pointer $sanitizers"
+LDFLAGS="$sanitizers -Og -g"
+CC=$clang
+
+# Test that UBSAN works
+cat >ubsan.c <<EOF
+#include <stdbool.h>
+#include <string.h>
+
+int main(int argc, char **argv) {
+  int x = 100;
+  bool b;
+  memcpy(&b, &x, sizeof(b));
+
+  return b;
+}
+EOF
+
+$CC $CFLAGS -c ubsan.c
+$CC $LDFLAGS ubsan.o -o ubsan
+
+./ubsan && exit 2
+test $? -eq 1
+rm -f ubsan ubsan.o ubsan.c
+
+# Test that ASAN works
+cat >asan.c <<EOF
+#include <stdlib.h>
+
+int main(int argc, char **argv) {
+  char* x = malloc(4);
+  free(x);
+  free(x);
+  return x[argc];
+}
+EOF
+
+$CC $CFLAGS -c asan.c
+$CC $LDFLAGS asan.o -o asan
+./asan && exit 2
+test $? -eq 1
+rm -f asan asan.o asan.c
 
 ./configure \
-  CC=clang-14 \
-  CFLAGS="-O1 -fno-omit-frame-pointer $sanitizers" \
+  CC="$CC" \
+  CFLAGS="$CFLAGS" \
+  LDFLAGS="$LDFLAGS" \
   --disable-stdlib-manpages --enable-dependency-generation
 
 # Build the system.  We want to check for memory leaks, hence
@@ -114,14 +161,14 @@ ASAN_OPTIONS="detect_leaks=0,use_sigaltstack=0" $run_testsuite
 # Initially intended to detect data races in OCaml programs and C stubs, it has
 # proved effective at also detecting races in the runtime (see #11040).
 
-echo "======== clang 14, thread sanitizer =========="
+echo "======== clang ${llvm_version}, thread sanitizer ========"
 
 git clean -q -f -d -x
 
 ./configure \
-  CC=clang-14 \
+  CC="$CC" \
   --enable-tsan \
-  CFLAGS="-DTSAN_INSTRUMENT_ALL" \
+  CPPFLAGS="-DTSAN_INSTRUMENT_ALL" \
   --disable-stdlib-manpages --enable-dependency-generation
 
 # Build the system
@@ -137,7 +184,7 @@ TSAN_OPTIONS="" $run_testsuite
 # Some alarms are reported that look like false positive
 # and are impossible to debug.
 
-# echo "======== clang 6.0, memory sanitizer =========="
+# echo "======== clang ${llvm_version}, memory sanitizer ========"
 
 # git clean -q -f -d -x
 
@@ -148,8 +195,9 @@ TSAN_OPTIONS="" $run_testsuite
 # # Don't optimize at all to get better backtraces of errors
 
 # ./configure \
-#   CC=clang-9 \
+#   CC="$CC" \
 #   CFLAGS="-O0 -g -fno-omit-frame-pointer -fsanitize=memory" \
+#   LDFLAGS="-fsanitize=memory" \
 #   --disable-native-compiler
 # # A tool that makes error backtraces nicer
 # # Need to pick the one that matches clang-6.0

diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
index 10fff70c4a84f12ba69cbcd9bfdebf5e76d0b95f..abe23216c7857ec287564b104570b7374287f478 100644 (file)
--- a/tools/dumpobj.ml
+++ b/tools/dumpobj.ml
@@ -161,8 +161,9 @@ let print_getglobal_name ic =
     if n >= Array.length !globals || n < 0
     then print_string "<global table overflow>"
     else match !globals.(n) with
-         | Glob glob -> print_string
-                       (Format.asprintf "%a" Symtable.Global.description glob)
+         | Glob glob ->
+             let desc = Format_doc.compat Symtable.Global.description in
+             print_string (Format.asprintf "%a" desc glob)
          | Constant obj -> print_obj obj
   end
 
@@ -190,8 +191,8 @@ let print_setglobal_name ic =
     then print_string "<global table overflow>"
     else match !globals.(n) with
          | Glob glob ->
-             print_string
-               (Format.asprintf "%a" Symtable.Global.description glob)
+             let desc = Format_doc.compat Symtable.Global.description in
+             print_string (Format.asprintf "%a" desc glob)
          | Constant _ -> print_string "<unexpected constant>"
   end
 

diff --git a/tools/eqparsetree.ml b/tools/eqparsetree.ml
index 819d49f70e0dc9b01e18756e3ff69ffa8566f3c2..c453fb5aefab921eac911170d1d83c50977114d2 100644 (file)
--- a/tools/eqparsetree.ml
+++ b/tools/eqparsetree.ml
@@ -60,7 +60,8 @@ end
 module Asttypes = struct
   open Asttypes
   let eq_constant : (constant * constant) -> 'result =
-    function
+    fun (a, b) ->
+    match a.pconst_desc, b.pconst_desc with
     | (Const_int a0, Const_int b0) -> eq_int (a0, b0)
     | (Const_char a0, Const_char b0) -> eq_char (a0, b0)
     | (Const_string a0, Const_string b0) -> eq_string (a0, b0)

diff --git a/tools/gdb-macros b/tools/gdb-macros
index 6b12b3b86b7a4f50b66a2dbe061eddadb224225f..21389a0775f6b6b78eefdf474068456d98641dbc 100644 (file)
--- a/tools/gdb-macros
+++ b/tools/gdb-macros
@@ -16,8 +16,7 @@
 # A set of macros for low-level debugging of OCaml programs and of the
 # OCaml runtime itself (both native and byte-code).
 
-# Advice to future developers: rewrite this in Python which will be
-# faster, more reliable, and more maintainable. See also gdb_ocamlrun.py
+printf "These GDB macros are deprecated. Use tools/gdb.py instead.\n"
 
 # This file should be loaded in gdb with [ source gdb-macros ].
 # It defines a few related commands:

diff --git a/tools/gdb.py b/tools/gdb.py
new file mode 100644 (file)
index 0000000..15953ee
--- /dev/null
+++ b/tools/gdb.py
@@ -0,0 +1,282 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                 Stephen Dolan, University of Cambridge                 *
+#*                                                                        *
+#*   Copyright 2016 Stephen Dolan.                                        *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+import gdb
+
+# When running inside GDB, the current directory isn't automatically
+# found, so we hack the path to find ocaml.py.
+import sys
+import os
+sys.path.append(os.path.dirname(__file__))
+
+import ocaml
+
+# These three classes (GDBType, GDBValue, GDBTarget) provide a
+# generic interface to the debugger, to allow debugger-agnostic code
+# in ocaml.py to access debugger and process state.  For a description
+# of the required slots and methods, see ocaml.py.
+
+class GDBType:
+    def __init__(self, t):
+        self._t = t
+
+    def pointer(self):
+        return GDBType(self._t.pointer())
+
+    def array(self, size):
+        # Amazing mis-feature in the GDB interface: the argument
+        # of the `array` method is the inclusive upper index bound,
+        # while the lower bound is zero. So we need to pass size-1,
+        return GDBType(self._t.array(size-1))
+
+    def size(self):
+        return self._t.sizeof
+
+class GDBValue:
+    def __init__(self, v, target):
+        self._v = v
+        self._target = target
+
+    def valid(self):
+        # unclear what else this could mean for GDB
+        return not (self._v.is_optimized_out)
+
+    def unsigned(self):
+        bits = int(self._v)
+        if bits < 0:
+            bits += (1 << (self._target.word_size * 8))
+        return bits
+
+    def signed(self):
+        return int(self._v)
+
+    def type(self):
+        return GDBType(self._v.type)
+
+    def cast(self, t):
+        return GDBValue(self._v.cast(t._t), self._target)
+
+    def value(self):
+        return self.cast(self._target._value_type)
+
+    def pointer(self):
+        return self.cast(self._target._value_ptr_type)
+
+    def dereference(self):
+        return GDBValue(self._v.dereference(), self._target)
+
+    def struct(self):
+        return {f.name: GDBValue(self._v[f], self._target)
+                for f in self._v.type.fields()}
+
+    def array_size(self):
+        range = self._v.type.range()
+        return range[1]-range[0]+1
+
+    def sub(self, index):
+        return GDBValue(self._v[index], self._target)
+
+    def field(self, index):
+        res = ((self._v.cast(self._target._value_ptr_type._t) + index)
+               .dereference())
+        return GDBValue(res, self._target)
+
+    def field_pointer(self, index):
+        return GDBValue(self._v.cast(self._target._value_ptr_type._t) + index,
+                        self._target)
+
+    def byte_field(self, index):
+        return GDBValue((self._v.cast(self._target._char_ptr_type._t) + index)
+                        .dereference(), self._target)
+
+    def double_field(self, index):
+        return float((self._v.cast(self._target._double_ptr_type._t) + index)
+                     .dereference())
+
+    def string(self, length):
+        return (bytes(gdb.selected_inferior().read_memory(self._v, length))
+                .decode('UTF-8'))
+
+    def c_string(self):
+        return self.cast(self._target._char_ptr_type)._v.string()
+
+    def field_array(self, offset, size):
+        ptr = self._v.cast(self._target._value_ptr_type._t) + offset
+        field0 = ptr.dereference()
+        return field0.cast(field0.type.array(size-1))
+
+    def double_array(self, size):
+        return self._v.cast(self._target._double_type.array(size-1)._t)
+
+class GDBTarget:
+    def __init__(self):
+        self._value_type = GDBType(gdb.lookup_type('value'))
+        self._value_ptr_type = self._value_type.pointer()
+        self._uintnat_type = GDBType(gdb.lookup_type('uintnat'))
+        self._uintnat_ptr_type = self._uintnat_type.pointer()
+        self._double_type = GDBType(gdb.lookup_type('double'))
+        self._double_ptr_type = self._double_type.pointer()
+        self._char_type = GDBType(gdb.lookup_type('char'))
+        self._char_ptr_type = self._char_type.pointer()
+
+        self.word_size = self._value_type.size()
+        self.double_size = self._double_type.size()
+
+    def global_variable(self, name):
+        sym = gdb.lookup_symbol(name, domain=gdb.SYMBOL_VAR_DOMAIN)
+        return GDBValue(sym[0].value(), self)
+
+    def type(self, typename):
+        return GDBType(gdb.lookup_type(typename))
+
+    def symbol(self, address):
+        # Annoyingly GDB doesn't provide a progspace.symbol_of_pc()
+        # and gdb doesn't recognise OCaml functions as "functions"
+        # for the purposes of progspace.block_of_pc(). So we
+        # use a GDB command to get at the symbol.
+        text = gdb.execute(f'info symbol 0x{address:x}', to_string=True)
+        if not text.startswith('No symbol matches'):
+            len = text.find(' in section ')
+            if len > 0:
+                return text[:len]
+
+    def mapping(self, addr):
+        # Annoyingly the progspace.solib_name() and
+        # objfile_for_address() functions either aren't reliably
+        # present on older versions of GDB, or return unhelpful
+        # answers. So we use parse the output of `info proc mapping`.
+        # This may be fragile to changes in GDB.
+        text = gdb.execute('info proc mappings', to_string=True)
+        all_mappings = [m.split() for m in text.split('\n') if '0x' in m]
+        mappings = [m for m in all_mappings
+                    if int(m[0],0) <= addr < int(m[1],0)]
+        if not mappings:
+            return
+        file_mappings = [m[5] for m in mappings
+                         if len(m) > 5
+                         and not m[5].startswith('[')]
+        # will be surprising if there's more than one of these
+        if file_mappings:
+            return ', '.join(file_mappings)
+
+    def value(self, v):
+        return GDBValue(gdb.Value(v).cast(self._value_type._t),
+                        self)
+
+# Object obeying Python's iterator protocol, for iterating through the
+# children of a value. This gives us slightly nicer display of block
+# values.
+
+class BlockChildren:
+    def __init__(self, value):
+        self.value = value
+        self.index = 0
+
+    def __iter__(self):
+        return self
+
+    def __next__(self):
+        if self.index >= self.value.num_children:
+            raise StopIteration
+        element = self.value.child(self.index)
+        if isinstance(element, GDBValue):
+            element = element._v
+        res = (str(self.index), element)
+        self.index += 1
+        return res
+
+# For pretty-printing values, GDB needs an object with a to_string
+# method.  Rather than pushing that into ocaml.Value, we wrap that
+# class in a GDB-specific one here.
+
+class ValuePrinter:
+    def __init__(self, value):
+        target = GDBTarget()
+        self._v = ocaml.Value(GDBValue(value, target), target)
+
+    def to_string(self):
+        return str(self._v)
+
+    # For pretty-printing block values with children, we
+    # need a number of additional methods (which basically
+    # delegate to the BlockChildren class above).
+
+    def display_hint(self):
+        if self._v.children:
+            return 'array'
+        else:
+            return None
+
+    def children(self):
+        return BlockChildren(self._v)
+
+    def num_children(self):
+        return self._v.num_children
+
+    def child(self, n):
+        return self._v.child(n)
+
+# The actual GDB pretty-printer.
+
+def value_printer(val):
+    if str(val.type) != 'value':
+        return None
+    return ValuePrinter(val)
+
+gdb.pretty_printers = [value_printer]
+
+# Interface to OCaml block finder
+
+class OCamlCommand(gdb.Command):
+    "Prefix of all GDB commands for debugging OCaml."
+    def __init__(self):
+        super(OCamlCommand, self).__init__("ocaml",
+                                           gdb.COMMAND_USER, prefix=True)
+
+OCamlCommand()
+
+class OCamlFind(gdb.Command):
+    "ocaml find <expr>: report the location of <expr> on the OCaml heap."
+    def __init__(self):
+        super(OCamlFind, self).__init__("ocaml find", gdb.COMMAND_USER)
+
+    def invoke(self, arg, from_tty):
+        self.dont_repeat()
+        target = GDBTarget()
+        val = ocaml.Value(GDBValue(gdb.parse_and_eval(arg),
+                                   target),
+                          target)
+        ocaml.Finder(target).find(arg, val)
+
+OCamlFind()
+
+# A convenience function $Array which casts a value to an array of values.
+
+class Array(gdb.Function):
+    """Turns a Caml value into an array."""
+    def __init__ (self):
+        super (Array, self).__init__ ("Array")
+
+    def invoke (self, val):
+        assert str(val.type) == 'value'
+        target = GDBTarget()
+        v = ocaml.Value(GDBValue(val, target), target)
+        return v.child_array()
+
+Array()
+
+print("OCaml support module loaded. Values of type 'value' will now\n"
+      "print as OCaml values, there is a $Array() convenience function,\n"
+      "and an 'ocaml' command is available for heap exploration\n"
+      "(see 'help ocaml' for more information).")

diff --git a/tools/gdb_ocamlrun.py b/tools/gdb_ocamlrun.py
index d01deddd0894b2ce99035a73c7192d9543bc56b1..ba322085559b31065bbc51dbd683c898b36dabbb 100644 (file)
--- a/tools/gdb_ocamlrun.py
+++ b/tools/gdb_ocamlrun.py
@@ -166,3 +166,5 @@ def value_printer(val):
     return BlockPrinter(val)
 
 gdb.pretty_printers = [value_printer]
+
+print("These GDB extensions are deprecated. Use tools/gdb.py instead.")

diff --git a/tools/lintapidiff.ml b/tools/lintapidiff.ml
index 58f44b7d770b5e2c8697b95175e4e8dcebee15bc..fa93c83a17bef08237dbe7edee579f4b1b700fa6 100644 (file)
--- a/tools/lintapidiff.ml
+++ b/tools/lintapidiff.ml
@@ -85,7 +85,8 @@ module Doc = struct
 
   let get_doc lst attrs = match find_attr lst attrs with
     | Some { attr_payload = PStr [{pstr_desc=Pstr_eval(
-        {pexp_desc=Pexp_constant(Pconst_string (doc, _,_));_}, _);_}]}
+        {pexp_desc=Pexp_constant
+             {pconst_desc=Pconst_string (doc, _,_)};_}, _);_}]}
       when doc <> "/*" && doc <> "" -> Some doc
     | _ -> None
 

diff --git a/tools/lldb.py b/tools/lldb.py
new file mode 100644 (file)
index 0000000..e1d6a60
--- /dev/null
+++ b/tools/lldb.py
@@ -0,0 +1,288 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                           Nick Barnes, Tarides                         *
+#*                                                                        *
+#*   Copyright 2024 Tarides.                                              *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+import lldb
+import ocaml
+
+def __lldb_init_module(d, _internal_dict):
+    global debugger
+    debugger = d
+    d.HandleCommand('type summary add --python-function '
+                    f'{__name__}.show_value value')
+    d.HandleCommand('command container add '
+                    '-h "OCaml runtime debugging utilities" '
+                    'ocaml')
+    d.HandleCommand('command script add --class '
+                    f'{__name__}.OCamlFind '
+                    'ocaml find'
+                    )
+    print("OCaml support module loaded. Values of type 'value' will now\n"
+          "print as OCaml values, and an 'ocaml' command is available for\n"
+          "heap exploration (see 'help ocaml' for more information).")
+
+    # Synthetic Child providers don't seem so useful
+    # d.HandleCommand("type synthetic add value --python-class "
+    #                f"{__name__}.ChildProvider")
+
+class OCamlFind:
+    def __init__(self, debugger, internal_dict):
+        super()
+
+    def __call__(self, debugger, expr, exe_ctx, result):
+        target = get_target()
+        finder = ocaml.Finder(target)
+        val = ocaml.Value(LLDBValue(exe_ctx.GetFrame().EvaluateExpression(expr),
+                                    target),
+                          target)
+        finder.find(expr, val)
+
+    def get_short_help(self):
+        return "Describe the location of the given OCaml value in the heap."
+    def get_long_help(self):
+        return "Describe the location of the given OCaml value in the heap."
+
+
+# These three classes (LLDBType, LLDBValue, LLDBTarget) provide a
+# generic interface to the debugger, to allow debugger-agnostic code
+# in ocaml.py to access debugger and process state.  For a description
+# of the required slots and methods, see ocaml.py.
+
+class LLDBType:
+    def __init__(self, t):
+        self._t = t
+
+    def pointer(self):
+        return LLDBType(self._t.GetPointerType())
+
+    def array(self, size):
+        return LLDBType(self._t.GetArrayType(size))
+
+    def size(self):
+        return self._t.size
+
+
+class LLDBValue:
+    def __init__(self, v, target):
+        self._v = v
+        self._target = target
+
+    def valid(self):
+        return self._v.IsValid()
+
+    def unsigned(self):
+        return self._v.unsigned
+
+    def signed(self):
+        return self._v.signed
+
+    def type(self):
+        return LLDBType(self._v.type)
+
+    def cast(self, t):
+        return LLDBValue(self._v.Cast(t._t), self._target)
+
+    def value(self):
+        return self.cast(self._target._value_type)
+
+    def pointer(self):
+        return self.cast(self._target._value_ptr_type)
+
+    def dereference(self):
+        return LLDBValue(self._v.Dereference(), self._target)
+
+    def struct(self):
+        t = self._v.GetType()
+        fields = t.GetNumberOfFields()
+        return {member.name:
+                    LLDBValue(self._v.GetChildMemberWithName(member.name),
+                              self._target)
+                for i in range(t.GetNumberOfFields())
+                if (member := t.GetFieldAtIndex(i))}
+
+    def array_size(self):
+        return self._v.GetNumChildren()
+
+    def sub(self, index):
+        return LLDBValue(self._v.GetChildAtIndex(index,
+                                                 lldb.eNoDynamicValues,
+                                                 False),
+                         self._target)
+
+    def field(self, index):
+        address = self.unsigned() + index * self._target.word_size
+        return self._target._create_value(f'[{index}]', address,
+                                          self._target._value_type)
+
+    def field_pointer(self, index):
+        return LLDBValue(self.field(index)._v.AddressOf(), self._target)
+
+    def byte_field(self, index):
+        ptr = self._v.Cast(self._target._char_ptr_type._t)
+        return LLDBValue(ptr.GetChildAtIndex(index,
+                                             lldb.eNoDynamicValues,
+                                             True),
+                         self._target)
+
+    # converts to/from a string; could use GetValueAsUnsigned and the
+    # `struct` module instead.
+    def double_field(self, index):
+        ptr = self._v.Cast(self._target._double_ptr_type._t)
+        return float(ptr.GetChildAtIndex(index,
+                                         lldb.eNoDynamicValues,
+                                         True)
+                     .GetValue())
+
+    def string(self, length):
+        return self._target._memory(self.unsigned(), length).decode('UTF-8')
+
+    def c_string(self):
+        return self._target._c_string(self.unsigned())
+
+    def field_array(self, offset, size):
+        address = self.unsigned() + offset * self._target.word_size
+        val = self._target._create_value('[]', address,
+                                         self._target._value_type.array(size))
+
+    def double_array(self, size):
+        return self._v.Cast(self._target._double_type.array(size)._t)
+
+class LLDBTarget:
+    def __init__(self, target):
+        self._target = target
+        self._value_type = LLDBType(target.FindFirstType("value"))
+        self._value_ptr_type = self._value_type.pointer()
+        self._double_type = LLDBType(target.FindFirstType("double"))
+        self._double_ptr_type = self._double_type.pointer()
+        self._char_type = LLDBType(target.FindFirstType("char"))
+        self._char_ptr_type = self._char_type.pointer()
+
+        self.word_size = self._value_type.size()
+        self.double_size = self._double_type.size()
+
+    def global_variable(self, name):
+        return LLDBValue(self._target.FindFirstGlobalVariable(name),
+                         self)
+
+    def type(self, typename):
+        return LLDBType(self._target.FindFirstType(typename))
+
+    def symbol(self, address):
+        addr = lldb.SBAddress(address, self._target)
+        if addr.IsValid() and addr.symbol and addr.symbol.name:
+            return addr.symbol.name
+
+    def mapping(self, addr):
+        address = self._address(addr)
+        section = address.GetSection()
+        module = address.GetModule()
+        if section.name:
+            return f"{str(module.file)}:{section.name}"
+
+
+    def value(self, v):
+        return LLDBValue(self._target.EvaluateExpression(f"((value){v})"),
+                         self)
+
+    ## These methods are only used by methods inside LLDBValue and/or LLDBType
+
+    def _address(self, addr):
+        return lldb.SBAddress(addr, self._target)
+
+    def _memory(self, addr, len):
+        return self._target.process.ReadMemory(addr, len, lldb.SBError())
+
+    def _c_string(self, addr):
+        return self._target.process.ReadCStringFromMemory(addr, 256,
+                                                          lldb.SBError())
+
+    def _create_value(self, name, addr, ty):
+        val = self._target.CreateValueFromAddress(name,
+                                                  self._address(addr),
+                                                  ty._t)
+        return LLDBValue(val, self)
+
+targets = {}
+
+def get_target():
+    target = debugger.GetSelectedTarget()
+    # TODO: SBTarget not hashable, but we want something hashable to
+    # uniquely represent it, for advanced cases in which we end up
+    # with (for instance) more than one process in the same debugging
+    # session.
+    key = (target.triple, target.process.id)
+    if key not in targets:
+        targets[key] = LLDBTarget(target)
+    return targets[key]
+
+def show_value(value, _internal_dict, options):
+    target = get_target()
+    return str(ocaml.Value(LLDBValue(value, target), target))
+
+# A class like this for aggregate values should let LLDB show members
+# in a natural way, but I can't get it to work.
+
+class ChildProvider:
+    def __init__(self, value, internal_dict):
+        self.value = value
+        self.ocaml = None
+
+    def _update(self):
+        target = get_target()
+        self.ocaml = ocaml.Value(LLDBValue(self.value, target),
+                                 target)
+
+    def _ensure(self):
+        if self.ocaml is None:
+            self._update()
+
+    def has_children(self):
+        """Return True if the value might have children,
+        False if definitely not."""
+        self._ensure()
+        print(f"has_children called on {self.ocaml}")
+        return self.ocaml.children
+
+    def num_children(self):
+        "Return the number of children."
+        self._ensure()
+        print(f"num_children called on {self.ocaml}")
+        return self.ocaml.num_children
+
+    def get_child_index(self, name):
+        """Return the index of a child, given part of an expression
+        identifying a child. Evidently used by LLDB parser.
+        """
+        # this is pretty mysterious
+        self._ensure()
+        print(f"get_child_index called on {self.ocaml}")
+        return int(name.lstrip('[').rstrip(']'))
+
+    def get_child_at_index(self, index):
+        self._ensure()
+        return self.ocaml.child(index)
+
+    def update(self):
+        """Update the internal state whenever the state of the variables
+        in LLDB changes. Invoked before any other method in the interface."""
+        self._update()
+        print(f"update called on {self.ocaml}")
+
+    def get_value(self):
+        self._update()
+        print(f"get_value called on {self.ocaml}")
+        if self.ocaml.children:
+            return self.value.cast(
+                self.value.type.GetArrayType(self.ocaml.num_children))
+        else:
+            return self.value

diff --git a/tools/objinfo.ml b/tools/objinfo.ml
index 2092900794f11d468d481acf4d5bb7a561727671..83e36593141b4bc65f244e55c4b42356cc9c64fb 100644 (file)
--- a/tools/objinfo.ml
+++ b/tools/objinfo.ml
@@ -31,6 +31,7 @@ let no_crc = ref false
 let shape = ref false
 let index = ref false
 let decls = ref false
+let uid_deps = ref false
 
 module Magic_number = Misc.Magic_number
 
@@ -129,9 +130,32 @@ let print_cmt_infos cmt =
       cmt.cmt_ident_occurrences;
     Format.print_flush ()
   end;
+  if !uid_deps then begin
+    printf "\nUid dependencies:\n";
+    let arr = Array.of_list cmt.cmt_declaration_dependencies in
+    let () =
+      Array.sort (fun (_tr, u1, u2) (_tr', u1', u2') ->
+                    match Shape.Uid.compare u1 u1' with
+                    | 0 -> Shape.Uid.compare u2 u2'
+                    | n -> n) arr
+    in
+    Format.printf "@[<v>";
+    Array.iter (fun (rk, u1, u2) ->
+      let rk = match rk with
+        | Definition_to_declaration -> "<-"
+        | Declaration_to_declaration -> "<->"
+      in
+      Format.printf "@[<h>%a %s %a@]@;"
+        Shape.Uid.print u1
+        rk
+        Shape.Uid.print u2) arr;
+    Format.printf "@]";
+  end;
   if !decls then begin
     printf "\nUid of decls:\n";
-    Shape.Uid.Tbl.iter (fun uid item ->
+    let decls = Array.of_list (Shape.Uid.Tbl.to_list cmt.cmt_uid_to_decl) in
+    Array.sort (fun (uid, _) (uid', _) -> Shape.Uid.compare uid uid') decls;
+    Array.iter (fun (uid, item) ->
       let loc = match (item : Typedtree.item_declaration) with
         | Value vd -> vd.val_name
         | Value_binding vb ->
@@ -161,8 +185,8 @@ let print_cmt_infos cmt =
       Format.printf "@[<hov 2>%a:@ %a@]@;"
         Shape.Uid.print uid
         pp_loc loc)
-      cmt.cmt_uid_to_decl;
-      Format.print_flush ()
+      decls;
+    Format.print_flush ()
   end
 
 let print_general_infos name crc defines cmi cmx =
@@ -179,8 +203,8 @@ let print_global_table table =
   printf "Globals defined:\n";
   Symtable.iter_global_map
     (fun global _ ->
-       print_line
-         (Format.asprintf "%a" Symtable.Global.description global)
+       let desc = Format_doc.compat Symtable.Global.description in
+       print_line (Format.asprintf "%a" desc global)
     )
     table
 
@@ -433,9 +457,17 @@ let dump_obj filename =
   then dump_cmxs ic
   else exit_magic_error ~expected_kind:None (Parse_error head_error)
 
+let print_version () =
+  Format.printf "ocamlobjinfo, version %s@." Sys.ocaml_version;
+  exit 0
+
+let print_version_num () =
+  Format.printf "%s@." Sys.ocaml_version;
+  exit 0
+
 let arg_list = [
   "-quiet", Arg.Set quiet,
-    " Only print explicitely required information";
+    " Only print explicitly required information";
   "-no-approx", Arg.Set no_approx,
     " Do not print module approximation information";
   "-no-code", Arg.Set no_code,
@@ -446,7 +478,11 @@ let arg_list = [
     " Print a list of all usages of values, types, etc. in the module";
   "-decls", Arg.Set decls,
     " Print a list of all declarations in the module";
+  "-uid-deps", Arg.Set uid_deps,
+    " Print the declarations' uids dependencies of the module";
   "-null-crc", Arg.Set no_crc, " Print a null CRC for imported interfaces";
+  "-version", Arg.Unit print_version, " Print version and exit";
+  "-vnum", Arg.Unit print_version_num, " Print version number and exit";
   "-args", Arg.Expand Arg.read_arg,
      "<file> Read additional newline separated command line arguments \n\
      \      from <file>";

diff --git a/tools/ocaml.py b/tools/ocaml.py
new file mode 100644 (file)
index 0000000..81ad16f
--- /dev/null
+++ b/tools/ocaml.py
@@ -0,0 +1,645 @@
+#**************************************************************************
+#*                                                                        *
+#*                                 OCaml                                  *
+#*                                                                        *
+#*                           Nick Barnes, Tarides                         *
+#*                                                                        *
+#*   Copyright 2024 Tarides.                                              *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+# This file contains any debugger-agnostic code for debugger plugins.
+#
+# Each debugger front end has three ciasses - targets, types, and
+# values, which must provide these slots and methods:
+#
+# targets:
+#
+#     word_size: size of a word in 8-bit bytes.
+#
+#     double_size: the number of 8-bit bytes in a double-precision
+#        float (i.e. 8).
+#
+#     value(address): a debugger "value" representing the given address
+#         with type `value`.
+#
+#     global_variable(name): the value of a named global variable.
+#
+#     type(name): a named type.
+#
+#     symbol(address): the symbol name associated with the given address.
+#
+#     mapping(address): a string describing any file mapping
+#         associated with the address, or None. Blocks on the Caml
+#         heap do not have an associated file mapping.
+#
+# types:
+#
+#     size(): the number of bytes required for this type.
+#
+#     pointer(): the type of a pointer to this type.
+#
+#     array(size): the type of an array of given size of this type.
+#
+# values:
+#
+#     valid(): False if this value is somehow "invalid" (for example,
+#       optimised away.
+#
+#     type(): The type of this value.
+#
+#     unsigned(): the value as an unsigned integer.
+#
+#     signed(): the value as a signed integer.
+#
+#     cast(t): the value cast to type `t`.
+#
+#     value(): the value cast to the "value" Caml runtime type.
+#
+#     pointer(): the value cast to "value*"
+#
+#     dereference(): the result of dereferencing the value, which must
+#       be a pointer.
+#
+#     array_size(): only used when the value is an array, returns the
+#       number of entries in the array.
+#
+#     sub(index): only used when the value is an array, returns an
+#       entry, as a debugger value. TODO: switch to __getitem__ to make
+#       this more transparent.
+#
+#     struct(): a dictionary {slot_name: value} representing the value,
+#       which must be a struct. TODO: could use __getattribute__ to make
+#       this more transparent.
+#
+#     field(index): the `index`th field of a value array whose address is
+#       in the value, which can have any scalar type. `index` is a Python
+#       number which can have any value, including negative.
+#
+#     field_pointer(index): a pointer to the `index`th field (see above).
+#
+#     byte_field(index): a byte value, from a byte array.
+#
+#     double_field(index): a double-precision floating-point value
+#       from an array, as a Python float.
+#
+#     string(length): treating the value as an address, `length` bytes from
+#       memory, decoded as UTF-8, as a Python string.
+#
+#     c_string(): treating the value as an address, returns the NUL-terminated
+#       C string at the location as a Python string.
+#
+#     field_array(offset, size): an array of elements [offset,
+#       offset+size), as a debugger-native array.
+#
+#     double_array(size): an array of double-precision floating point
+#       members, as a debugger-native array.
+
+MAX_BLOCK_SLOTS = 8
+MAX_STRING_LEN = 80
+STRING_SUFFIX = 8
+STRING_PREFIX = MAX_STRING_LEN - STRING_SUFFIX - 5
+MAX_STRING_SUMMARY = 20
+STRING_SUMMARY_PREFIX = 8
+STRING_SUMMARY_SUFFIX = MAX_STRING_SUMMARY - STRING_SUMMARY_PREFIX - 5
+
+TAGS = {
+    244: 'Forcing',
+    245: 'Cont',
+    246: 'Lazy',
+    247: 'Closure',
+    248: 'Object',
+    249: 'Infix',
+    250: 'Forward',
+    251: 'Abstract',
+    252: 'String',
+    253: 'Double',
+    254: 'Double_array',
+    255: 'Custom'
+}
+
+# specific tag values which we display in particular ways.
+
+TAG_CLOSURE = 247
+TAG_INFIX = 249
+TAG_STRING = 252
+TAG_DOUBLE = 253
+TAG_DOUBLE_ARRAY = 254
+TAG_CUSTOM = 255
+
+# constants for header word decoding.
+
+HEADER_TAG_BITS = 8
+HEADER_TAG_MASK = (1 << HEADER_TAG_BITS) - 1
+
+HEADER_COLOR_BITS = 2
+HEADER_COLOR_SHIFT = HEADER_TAG_BITS
+HEADER_COLOR_MASK = ((1 << HEADER_COLOR_BITS) - 1) << HEADER_COLOR_SHIFT
+NOT_MARKABLE = 3 << HEADER_COLOR_SHIFT
+
+HEADER_WOSIZE_SHIFT = HEADER_TAG_BITS + HEADER_COLOR_BITS
+
+# tags of this or above indicate blocks with no scannable fields
+NO_SCAN_TAG = 251
+
+# The debug runtime fills free and uninitialized memory with words:
+#
+#             D7xx D6D8 on 32-bit platforms
+#   D7xx D7D7 D7xx D6D8 in 64-bit platforms
+#
+# where xx is one of the following 8-bit values, depending on the
+# context of the memory word.
+
+DEBUG_TAGS = {
+    0x00: 'free minor',
+    0x01: 'free major',
+    0x03: 'free shrink',
+    0x04: 'free truncate', # obsolete
+    0x05: 'free unused',
+    0x10: 'uninit minor',
+    0x11: 'uninit major',
+    0x15: 'uninit align',
+    0x85: 'filler align',
+    0x99: 'pool magic',
+}
+
+DEBUG_LOW_BYTES = [0xd8, 0xd6]
+DEBUG_OTHER = 0xd7
+DEBUG_TAG_BYTES = [2, 6]
+
+def debug_decode(word, word_size):
+    """If `word` is a debug padding word, return a string representation of
+it. Otherwise, return None. `target` is used for word size."""
+
+    if (word >> (word_size * 8)) not in {0,-1}:
+        return
+    bytes = [(word >> (i * 8)) & 0xff for i in range(word_size)]
+    if bytes[:len(DEBUG_LOW_BYTES)] != DEBUG_LOW_BYTES:
+        return
+    pads = set(bytes[i]
+               for i in range(len(DEBUG_LOW_BYTES), word_size)
+               if i not in DEBUG_TAG_BYTES)
+    if pads != {DEBUG_OTHER}: # not all pad bytes DEBUG_OTHER
+        return
+    tags = set(bytes[i] for i in DEBUG_TAG_BYTES if i < word_size)
+    if len(tags) != 1: # differing tags on 64-bits
+        return
+    tag = list(tags)[0] # unique tag byte
+    if tag not in DEBUG_TAGS:
+        return f'Debug(0x{tag:x}?!)'
+    return f'Debug({DEBUG_TAGS[tag]})'
+
+# we show colors as [x], for some character x:
+
+COLOR_SUMMARY = {
+    'MARKED': 'm',
+    'UNMARKED': 'u',
+    'GARBAGE': 'g',
+    'NOT MARKABLE': '-',
+}
+
+def colors(target):
+    """Return a dictionary value -> name of the current GC colors
+    (MARKED, UNMARKED, GARBAGE, NOT MARKABLE).
+    """
+
+    heapState = target.global_variable('caml_global_heap_state').struct()
+    cols = {v.unsigned(): (f, COLOR_SUMMARY[f])
+            for f, v in heapState.items()}
+    cols[NOT_MARKABLE] = ('NOT MARKABLE', '-')
+    return cols
+
+class Value:
+    def __init__(self, value, target):
+        self._value = value
+        self._target = target
+        self.children = False
+        self.num_children = 0
+        self.valid = value.valid()
+        if not self.valid:
+            return
+
+        self.word = value.signed()
+        if self.word == 0:
+            self.valid = False
+            return
+
+        self.immediate = (self.word & 1) == 1
+        if self.immediate:
+            return
+
+        self.debug = debug_decode(self.word, target.word_size)
+        if self.debug is not None:
+            return
+
+        self.pointer = value.pointer()
+        self._header = self.pointer.field(-1).unsigned()
+        self._wosize = self._header >> HEADER_WOSIZE_SHIFT
+        self._tag = self._header & HEADER_TAG_MASK
+        self._color_bits = self._header & HEADER_COLOR_MASK
+        self.children = True
+        self.num_children = self._wosize # overridden for some tags
+        if self._tag == TAG_DOUBLE:
+            self.children = False
+            self.num_children = 0
+        elif self._tag == TAG_DOUBLE_ARRAY:
+            self.num_children = ((self.num_children * target.word_size)
+                                 // target.double_size)
+        elif self._tag == TAG_STRING:
+            self.children = False
+            self.num_children = 0
+            byteSize = target.word_size * self._wosize
+            lastByte = value.byte_field(byteSize-1).unsigned()
+            self._length = byteSize-1-lastByte
+            if self._length > 0:
+                self._string = value.string(self._length)
+            else:
+                self._string = ''
+        elif self._tag == TAG_CLOSURE:
+            # collect code pointers and metadata for all functions
+            # in this closure.
+            self._functions = []
+            # list of (code, arity [, additional code]) tuples.
+            self._infix_map = {}
+            # map from infix offset to tuple
+            arity_shift = target.word_size * 8 - 8
+            closinfo = value.field(1).signed()
+            self._start_env = (closinfo & ((1 << arity_shift) - 1)) >> 1
+            self.num_children = self._wosize - self._start_env
+            block = 0
+            while block < self._start_env:
+                code = value.field(block).unsigned()
+                closinfo = value.field(block+1).unsigned()
+                arity = closinfo >> arity_shift
+                if (arity == 0) or (arity == 1):
+                    fn = (code, arity)
+                    bump = 0
+                else: # higher arity, so code is curry/tuplify
+                    true_code = value.field(block+2).unsigned()
+                    fn = (true_code, arity, code)
+                    bump = 1
+                self._functions.append(fn)
+                self._infix_map[block] = fn
+                block += 3 +bump # code, closinfo, [extra code], [infix header]
+        elif self._tag == TAG_INFIX:
+            self._container = Value(value.field_pointer(-self._wosize), target)
+            self.num_children = 0
+            self.children = False
+        elif self._tag == TAG_CUSTOM:
+            ptr_type = target.type('struct custom_operations').pointer()
+            self._ops = value.field(0).cast(ptr_type).dereference().struct()
+            self._id = self._ops['identifier'].c_string()
+            self.children = False
+            self.num_children = 0
+
+    def tag_part(self):
+        if self._tag in TAGS:
+            return f'{TAGS[self._tag]}'
+        elif self._tag == 0:
+            return ''
+        else:
+            return f't{self._tag}'
+
+    def infix_sym(self):
+        cont = self._container
+        sym = f'+{self._wosize}'
+        # try to find symbol in infix map of container
+        if cont._tag == TAG_CLOSURE: # always true!
+            if self._wosize in cont._infix_map:
+                code = cont._infix_map[self._wosize][0]
+                sym = self._target.symbol(code)
+                if sym is None:
+                    sym = f'0x{code:x}'
+        return sym
+
+    def code_sym(self, t):
+        code = t[0]
+        sym = self._target.symbol(code)
+        if sym is None:
+            sym = f'0x{code:x}'
+        if len(t) == 2:
+            return sym
+        else:
+            return f'{sym}({self._target.symbol(t[2])})'
+
+    def closure_syms(self):
+        return [self.code_sym(t) for t in self._functions]
+
+    def array_contents(self, short=False):
+        if self._tag == TAG_DOUBLE_ARRAY:
+            if self.num_children <= MAX_BLOCK_SLOTS:
+                return [str(self._value.double_field(i))
+                        for i in range(self.num_children)]
+            return ([str(self._value.double_field(i))
+                     for i in range(MAX_BLOCK_SLOTS-2)]
+                    + ['...',
+                       str(self._value.double_field(
+                           self.num_children - 1))])
+
+        if self.num_children < MAX_BLOCK_SLOTS:
+            return [self.field_summary(i, short)
+                    for i in range(self.num_children)]
+        else:
+            return ([self.field_summary(i, short)
+                     for i in range(MAX_BLOCK_SLOTS-2)]
+                    + ['...',
+                       self.field_summary(self.num_children - 1, short)])
+
+    def summary(self, short=False):
+        """Return a short value summary string, suitable for display in a
+        larger aggregate. If `short` then summarise the summary.
+        """
+        if not self.valid:
+            return '[invalid]'
+        if self.immediate:
+            return f'{self.word // 2}'
+        if self.debug is not None:
+            return self.debug
+
+        if self._tag == TAG_DOUBLE:
+            return str(self._value.double_field(0))
+        elif self._tag == TAG_STRING:
+            if self._length > MAX_STRING_SUMMARY:
+                return (repr(self._string[:STRING_SUMMARY_PREFIX])
+                        + '...'
+                        + repr(self._string[-STRING_SUMMARY_SUFFIX:])
+                        + f'<{self._length}>')
+            return repr(self._string)
+        elif self._tag == TAG_INFIX:
+            sym = self.infix_sym()
+            return f'infix({sym}) in ' + self._container.summary(short=True)
+        elif self._tag == TAG_CLOSURE:
+            syms = self.closure_syms()
+            if len(syms) > 1:
+                sym = f'{syms[0]}, +{len(syms)-1}'
+            else:
+                sym = syms[0]
+            return f'closure({sym})<{self.num_children}>'
+        elif self._tag == TAG_CUSTOM:
+            return f"custom {self._id}<{self._wosize}>"
+
+        tag_part = self.tag_part()
+
+        if short:
+            if not tag_part:
+                tag_part = 't0'
+            return f'<{tag_part}:{self.num_children}>'
+
+        if tag_part:
+            tag_part += ':'
+
+        contents = self.array_contents(short=True)
+
+        return (f'({tag_part}' + ', '.join(contents) + ')')
+
+
+    def field_summary(self, index, short=False):
+        return (Value(self._value.field(index), self._target).
+                summary(short))
+
+    def __str__(self):
+        if not self.valid:
+            return '[invalid]'
+        if self.immediate:
+            return f'caml:{self.word // 2}'
+        if self.debug is not None:
+            return f'Caml:{self.debug}'
+
+        color_char = colors(self._target).get(self._color_bits,
+                                         f'BAD COLOR {self._color_bits}')[1]
+        prefix = f'caml({color_char}):'
+
+        if self._tag == TAG_DOUBLE:
+            val = str(self._value.double_field(0))
+            return f'{prefix}{val}'
+        elif self._tag == TAG_STRING:
+            if self._length > MAX_STRING_LEN:
+                s = (repr(self._string[:STRING_PREFIX])
+                     + '...' + repr(self._string[-STRING_SUFFIX:]))
+            else:
+                s = repr(self._string)
+            return (f'{prefix}{s}<{self._length}>')
+        elif self._tag == TAG_INFIX:
+            sym = self.infix_sym()
+            return (f'{prefix}infix({sym}) in'
+                    + f' 0x{self._container._value.unsigned():x} '
+                    + self._container.summary())
+        elif self._tag == TAG_CLOSURE:
+            syms = ', '.join(self.closure_syms())
+            return (f'{prefix}closure({syms})'
+                    + f' arity {self._functions[0][1]} ('
+                    + ', '.join(self.field_summary(i + self._start_env)
+                                for i in range(self.num_children))
+                    + ')')
+        elif self._tag == TAG_CUSTOM:
+            return (f"{prefix}custom {self._id}"
+                    f"<{self._wosize}>")
+
+        tag_part = self.tag_part()
+        if self._tag != 0:
+            tag_part += ': '
+        suffix = ('' if self.num_children <= MAX_BLOCK_SLOTS
+                  else f'<{self.num_children}>')
+
+        contents = self.array_contents()
+
+        return (f'{prefix}({tag_part}'
+                + ', '.join(contents)
+                + f'){suffix}')
+
+    # Useful in GDB and maybe one day in LLDB too.
+
+    def child(self, index):
+        if (not self.children) or index < 0 or index >= self.num_children:
+            return
+        if self._tag == TAG_DOUBLE_ARRAY:
+            return self._value.double_field(index)
+        elif self._tag == TAG_CLOSURE:
+            return self._value.field(index + self._start_env).value()
+        else:
+            return self._value.field(index).value()
+
+    # Useful in GDB and maybe one day in LLDB too.
+
+    def child_array(self):
+        """If the value is a block which can be regarded as an array,
+        return the array as a debugger-native value."""
+        if (not self.children):
+            return
+        if self._tag == TAG_DOUBLE_ARRAY:
+            return self._value.double_array(self.num_children)
+        elif self._tag == TAG_CLOSURE:
+            return self._value.field_array(self._start_env, self.num_children)
+        else:
+            return self._value.field_array(0, self.num_children)
+
+POOL_WSIZE = 4096
+
+class Finder:
+    def __init__(self, target):
+        self._sizeclasses = None
+        self._wsize_sizeclass = None
+        self._target = target
+        self.debug = False
+
+    def sizeclasses(self):
+        if self._sizeclasses is None:
+            pool_freelist = (self._target.global_variable('pool_freelist').
+                             struct())
+            self._sizeclasses = (
+                pool_freelist['global_avail_pools'].type().size() //
+                pool_freelist['global_avail_pools'].sub(0).type().size())
+        return self._sizeclasses
+
+    def wsize_sizeclass(self, sz):
+        if self._wsize_sizeclass is None:
+            self._wsize_sizeclass = (self._target.
+                                     global_variable('wsize_sizeclass'))
+        return self._wsize_sizeclass.sub(sz).unsigned()
+
+    def _log(self, *args):
+        if self.debug:
+            print(*args)
+
+    def _found(self, where):
+        if self.debug:
+            print(f"FOUND 0x{self.address:x} {where}")
+        self.found.append(where)
+        self.keep_going = self.debug
+
+    def search_pool_list(self, description, pool_list):
+        "Search a single pool list for `self.address`."
+        count = 0
+        while self.keep_going and pool_list.unsigned():
+            count += 1
+            base = pool_list.unsigned()
+            limit = base + POOL_WSIZE * self._target.word_size
+            if base < self.address < limit:
+                self._found(f"{description}: pool 0x{base:x}-0x{limit:x}")
+            pool_list = pool_list.dereference().struct()['next']
+        self._log(f"    searched {count} pools of {description}")
+
+    def search_pools(self, description, pools):
+        "Search an array `pool *pools[NUM_SIZECLASSES]` for `self.address`."
+        self._log(f"  searching {description} pools")
+        for i in range(self.sizeclasses()):
+            pool_list = pools.sub(i)
+            if pool_list.unsigned() == 0:
+                continue
+            self.search_pool_list(f"{description} "
+                                  f"wsize={self.wsize_sizeclass(i)}",
+                                  pool_list)
+            if not self.keep_going:
+                break
+
+    def search_large(self, description, large_list):
+        "Search a `large_alloc *` linked list for `self.address`."
+        if large_list.unsigned() == 0:
+            return
+        count = 0
+        while self.keep_going and large_list.unsigned():
+            count += 1
+            base = large_list.unsigned()
+            block = base + large_list.dereference().type().size()
+            val = self._target.value(block + self._target.word_size)
+            val_ptr = val.cast(val.type().pointer())
+            oval = Value(val_ptr, self._target)
+            limit = block + (oval._wosize + 1) * self._target.word_size
+            if base < self.address < limit:
+                self._found(f"{description} large 0x{block:x}-0x{limit:x}")
+            large_list = large_list.dereference().struct()['next']
+        self._log(f"  searched {count} large blocks of {description}")
+
+    def search_heap(self, description, heap_state_p):
+        "Searches a single `struct caml_heap_state *` for self.address."
+        heap_state = heap_state_p.dereference().struct()
+        if self.keep_going:
+            self.search_pools(f"{description} avail",
+                              heap_state['avail_pools'])
+        if self.keep_going:
+            self.search_pools(f"{description} full",
+                              heap_state['full_pools'])
+        if self.keep_going:
+            self.search_pools(f"{description} unswept avail",
+                              heap_state['unswept_avail_pools'])
+        if self.keep_going:
+            self.search_pools(f"{description} unswept full",
+                              heap_state['unswept_full_pools'])
+        if self.keep_going:
+            self.search_large(f"{description}",
+                              heap_state['swept_large'])
+        if self.keep_going:
+            self.search_large(f"{description} unswept",
+                              heap_state['unswept_large'])
+
+    def search_domain(self, index, dom_state_p):
+        "Search a single domain's heap for `self.address`."
+        dom_state = dom_state_p.dereference().struct()
+        young_start = dom_state['young_start'].unsigned()
+        young_end = dom_state['young_end'].unsigned()
+        description = f"domain {index}"
+        self._log(f"searching {description}")
+        if self.keep_going and (young_start <= self.address <= young_end):
+                self._found(f"{description} minor heap "
+                            f"0x{young_start:x}-0x{young_end:x}")
+        if self.keep_going:
+            self.search_heap(description, dom_state['shared_heap'])
+
+    def find(self, expr, val):
+        if not val.valid:
+            print(f"{expr} not a valid expression")
+            return
+        if val.immediate:
+            print(f"{expr} is immediate: {str(val)}")
+            return
+        if val.debug is not None:
+            print(f"{expr} is a debug padding value: {val.debug}")
+            return
+
+        self.address = val.pointer.unsigned()
+        mapping = self._target.mapping(self.address)
+        if mapping:
+            print(f"{expr} {str(val)} is from {mapping}, "
+                  "not the heap.")
+            return
+
+        self.found = []
+        self.keep_going = True
+
+        # Search per-domain heaps.
+        all_domains = self._target.global_variable('all_domains')
+        Max_domains = all_domains.array_size()
+        self._log(f"{Max_domains} domains.")
+        for i in range(Max_domains):
+            dom = all_domains.sub(i).struct()
+            dom_state_p = dom['state']
+            if dom_state_p.unsigned() == 0: # null pointer: no domain
+                continue
+            self.search_domain(i, dom_state_p)
+            if not self.keep_going:
+                break
+
+        # Global (orphaned) heap
+        pool_freelist = self._target.global_variable('pool_freelist').struct()
+        if self.keep_going:
+            self.search_pools('global avail',
+                              pool_freelist['global_avail_pools'])
+        if self.keep_going:
+            self.search_pools('global full',
+                              pool_freelist['global_full_pools'])
+        if self.keep_going:
+            self.search_large("global",
+                              pool_freelist['global_large'])
+
+        if self.found:
+            print(f"{expr} {str(val)}: 0x{self.address:x} found:")
+            for where in self.found:
+                print(f"  {where}")
+        else:
+            print(f"{expr} {str(val)} not found on heap")
+
+        self.debug = True

diff --git a/tools/ocamlcmt.ml b/tools/ocamlcmt.ml
index 92014a2336e7b8dedad7eb70888f330e93f87fce..2cfef715d7ee279e3689c6672b1fb769a2e6fb5b 100644 (file)
--- a/tools/ocamlcmt.ml
+++ b/tools/ocamlcmt.ml
@@ -19,6 +19,14 @@ let print_info_arg = ref false
 let target_filename = ref None
 let save_cmt_info = ref false
 
+let print_version () =
+  Format.printf "ocamlcmt, version %s@." Sys.ocaml_version;
+  exit 0
+
+let print_version_num () =
+  Format.printf "%s@." Sys.ocaml_version;
+  exit 0
+
 let arg_list = Arg.align [
   "-o", Arg.String (fun s -> target_filename := Some s),
     "<file> Dump to file <file> (or stdout if -)";
@@ -29,6 +37,10 @@ let arg_list = Arg.align [
   "-src", Arg.Set gen_ml,
     " Convert .cmt or .cmti back to source code (without comments)";
   "-info", Arg.Set print_info_arg, " : print information on the file";
+  "-version", Arg.Unit print_version,
+              "     Print version and exit";
+  "-vnum", Arg.Unit print_version_num,
+           "        Print version number and exit";
   "-args", Arg.Expand Arg.read_arg,
     "<file> Read additional newline separated command line arguments \n\
     \      from <file>";
@@ -41,7 +53,9 @@ let arg_list = Arg.align [
   ]
 
 let arg_usage =
-  "ocamlcmt [OPTIONS] FILE.cmt : read FILE.cmt and print related information"
+  "Read FILE.cmt and print related information\n\
+   Usage: ocamlcmt [options] FILE.cmt\n\
+   Options are:"
 
 let dummy_crc = String.make 32 '-'
 

diff --git a/tools/ocamlcp_common.ml b/tools/ocamlcp_common.ml
index 9d2df7d24d8d0b58bd36642e3af8595f88fd1f74..7fcacc94248ee16f7ff8d9d13a37c7b61af01a21 100644 (file)
--- a/tools/ocamlcp_common.ml
+++ b/tools/ocamlcp_common.ml
@@ -40,7 +40,7 @@ module Make(T: OCAMLCP) = struct
     if Filename.check_suffix filename ".ml" then with_ml := true;
     if Filename.check_suffix filename ".mli" then with_mli := true
 
-  let usage = "Usage: " ^ name ^ " <options> <files>\noptions are:"
+  let usage = "Usage: " ^ name ^ " <options> <files>\nOptions are:"
 
   let incompatible o =
     Printf.eprintf "%s: profiling is incompatible with the %s option\n" name o;

diff --git a/tools/ocamlmklib.ml b/tools/ocamlmklib.ml
index f6bfa96de6f236f45a0797ec6e025d9a13a59d9d..f6b2a2d16ec9bf98fa010e94b237129234586557 100644 (file)
--- a/tools/ocamlmklib.ml
+++ b/tools/ocamlmklib.ml
@@ -178,46 +178,46 @@ let parse_arguments argv =
 
   if !output_c = "" then output_c := !output
 
-let usage = "\
-Usage: ocamlmklib [options] <.cmo|.cma|.cmx|.ml|.mli|.o|.a|.obj|.lib|\
-                             .dll|.dylib files>\
-\nOptions are:\
-\n  -args <file>   Read additional newline-terminated command line arguments\
-\n                 from <file>\
-\n  -args0 <file>  Read additional null character terminated command line\
-\n                 arguments from <file>\
-\n  -cclib <lib>   C library passed to ocamlc -a or ocamlopt -a only\
-\n  -ccopt <opt>   C option passed to ocamlc -a or ocamlopt -a only\
-\n  -custom        Disable dynamic loading\
-\n  -g             Build with debug information\
-\n  -dllpath <dir> Add <dir> to the run-time search path for DLLs\
-\n  -F<dir>        Specify a framework directory (MacOSX)\
-\n  -framework <name>    Use framework <name> (MacOSX)\
-\n  -help          Print this help message and exit\
-\n  --help         Same as -help\
-\n  -h             Same as -help\
-\n  -I <dir>       Add <dir> to the path searched for OCaml object files\
-\n  -failsafe      fall back to static linking if DLL construction failed\
-\n  -ldopt <opt>   C option passed to the shared linker only\
-\n  -linkall       Build OCaml archive with link-all behavior\
-\n  -l<lib>        Specify a dependent C library\
-\n  -L<dir>        Add <dir> to the path searched for C libraries\
-\n  -ocamlc <cmd>  Use <cmd> in place of \"ocamlc\"\
-\n  -ocamlcflags <opt>    Pass <opt> to ocamlc\
-\n  -ocamlopt <cmd> Use <cmd> in place of \"ocamlopt\"\
-\n  -ocamloptflags <opt>  Pass <opt> to ocamlopt\
-\n  -o <name>      Generated OCaml library is named <name>.cma or <name>.cmxa\
-\n  -oc <name>     Generated C library is named dll<name>.so or lib<name>.a\
-\n  -rpath <dir>   Same as -dllpath <dir>\
-\n  -R<dir>        Same as -rpath\
-\n  -verbose       Print commands before executing them\
-\n  -v             same as -verbose\
-\n  -version       Print version and exit\
-\n  -vnum          Print version number and exit\
-\n  -Wl,-rpath,<dir>     Same as -dllpath <dir>\
-\n  -Wl,-rpath -Wl,<dir> Same as -dllpath <dir>\
-\n  -Wl,-R<dir>          Same as -dllpath <dir>\
-\n"
+let usage =
+{|Usage: ocamlmklib [options] <.cmo|.cma|.cmx|.ml|.mli|.o|.a|.obj|.lib|
+                             .dll|.dylib files>
+Options are:
+  -args <file>   Read additional newline-terminated command line arguments
+                 from <file>
+  -args0 <file>  Read additional null character terminated command line
+                 arguments from <file>
+  -cclib <lib>   C library passed to ocamlc -a or ocamlopt -a only
+  -ccopt <opt>   C option passed to ocamlc -a or ocamlopt -a only
+  -custom        Disable dynamic loading
+  -g             Build with debug information
+  -dllpath <dir> Add <dir> to the run-time search path for DLLs
+  -F<dir>        Specify a framework directory (MacOSX)
+  -framework <name>    Use framework <name> (MacOSX)
+  -help          Print this help message and exit
+  --help         Same as -help
+  -h             Same as -help
+  -I <dir>       Add <dir> to the path searched for OCaml object files
+  -failsafe      fall back to static linking if DLL construction failed
+  -ldopt <opt>   C option passed to the shared linker only
+  -linkall       Build OCaml archive with link-all behavior
+  -l<lib>        Specify a dependent C library
+  -L<dir>        Add <dir> to the path searched for C libraries
+  -ocamlc <cmd>  Use <cmd> in place of "ocamlc"
+  -ocamlcflags <opt>    Pass <opt> to ocamlc
+  -ocamlopt <cmd> Use <cmd> in place of "ocamlopt"
+  -ocamloptflags <opt>  Pass <opt> to ocamlopt
+  -o <name>      Generated OCaml library is named <name>.cma or <name>.cmxa
+  -oc <name>     Generated C library is named dll<name>.so or lib<name>.a
+  -rpath <dir>   Same as -dllpath <dir>
+  -R<dir>        Same as -rpath
+  -verbose       Print commands before executing them
+  -v             same as -verbose
+  -version       Print version and exit
+  -vnum          Print version number and exit
+  -Wl,-rpath,<dir>     Same as -dllpath <dir>
+  -Wl,-rpath -Wl,<dir> Same as -dllpath <dir>
+  -Wl,-R<dir>          Same as -dllpath <dir>
+|}
 
 let command cmd =
   if !verbose then (print_string "+ "; print_string cmd; print_newline());

diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml
index c93c81104566e2f0f48008c18f11222a53943042..256659ecf1b2daf67233025ee48beef016a30ad9 100644 (file)
--- a/tools/ocamlprof.ml
+++ b/tools/ocamlprof.ml
@@ -482,7 +482,7 @@ let process_anon_file filename =
 
 open Format
 
-let usage = "Usage: ocamlprof <options> <files>\noptions are:"
+let usage = "Usage: ocamlprof <options> <files>\nOptions are:"
 
 let print_version () =
   printf "ocamlprof, version %s@." Sys.ocaml_version;

diff --git a/tools/sync_dynlink.ml b/tools/sync_dynlink.ml
new file mode 100644 (file)
index 0000000..5c23cdd
--- /dev/null
+++ b/tools/sync_dynlink.ml
@@ -0,0 +1,68 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Florian Angeletti, projet Cambium, Inria Paris             *)
+(*                                                                        *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** This small script prints a file annotated with line directives using the
+    source currently pointed at by the last line directive. It aims to check
+    that vendored libraries don't diverge from their original sources. *)
+
+module Opened_files = Map.Make(String)
+
+type 'a diff = { chimera:'a; source:'a }
+
+let chimera lines index = lines.chimera.(index.chimera)
+let source lines index = lines.source.(index.source)
+
+let open_file opened filename = match Opened_files.find_opt filename opened with
+  | Some a -> a, opened
+  | None ->
+      let lines =
+        filename
+        |> In_channel.open_text
+        |> In_channel.input_lines
+        |> Array.of_list
+      in
+      lines, Opened_files.add filename lines opened
+
+let parse_line_directive s =
+  Scanf.sscanf_opt s "#%d %S" (fun pos file -> pos-1,file)
+
+let one_line (cursor,lines,opened_files) =
+  if cursor.chimera >= Array.length lines.chimera then `Stop
+  else
+    match parse_line_directive (chimera lines cursor) with
+    | Some (pos,file) ->
+        Printf.printf "%s\n" (chimera lines cursor);
+        let cursor = { source = pos; chimera = cursor.chimera + 1 } in
+        let file, opened_files = open_file opened_files file in
+        `Next (cursor, { lines with source = file}, opened_files)
+    | None ->
+        Printf.printf "%s\n" (source lines cursor);
+        let cursor = {
+          source = cursor.source + 1;
+          chimera = cursor.chimera + 1
+        }
+        in
+        `Next (cursor, lines, opened_files)
+
+let rec all_lines state =
+  match one_line state with
+  | `Next state -> all_lines state
+  | `Stop -> ()
+
+let replay file =
+  let chimera, opened_files = open_file Opened_files.empty file in
+  all_lines ({chimera=0;source=0}, {chimera;source=chimera}, opened_files)
+
+let () = replay Sys.argv.(1)

diff --git a/tools/sync_dynlink.mli b/tools/sync_dynlink.mli
new file mode 100644 (file)
index 0000000..fbbbabb
--- /dev/null
+++ b/tools/sync_dynlink.mli
@@ -0,0 +1,14 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Florian Angeletti, projet Cambium, Inria Paris             *)
+(*                                                                        *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)

diff --git a/toplevel/byte/topeval.ml b/toplevel/byte/topeval.ml
index 0302f358ccb334ce0eeb08136bfe917bbfac077c..14c605039d565c48e3e1d649b2444534aa4d4ee3 100644 (file)
--- a/toplevel/byte/topeval.ml
+++ b/toplevel/byte/topeval.ml
@@ -109,7 +109,7 @@ let load_lambda ppf lam =
 (* Print the outcome of an evaluation *)
 
 let pr_item =
-  Printtyp.print_items
+  Out_type.print_items
     (fun env -> function
       | Sig_value(id, {val_kind = Val_reg; val_type}, _) ->
           Some (outval_of_value env (getvalue (Translmod.toplevel_name id))
@@ -129,7 +129,7 @@ let execute_phrase print_outcome ppf phr =
       in
       if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
       let sg' = Typemod.Signature_names.simplify newenv sn sg in
-      ignore (Includemod.signatures ~mark:Mark_positive oldenv sg sg');
+      Includemod.check_implementation oldenv sg sg';
       Typecore.force_delayed_checks ();
       let shape = Shape_reduce.local_reduce Env.empty shape in
       if !Clflags.dump_shape then Shape.print ppf shape;
@@ -149,7 +149,10 @@ let execute_phrase print_outcome ppf phr =
                       match find_eval_phrase str with
                       | Some (exp, _, _) ->
                         let outv = outval_of_value newenv v exp.exp_type in
-                        let ty = Printtyp.tree_of_type_scheme exp.exp_type in
+                        let ty =
+                          Out_type.prepare_for_printing [exp.exp_type];
+                          Out_type.tree_of_typexp Type_scheme exp.exp_type
+                        in
                         Ophr_eval (outv, ty)
                       | None -> Ophr_signature (pr_item oldenv sg'))
               else Ophr_signature []

diff --git a/toplevel/byte/topmain.ml b/toplevel/byte/topmain.ml
index 72464e69746460bfff7faeaca944bddfc69c3876..c2f9254eacbe35dbf4d90732e4de2751b157e9f1 100644 (file)
--- a/toplevel/byte/topmain.ml
+++ b/toplevel/byte/topmain.ml
@@ -120,8 +120,6 @@ let _ = Topcommon.add_directive "untrace_all"
 (* --- *)
 
 
-let preload_objects = ref []
-
 (* Position of the first non expanded argument *)
 let first_nonexpanded_pos = ref 0
 
@@ -140,29 +138,12 @@ let expand_position pos len =
     (* New last position *)
     first_nonexpanded_pos := pos + len + 2
 
-let prepare ppf =
-  Topcommon.set_paths ();
-  try
-    let res =
-      let objects =
-        List.rev (!preload_objects @ !Compenv.first_objfiles)
-      in
-      List.for_all (Topeval.load_file false ppf) objects
-    in
-    Topcommon.run_hooks Topcommon.Startup;
-    res
-  with x ->
-    try Location.report_exception ppf x; false
-    with x ->
-      Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
-      false
-
 let input_argument name =
   let filename = Toploop.filename_of_input name in
   let ppf = Format.err_formatter in
   if Filename.check_suffix filename ".cmo"
           || Filename.check_suffix filename ".cma"
-  then preload_objects := filename :: !preload_objects
+  then Toploop.preload_objects := filename :: !Toploop.preload_objects
   else if is_expanded !current then begin
     (* Script files are not allowed in expand options because otherwise the
        check in override arguments may fail since the new argv can be larger
@@ -178,7 +159,8 @@ let input_argument name =
       in
       Compenv.readenv ppf Before_link;
       Compmisc.read_clflags_from_env ();
-      if prepare ppf && Toploop.run_script ppf name newargs
+      if Toploop.prepare ppf ~input:name () &&
+         Toploop.run_script ppf name newargs
       then raise (Compenv.Exit_with_status 0)
       else raise (Compenv.Exit_with_status 2)
     end
@@ -214,7 +196,7 @@ let main () =
   Compenv.parse_arguments ~current argv file_argument program;
   Compenv.readenv ppf Before_link;
   Compmisc.read_clflags_from_env ();
-  if not (prepare ppf) then raise (Compenv.Exit_with_status 2);
+  if not (Toploop.prepare ppf ()) then raise (Compenv.Exit_with_status 2);
   Compmisc.init_path ();
   Toploop.loop Format.std_formatter
 

diff --git a/toplevel/byte/trace.ml b/toplevel/byte/trace.ml
index 96259e74180035498e694d8d85061a5db12b64fb..1712c5ff27234f664108409c081df4a94648e9bb 100644 (file)
--- a/toplevel/byte/trace.ml
+++ b/toplevel/byte/trace.ml
@@ -61,7 +61,8 @@ let invoke_traced_function codeptr env arg =
   Meta.invoke_traced_function codeptr env arg
 
 let print_label ppf l =
-  if l <> Asttypes.Nolabel then fprintf ppf "%s:" (Printtyp.string_of_label l)
+  if l <> Asttypes.Nolabel then fprintf ppf "%s:"
+  (Asttypes.string_of_label l)
 
 (* If a function returns a functional value, wrap it into a trace code *)
 

diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index 0b8e30e323081650d77a203ff3b6deefe17f3b9e..25069ddf3d71355c9b8e98010d243875c6570d19 100644 (file)
--- a/toplevel/genprintval.ml
+++ b/toplevel/genprintval.ml
@@ -21,7 +21,7 @@ open Longident
 open Path
 open Types
 open Outcometree
-module Out_name = Printtyp.Out_name
+module Out_name = Out_type.Out_name
 
 module type OBJ =
   sig
@@ -153,16 +153,24 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
                 (fun x -> Oval_int64 (O.obj x : int64)) ))
     ] : (Path.t * printer) list)
 
-    let exn_printer ppf path exn =
-      fprintf ppf "<printer %a raised an exception: %s>" Printtyp.path path
+    let exn_printer path ppf exn =
+      Format_doc.fprintf ppf "<printer %a raised an exception: %s>"
+        Printtyp.Doc.path path
         (Printexc.to_string exn)
 
     let out_exn path exn =
-      Oval_printer (fun ppf -> exn_printer ppf path exn)
+      Oval_printer (fun ppf -> exn_printer path ppf exn)
+
+    let user_printer path f ppf x =
+      Format_doc.deprecated_printer
+        (fun ppf ->
+           try f ppf x with
+           | exn -> Format_doc.compat1 exn_printer path ppf exn
+        )
+        ppf
 
     let install_printer path ty fn =
-      let print_val ppf obj =
-        try fn ppf obj with exn -> exn_printer ppf path exn in
+      let print_val ppf obj = user_printer path fn ppf obj in
       let printer obj = Oval_printer (fun ppf -> print_val ppf obj) in
       printers := (path, Simple (ty, printer)) :: !printers
 
@@ -174,8 +182,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
         match gp with
         | Zero fn ->
             let out_printer obj =
-              let printer ppf =
-                try fn ppf obj with exn -> exn_printer ppf function_path exn in
+              let printer ppf = user_printer function_path fn ppf obj in
               Oval_printer printer in
             Zero out_printer
         | Succ fn ->
@@ -208,9 +215,9 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
             | _ -> false
             | exception Not_found -> false
           then Oide_ident name
-          else Oide_dot (Printtyp.tree_of_path p, Out_name.print name)
+          else Oide_dot (Out_type.tree_of_path p, Out_name.print name)
       | Papply _ ->
-          Printtyp.tree_of_path ty_path
+          Out_type.tree_of_path ty_path
       | Pextra_ty _ ->
           (* These can only appear directly inside of the associated
              constructor so we can just drop the prefix *)
@@ -242,7 +249,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
       let nested_values = ObjTbl.create 8 in
       let nest_gen err f depth obj ty =
         let repr = obj in
-        if not (O.is_block repr) then
+        if not (O.is_block repr) || (O.tag repr >= Obj.no_scan_tag) then
           f depth obj ty
         else
           if ObjTbl.mem nested_values repr then
@@ -271,117 +278,120 @@ 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, [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 depth obj ty_arg =
-                      if !printer_steps < 0 || depth < 0 then
-                        Oval_ellipsis :: tree_list
-                      else if O.is_block obj then
-                        let tree =
-                          nest tree_of_val (depth - 1) (O.field obj 0) ty_arg
+          | Tconstr(path, ty_list, _) -> begin
+              match get_desc (Ctype.expand_head env ty) with
+              | 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 depth obj ty_arg =
+                          if !printer_steps < 0 || depth < 0 then
+                            Oval_ellipsis :: tree_list
+                          else if O.is_block obj then
+                            let tree = nest tree_of_val (depth - 1)
+                                          (O.field obj 0) ty_arg
+                            in
+                            let next_obj = O.field obj 1 in
+                            nest_gen (Oval_stuff "<cycle>" :: tree :: tree_list)
+                              (tree_of_conses (tree :: tree_list))
+                              depth next_obj ty_arg
+                          else tree_list
                         in
-                        let next_obj = O.field obj 1 in
-                        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 [] depth obj ty_arg))
-              else
-                Oval_list []
-          | Tconstr(path, [ty_arg], _)
-            when Path.same path Predef.path_array ->
-              let length = O.size obj in
-              if length > 0 then
-                match check_depth depth obj ty with
-                  Some x -> x
-                | None ->
-                    let rec tree_of_items tree_list i =
-                      if !printer_steps < 0 || depth < 0 then
-                        Oval_ellipsis :: tree_list
-                      else if i < length then
-                        let tree =
-                          nest tree_of_val (depth - 1) (O.field obj i) ty_arg
+                        Oval_list
+                            (List.rev (tree_of_conses [] depth obj ty_arg))
+                  else
+                    Oval_list []
+
+              | Tconstr(path, [ty_arg], _)
+                when Path.same path Predef.path_array ->
+                  let length = O.size obj in
+                  if length > 0 then
+                    match check_depth depth obj ty with
+                      Some x -> x
+                    | None ->
+                        let rec tree_of_items tree_list i =
+                          if !printer_steps < 0 || depth < 0 then
+                            Oval_ellipsis :: tree_list
+                          else if i < length then
+                            let tree = 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
-                        tree_of_items (tree :: tree_list) (i + 1)
-                      else tree_list
-                    in
-                    Oval_array (List.rev (tree_of_items [] 0))
-              else
-                Oval_array []
-
-          | Tconstr(path, [], _)
-              when Path.same path Predef.path_string ->
-            Oval_string ((O.obj obj : string), !printer_steps, Ostr_string)
-
-          | Tconstr (path, [], _)
-              when Path.same path Predef.path_bytes ->
-            let s = Bytes.to_string (O.obj obj : bytes) in
-            Oval_string (s, !printer_steps, Ostr_bytes)
-
-          | Tconstr (path, [ty_arg], _)
-            when Path.same path Predef.path_lazy_t ->
-             let obj_tag = O.tag obj in
-             (* Lazy values are represented in three possible ways:
-
-                1. a lazy thunk that is not yet forced has tag
-                   Obj.lazy_tag
-
-                2. a lazy thunk that has just been forced has tag
-                   Obj.forward_tag; its first field is the forced
-                   result, which we can print
-
-                3. when the GC moves a forced trunk with forward_tag,
-                   or when a thunk is directly created from a value,
-                   we get a third representation where the value is
-                   directly exposed, without the Obj.forward_tag
-                   (if its own tag is not ambiguous, that is neither
-                   lazy_tag nor forward_tag)
-
-                Note that using Lazy.is_val and Lazy.force would be
-                unsafe, because they use the Obj.* functions rather
-                than the O.* functions of the functor argument, and
-                would thus crash if called from the toplevel
-                (debugger/printval instantiates Genprintval.Make with
-                an Obj module talking over a socket).
-              *)
-             if obj_tag = Obj.lazy_tag then Oval_stuff "<lazy>"
-             else begin
-                 let forced_obj =
-                   if obj_tag = Obj.forward_tag then O.field obj 0 else obj
-                 in
-                 (* calling oneself recursively on forced_obj risks
-                    having a false positive for cycle detection;
-                    indeed, in case (3) above, the value is stored
-                    as-is instead of being wrapped in a forward
-                    pointer. It means that, for (lazy "foo"), we have
-                      forced_obj == obj
-                    and it is easy to wrongly print (lazy <cycle>) in such
-                    a case (PR#6669).
-
-                    Unfortunately, there is a corner-case that *is*
-                    a real cycle: using unboxed types one can define
-
-                       type t = T : t Lazy.t -> t [@@unboxed]
-                       let rec x = lazy (T x)
-
-                    which creates a Forward_tagged block that points to
-                    itself. For this reason, we still "nest"
-                    (detect head cycles) on forward tags.
+                        Oval_array (List.rev (tree_of_items [] 0))
+                  else
+                    Oval_array []
+
+              | Tconstr(path, [], _)
+                  when Path.same path Predef.path_string ->
+                Oval_string ((O.obj obj : string), !printer_steps, Ostr_string)
+
+              | Tconstr (path, [], _)
+                  when Path.same path Predef.path_bytes ->
+                let s = Bytes.to_string (O.obj obj : bytes) in
+                Oval_string (s, !printer_steps, Ostr_bytes)
+
+              | Tconstr (path, [ty_arg], _)
+                when Path.same path Predef.path_lazy_t ->
+                let obj_tag = O.tag obj in
+                (* Lazy values are represented in three possible ways:
+
+                    1. a lazy thunk that is not yet forced has tag
+                      Obj.lazy_tag
+
+                    2. a lazy thunk that has just been forced has tag
+                      Obj.forward_tag; its first field is the forced
+                      result, which we can print
+
+                    3. when the GC moves a forced trunk with forward_tag,
+                      or when a thunk is directly created from a value,
+                      we get a third representation where the value is
+                      directly exposed, without the Obj.forward_tag
+                      (if its own tag is not ambiguous, that is neither
+                      lazy_tag nor forward_tag)
+
+                    Note that using Lazy.is_val and Lazy.force would be
+                    unsafe, because they use the Obj.* functions rather
+                    than the O.* functions of the functor argument, and
+                    would thus crash if called from the toplevel
+                    (debugger/printval instantiates Genprintval.Make with
+                    an Obj module talking over a socket).
                   *)
-                 let v =
-                   if obj_tag = Obj.forward_tag
-                   then nest tree_of_val depth forced_obj ty_arg
-                   else      tree_of_val depth forced_obj ty_arg
-                 in
-                 Oval_lazy v
-               end
-          | Tconstr(path, ty_list, _) -> begin
-              try
+                if obj_tag = Obj.lazy_tag then Oval_stuff "<lazy>"
+                else begin
+                    let forced_obj =
+                      if obj_tag = Obj.forward_tag then O.field obj 0 else obj
+                    in
+                    (* calling oneself recursively on forced_obj risks
+                        having a false positive for cycle detection;
+                        indeed, in case (3) above, the value is stored
+                        as-is instead of being wrapped in a forward
+                        pointer. It means that, for (lazy "foo"), we have
+                          forced_obj == obj
+                        and it is easy to wrongly print (lazy <cycle>) in such
+                        a case (PR#6669).
+
+                        Unfortunately, there is a corner-case that *is*
+                        a real cycle: using unboxed types one can define
+
+                          type t = T : t Lazy.t -> t [@@unboxed]
+                          let rec x = lazy (T x)
+
+                        which creates a Forward_tagged block that points to
+                        itself. For this reason, we still "nest"
+                        (detect head cycles) on forward tags.
+                      *)
+                    let v =
+                      if obj_tag = Obj.forward_tag
+                      then nest tree_of_val depth forced_obj ty_arg
+                      else      tree_of_val depth forced_obj ty_arg
+                    in
+                    Oval_lazy v
+                  end
+            | _ -> begin try
                 let decl = Env.find_type path env in
                 match decl with
                 | {type_kind = Type_abstract _; type_manifest = None} ->
@@ -449,6 +459,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
               | Datarepr.Constr_not_found -> (* raised by find_constr_by_tag *)
                   Oval_stuff "<unknown constructor>"
               end
+            end
           | Tvariant row ->
               if O.is_block obj then
                 let tag : int = O.obj (O.field obj 0) in
@@ -612,11 +623,12 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
       | _ ->
           (fun _obj ->
             let printer ppf =
-              fprintf ppf "<internal error: incorrect arity for '%a'>"
-                Printtyp.path path in
+              Format_doc.fprintf ppf
+                "<internal error: incorrect arity for '%a'>"
+                Printtyp.Doc.path path in
             Oval_printer printer)
 
 
-    in nest tree_of_val max_depth obj (Ctype.correct_levels ty)
+    in nest tree_of_val max_depth obj ty
 
 end

diff --git a/toplevel/native/topeval.ml b/toplevel/native/topeval.ml
index 26d77d68acb1c51c3d738beeffa42268bd5156e8..fd2443fd4e153c70ef70f82e122d66699d8c5429 100644 (file)
--- a/toplevel/native/topeval.ml
+++ b/toplevel/native/topeval.ml
@@ -106,7 +106,7 @@ let load_lambda ppf ~module_ident ~required_globals phrase_name lam size =
 (* Print the outcome of an evaluation *)
 
 let pr_item =
-  Printtyp.print_items
+  Out_type.print_items
     (fun env -> function
       | Sig_value(id, {val_kind = Val_reg; val_type}, _) ->
           Some (outval_of_value env (toplevel_value id) val_type)
@@ -169,7 +169,7 @@ let execute_phrase print_outcome ppf phr =
       in
       if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
       let sg' = Typemod.Signature_names.simplify newenv names sg in
-      ignore (Includemod.signatures oldenv ~mark:Mark_positive sg sg');
+      Includemod.check_implementation oldenv sg sg';
       Typecore.force_delayed_checks ();
       let shape = Shape_reduce.local_reduce Env.empty shape in
       if !Clflags.dump_shape then Shape.print ppf shape;
@@ -232,7 +232,10 @@ let execute_phrase print_outcome ppf phr =
                             outval_of_value newenv (toplevel_value id)
                               vd.val_type
                           in
-                          let ty = Printtyp.tree_of_type_scheme vd.val_type in
+                          let ty =
+                            Out_type.prepare_for_printing [vd.val_type];
+                            Out_type.tree_of_typexp Type_scheme vd.val_type
+                          in
                           Ophr_eval (outv, ty)
                       | _ -> assert false
                     else

diff --git a/toplevel/native/topmain.ml b/toplevel/native/topmain.ml
index 517eb3ee61ff81002342a96e2e05e6402ea6f8c9..2121612e724f8e4a8466dcf111d593234f82e607 100644 (file)
--- a/toplevel/native/topmain.ml
+++ b/toplevel/native/topmain.ml
@@ -13,8 +13,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let preload_objects = ref []
-
 (* Position of the first non expanded argument *)
 let first_nonexpanded_pos = ref 0
 
@@ -33,28 +31,13 @@ let expand_position pos len =
     (* New last position *)
     first_nonexpanded_pos := pos + len + 2
 
-
-let prepare ppf =
-  Topcommon.set_paths ();
-  try
-    let res =
-      List.for_all (Topeval.load_file false ppf) (List.rev !preload_objects)
-    in
-    Topcommon.run_hooks Topcommon.Startup;
-    res
-  with x ->
-    try Location.report_exception ppf x; false
-    with x ->
-      Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
-      false
-
 let input_argument name =
   let filename = Toploop.filename_of_input name in
   let ppf = Format.err_formatter in
   if Filename.check_suffix filename ".cmxs"
     || Filename.check_suffix filename ".cmx"
     || Filename.check_suffix filename ".cmxa"
-  then preload_objects := filename :: !preload_objects
+  then Toploop.preload_objects := filename :: !Toploop.preload_objects
   else if is_expanded !current then begin
     (* Script files are not allowed in expand options because otherwise the
        check in override arguments may fail since the new argv can be larger
@@ -69,7 +52,8 @@ let input_argument name =
                               (Array.length !argv - !Arg.current)
       in
       Compmisc.read_clflags_from_env ();
-      if prepare ppf && Toploop.run_script ppf name newargs
+      if Toploop.prepare ppf ~input:name () &&
+         Toploop.run_script ppf name newargs
       then raise (Compenv.Exit_with_status 0)
       else raise (Compenv.Exit_with_status 2)
     end
@@ -106,7 +90,7 @@ let main () =
   Clflags.add_arguments __LOC__ Options.list;
   Compenv.parse_arguments ~current argv file_argument program;
   Compmisc.read_clflags_from_env ();
-  if not (prepare Format.err_formatter) then raise (Compenv.Exit_with_status 2);
+  if not (Toploop.prepare ppf ()) then raise (Compenv.Exit_with_status 2);
   Compmisc.init_path ();
   Toploop.loop Format.std_formatter
 

diff --git a/toplevel/topcommon.ml b/toplevel/topcommon.ml
index d281b3ad68f217db02f6ce322ba950553b46033a..2f37ebfd41b443ab4027051ee930fbb2b0783fbc 100644 (file)
--- a/toplevel/topcommon.ml
+++ b/toplevel/topcommon.ml
@@ -34,7 +34,7 @@ let print_warning = Location.print_warning
 let input_name = Location.input_name
 
 let parse_mod_use_file name lb =
-  let modname = Unit_info.modname_from_source name in
+  let modname = Unit_info.lax_modname_from_source name in
   let items =
     List.concat
       (List.map
@@ -260,14 +260,14 @@ let refill_lexbuf buffer len =
       len
   end
 
-let set_paths ?(auto_include=Compmisc.auto_include) () =
+let set_paths ?(auto_include=Compmisc.auto_include) ?(dir="") () =
   (* Add whatever -I options have been specified on the command line,
      but keep the directories that user code linked in with ocamlmktop
      may have added to load_path. *)
   let expand = Misc.expand_directory Config.standard_library in
   let Load_path.{ visible; hidden } = Load_path.get_paths () in
   let visible = List.concat [
-      [ "" ];
+      [ dir ];
       List.map expand (List.rev !Compenv.first_include_dirs);
       List.map expand (List.rev !Clflags.include_dirs);
       List.map expand (List.rev !Compenv.last_include_dirs);
@@ -340,13 +340,14 @@ let all_directive_names () =
   Hashtbl.fold (fun dir _ acc -> dir::acc) directive_table []
 
 module Style = Misc.Style
+let inline_code = Format_doc.compat Style.inline_code
 
 let try_run_directive ppf dir_name pdir_arg =
   begin match get_directive dir_name with
   | None ->
-      fprintf ppf "Unknown directive %a." Style.inline_code dir_name;
+      fprintf ppf "Unknown directive %a." inline_code dir_name;
       let directives = all_directive_names () in
-      Misc.did_you_mean ppf
+      Format_doc.compat Misc.did_you_mean ppf
         (fun () -> Misc.spellcheck directives dir_name);
       fprintf ppf "@.";
       false
@@ -360,12 +361,12 @@ let try_run_directive ppf dir_name pdir_arg =
          | exception _ ->
            fprintf ppf "Integer literal exceeds the range of \
                         representable integers for directive %a.@."
-                   Style.inline_code dir_name;
+                   inline_code dir_name;
            false
          end
       | Directive_int _, Some {pdira_desc = Pdir_int (_, Some _)} ->
           fprintf ppf "Wrong integer literal for directive %a.@."
-            Style.inline_code dir_name;
+            inline_code dir_name;
           false
       | Directive_ident f, Some {pdira_desc = Pdir_ident lid} -> f lid; true
       | Directive_bool f, Some {pdira_desc = Pdir_bool b} -> f b; true
@@ -387,24 +388,25 @@ let try_run_directive ppf dir_name pdir_arg =
           let pp_type ppf = function
           | `None -> Format.fprintf ppf "no argument"
           | `String ->
-              Format.fprintf ppf "a %a literal" Style.inline_code "string"
+              Format.fprintf ppf "a %a literal" inline_code "string"
           | `Int ->
-              Format.fprintf ppf "an %a literal" Style.inline_code "string"
+              Format.fprintf ppf "an %a literal" inline_code "string"
           | `Ident ->
               Format.fprintf ppf "an identifier"
           | `Bool ->
-              Format.fprintf ppf "a %a literal" Style.inline_code "bool"
+              Format.fprintf ppf "a %a literal" inline_code "bool"
           in
           fprintf ppf "Directive %a expects %a, got %a.@."
-            Style.inline_code dir_name pp_type dir_type pp_type arg_type;
+            inline_code dir_name pp_type dir_type pp_type arg_type;
           false
   end
 
 (* Overriding exception printers with toplevel-specific ones *)
 
 let loading_hint_printer ppf cu =
+  let open Format_doc in
   let global = Symtable.Global.Glob_compunit (Cmo_format.Compunit cu) in
-  Symtable.report_error ppf (Symtable.Undefined_global global);
+  Symtable.report_error_doc ppf (Symtable.Undefined_global global);
   let find_with_ext ext =
     try Some (Load_path.find_normalized (cu ^ ext)) with Not_found -> None
   in
@@ -417,7 +419,7 @@ let loading_hint_printer ppf cu =
      But very often they do. *)
   begin match List.find_map find_with_ext [".cma"; ".cmo"] with
   | Some path ->
-    let load ppf path = Format.fprintf ppf "#load \"%s\"" path in
+    let load ppf path = Format_doc.fprintf ppf "#load \"%s\"" path in
     fprintf ppf
       "Found %a @,in the load paths. \
        @,Did you mean to load it using @,%a \

diff --git a/toplevel/topcommon.mli b/toplevel/topcommon.mli
index bcbe1a80f97a7cd9c81e7c8d967c1b60514bd594..f76ccb30abf07b0831bf95f5297def4bdb7824be 100644 (file)
--- a/toplevel/topcommon.mli
+++ b/toplevel/topcommon.mli
@@ -29,7 +29,8 @@ open Format
 
 (* Set the load paths, before running anything *)
 
-val set_paths : ?auto_include:Load_path.auto_include_callback -> unit -> unit
+val set_paths :
+  ?auto_include:Load_path.auto_include_callback -> ?dir:string -> unit -> unit
 
 (* Add directories listed in OCAMLTOP_INCLUDE_PATH to the end of the search
    path *)
@@ -58,20 +59,16 @@ val find_eval_phrase :
 val max_printer_depth: int ref
 val max_printer_steps: int ref
 
+type 'a printer := 'a Oprint.printer
+
 val print_out_value :
   (formatter -> Outcometree.out_value -> unit) ref
-val print_out_type :
-  (formatter -> Outcometree.out_type -> unit) ref
-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 :
-  (formatter -> Outcometree.out_sig_item list -> unit) ref
+val print_out_type : Outcometree.out_type printer
+val print_out_class_type :  Outcometree.out_class_type printer
+val print_out_module_type : Outcometree.out_module_type printer
+val print_out_type_extension : Outcometree.out_type_extension printer
+val print_out_sig_item :  Outcometree.out_sig_item printer
+val print_out_signature :  Outcometree.out_sig_item list printer
 val print_out_phrase :
   (formatter -> Outcometree.out_phrase -> unit) ref
 

diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index 9113c059d9c5845ff56da984828a02077763e271..aa75b57233da05f4bdfb0c18319fd0d935b20cd8 100644 (file)
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -232,7 +232,7 @@ let match_simple_printer_type desc ~is_old_style =
     else Topprinters.printer_type_new
   in
   match
-    Ctype.with_local_level ~post:Ctype.generalize begin fun () ->
+    Ctype.with_local_level_generalize begin fun () ->
       let ty_arg = Ctype.newvar() in
       Ctype.unify !toplevel_env
         (make_printer_type ty_arg)
@@ -249,7 +249,7 @@ let match_simple_printer_type desc ~is_old_style =
 let match_generic_printer_type desc ty_path params =
   let make_printer_type = Topprinters.printer_type_new in
   match
-    Ctype.with_local_level ~post:(List.iter Ctype.generalize) begin fun () ->
+    Ctype.with_local_level_generalize begin fun () ->
       let args = List.map (fun _ -> Ctype.newvar ()) params in
       let ty_target = Ctype.newty (Tconstr (ty_path, args, ref Mnil)) in
       let printer_args_ty =
@@ -440,10 +440,11 @@ let is_nonrec_type id td =
           nonrecursive_use:= true
     | _ -> ()
   in
-  let it =  Btype.{type_iterators with it_path } in
   let () =
-    it.it_type_declaration it td;
-    Btype.unmark_iterators.it_type_declaration Btype.unmark_iterators td
+    with_type_mark begin fun mark ->
+      let it = Btype.{(type_iterators mark) with it_path} in
+      it.it_type_declaration it td
+    end
   in
   match !recursive_use, !nonrecursive_use with
   | false, true -> Trec_not
@@ -542,16 +543,15 @@ let is_rec_module id md =
     | Path.Pident id' -> if (Ident.same id id') then raise Exit
     | _ -> ()
   in
-  let it =  Btype.{type_iterators with it_path } in
-  let rs = match it.it_module_declaration it md with
+  with_type_mark begin fun mark ->
+    let it =  Btype.{(type_iterators mark) with it_path} in
+    match it.it_module_declaration it md with
     | () -> Trec_not
     | exception Exit -> Trec_first
-  in
-  Btype.unmark_iterators.it_module_declaration Btype.unmark_iterators md;
-  rs
+  end
 
 let secretly_the_same_path env path1 path2 =
-  let norm path = Printtyp.rewrite_double_underscore_paths env path in
+  let norm path = Out_type.rewrite_double_underscore_paths env path in
   Path.same (norm path1) (norm path2)
 
 let () =

diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
index 86f0e44ebedb5b45d4fa9d5874d4c63efa290409..67765ed7266128cbb7bd7de171027bcf7b18e40d 100644 (file)
--- a/toplevel/toploop.ml
+++ b/toplevel/toploop.ml
@@ -117,11 +117,6 @@ let run_script ppf name args =
   let filename = filename_of_input name in
   Compmisc.init_path ~dir:(Filename.dirname filename) ();
                    (* Note: would use [Filename.abspath] here, if we had it. *)
-  begin
-    try toplevel_env := Compmisc.initial_env()
-    with Env.Error _ | Typetexp.Error _ as exn ->
-      Location.report_exception ppf exn; raise (Compenv.Exit_with_status 2)
-  end;
   Sys.interactive := false;
   run_hooks After_setup;
   let explicit_name =
@@ -385,18 +380,15 @@ let process_phrases ppf snap phrs =
     end
 
 let loop ppf =
+  Misc.Style.setup !Clflags.color;
   Clflags.debug := true;
   Location.formatter_for_warnings := ppf;
   if not !Clflags.noversion then
-    fprintf ppf "OCaml version %s%s%s@.Enter #help;; for help.@.@."
+    fprintf ppf "OCaml version %s%s%s@.Enter %a for help.@.@."
       Config.version
       (if Topeval.implementation_label = "" then "" else " - ")
-      Topeval.implementation_label;
-  begin
-    try initialize_toplevel_env ()
-    with Env.Error _ | Typetexp.Error _ as exn ->
-      Location.report_exception ppf exn; raise (Compenv.Exit_with_status 2)
-  end;
+      Topeval.implementation_label
+      (Format_doc.compat Misc.Style.inline_code) "#help;;";
   let lb = Lexing.from_function refill_lexbuf in
   Location.init lb "//toplevel//";
   Location.input_name := "//toplevel//";
@@ -421,3 +413,29 @@ let loop ppf =
     | PPerror -> ()
     | x -> Location.report_exception ppf x; Btype.backtrack !snap
   done
+
+let preload_objects = ref []
+
+let prepare ppf ?input () =
+  let dir =
+    Option.map (fun inp -> Filename.dirname (filename_of_input inp)) input in
+  Topcommon.set_paths ?dir ();
+  begin try
+    initialize_toplevel_env ()
+  with Env.Error _ | Typetexp.Error _ as exn ->
+    Location.report_exception ppf exn; raise (Compenv.Exit_with_status 2)
+  end;
+  try
+    let res =
+      let objects =
+        List.rev (!preload_objects @ !Compenv.first_objfiles)
+      in
+      List.for_all (Topeval.load_file false ppf) objects
+    in
+    Topcommon.run_hooks Topcommon.Startup;
+    res
+  with x ->
+    try Location.report_exception ppf x; false
+    with x ->
+      Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
+      false

diff --git a/toplevel/toploop.mli b/toplevel/toploop.mli
index e9f8a48ec5d6c73c477f260e9aae7950285d5a97..b544e17240aa4efe29fe066e07fec8b101d364b2 100644 (file)
--- a/toplevel/toploop.mli
+++ b/toplevel/toploop.mli
@@ -32,7 +32,8 @@ val filename_of_input: input -> string
 
 (* Set the load paths, before running anything *)
 
-val set_paths : ?auto_include:Load_path.auto_include_callback -> unit -> unit
+val set_paths :
+  ?auto_include:Load_path.auto_include_callback -> ?dir:string -> unit -> unit
 
 (* The interactive toplevel loop *)
 
@@ -143,18 +144,14 @@ val input_name : string ref
 
 val print_out_value :
   (formatter -> Outcometree.out_value -> unit) ref
-val print_out_type :
-  (formatter -> Outcometree.out_type -> unit) ref
-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 :
-  (formatter -> Outcometree.out_sig_item list -> unit) ref
+
+type 'a oprinter := 'a Oprint.printer
+val print_out_type : Outcometree.out_type oprinter
+val print_out_class_type : Outcometree.out_class_type oprinter
+val print_out_module_type : Outcometree.out_module_type oprinter
+val print_out_type_extension : Outcometree.out_type_extension oprinter
+val print_out_sig_item : Outcometree.out_sig_item oprinter
+val print_out_signature : Outcometree.out_sig_item list oprinter
 val print_out_phrase :
   (formatter -> Outcometree.out_phrase -> unit) ref
 
@@ -203,3 +200,11 @@ val split_path : string -> string list
     double-quoted (which allows semicolons in filenames to be quoted). The
     double-quote characters are stripped (i.e. [f"o"o = foo]; also
     [split_path "foo\";\";bar" = ["foo;"; "bar"]) *)
+
+val preload_objects : string list ref
+(** List of compilation units to be loaded before entering the interactive
+    loop. *)
+
+val prepare : Format.formatter -> ?input:input -> unit -> bool
+(** Setup the load paths and initial toplevel environment and load compilation
+    units in {!preload_objects}. *)

diff --git a/typing/btype.ml b/typing/btype.ml
index 5b09a4e5643bded44ad1d3a92c7fa9909ce6d923..75a9f5f237021372f8caa8a25c2bcdb3916efc2e 100644 (file)
--- a/typing/btype.ml
+++ b/typing/btype.ml
@@ -43,7 +43,6 @@ module TypeMap = struct
   let singleton ty = wrap_repr singleton ty
   let fold f = TransientTypeMap.fold (wrap_type_expr f)
 end
-module TransientTypeHash = Hashtbl.Make(TransientTypeOps)
 module TypeHash = struct
   include TransientTypeHash
   let mem hash = wrap_repr (mem hash)
@@ -94,45 +93,85 @@ module TypePairs = struct
         f (type_expr t1, type_expr t2))
 end
 
-(**** Forward declarations ****)
-
-let print_raw =
-  ref (fun _ -> assert false : Format.formatter -> type_expr -> unit)
-
 (**** Type level management ****)
 
 let generic_level = Ident.highest_scope
-
-(* Used to mark a type during a traversal. *)
 let lowest_level = Ident.lowest_scope
-let pivot_level = 2 * lowest_level - 1
-    (* pivot_level - lowest_level < lowest_level *)
+
+(**** leveled type pool ****)
+(* This defines a stack of pools of type nodes indexed by the level
+   we will try to generalize them in [Ctype.with_local_level_gen].
+   [pool_of_level] returns the pool in which types at level [level]
+   should be kept, which is the topmost pool whose level is lower or
+   equal to [level].
+   [Ctype.with_local_level_gen] shall call [with_new_pool] to create
+   a new pool at a given level. On return it shall process all nodes
+   that were added to the pool.
+   Remark: the only function adding to a pool is [add_to_pool], and
+   the only function returning the contents of a pool is [with_new_pool],
+   so that the initial pool can be added to, but never read from. *)
+
+type pool = {level: int; mutable pool: transient_expr list; next: pool}
+(* To avoid an indirection we choose to add a dummy level at the end of
+   the list. It will never be accessed, as [pool_of_level] is always called
+   with [level >= 0]. *)
+let rec dummy = {level = max_int; pool = []; next = dummy}
+let pool_stack = s_table (fun () -> {level = 0; pool = []; next = dummy}) ()
+
+(* Lookup in the stack is linear, but the depth is the number of nested
+   generalization points (e.g. lhs of let-definitions), which in ML is known
+   to be generally low. In most cases we are allocating in the topmost pool.
+   In [Ctype.with_local_gen], we move non-generalizable type nodes from the
+   topmost pool to one deeper in the stack, so that for each type node the
+   accumulated depth of lookups over its life is bounded by the depth of
+   the stack when it was allocated.
+   In case this linear search turns out to be costly, we could switch to
+   binary search, exploiting the fact that the levels of pools in the stack
+   are expected to grow. *)
+let rec pool_of_level level pool =
+  if level >= pool.level then pool else pool_of_level level pool.next
+
+(* Create a new pool at given level, and use it locally. *)
+let with_new_pool ~level f =
+  let pool = {level; pool = []; next = !pool_stack} in
+  let r =
+    Misc.protect_refs [ R(pool_stack, pool) ] f
+  in
+  (r, pool.pool)
+
+let add_to_pool ~level ty =
+  if level >= generic_level || level <= lowest_level then () else
+  let pool = pool_of_level level !pool_stack in
+  pool.pool <- ty :: pool.pool
 
 (**** Some type creators ****)
 
+let newty3 ~level ~scope desc =
+  let ty = proto_newty3 ~level ~scope desc in
+  add_to_pool ~level ty;
+  Transient_expr.type_expr ty
+
+let newty2 ~level desc =
+  newty3 ~level ~scope:Ident.lowest_scope desc
+
 let newgenty desc      = newty2 ~level:generic_level desc
 let newgenvar ?name () = newgenty (Tvar name)
 let newgenstub ~scope  = newty3 ~level:generic_level ~scope (Tvar None)
 
-(*
-let newmarkedvar level =
-  incr new_id; { desc = Tvar; level = pivot_level - level; id = !new_id }
-let newmarkedgenvar () =
-  incr new_id;
-  { desc = Tvar; level = pivot_level - generic_level; id = !new_id }
-*)
-
 (**** Check some types ****)
 
 let is_Tvar ty = match get_desc ty with Tvar _ -> true | _ -> false
 let is_Tunivar ty = match get_desc ty with Tunivar _ -> true | _ -> false
 let is_Tconstr ty = match get_desc ty with Tconstr _ -> true | _ -> false
+let is_poly_Tpoly ty =
+  match get_desc ty with Tpoly (_, _ :: _) -> true | _ -> false
 let type_kind_is_abstract decl =
   match decl.type_kind with Type_abstract _ -> true | _ -> false
 let type_origin decl =
   match decl.type_kind with
   | Type_abstract origin -> origin
   | Type_variant _ | Type_record _ | Type_open -> Definition
+let label_is_poly lbl = is_poly_Tpoly lbl.lbl_arg
 
 let dummy_method = "*dummy method*"
 
@@ -238,7 +277,6 @@ let set_static_row_name decl path =
           set_type_desc ty (Tvariant row)
       | _ -> ()
 
-
                   (**********************************)
                   (*  Utilities for type traversal  *)
                   (**********************************)
@@ -303,24 +341,6 @@ let rec iter_abbrev f = function
   | Mcons(_, _, ty, ty', rem) -> f ty; f ty'; iter_abbrev f rem
   | Mlink rem              -> iter_abbrev f !rem
 
-type type_iterators =
-  { it_signature: type_iterators -> signature -> unit;
-    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_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;
-    it_class_type_declaration: type_iterators -> class_type_declaration -> unit;
-    it_functor_param: type_iterators -> functor_parameter -> unit;
-    it_module_type: type_iterators -> module_type -> unit;
-    it_class_type: type_iterators -> class_type -> unit;
-    it_type_kind: type_iterators -> type_decl_kind -> unit;
-    it_do_type_expr: type_iterators -> type_expr -> unit;
-    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
@@ -344,8 +364,44 @@ let iter_type_expr_kind f = function
   | Type_open ->
       ()
 
+                  (**********************************)
+                  (*     Utilities for marking      *)
+                  (**********************************)
 
-let type_iterators =
+let rec mark_type mark ty =
+  if try_mark_node mark ty then iter_type_expr (mark_type mark) ty
+
+let mark_type_params mark ty =
+  iter_type_expr (mark_type mark) ty
+
+                  (**********************************)
+                  (*  (Object-oriented) iterator    *)
+                  (**********************************)
+
+type 'a type_iterators =
+  { it_signature: 'a type_iterators -> signature -> unit;
+    it_signature_item: 'a type_iterators -> signature_item -> unit;
+    it_value_description: 'a type_iterators -> value_description -> unit;
+    it_type_declaration: 'a type_iterators -> type_declaration -> unit;
+    it_extension_constructor:
+        'a type_iterators -> extension_constructor -> unit;
+    it_module_declaration: 'a type_iterators -> module_declaration -> unit;
+    it_modtype_declaration: 'a type_iterators -> modtype_declaration -> unit;
+    it_class_declaration: 'a type_iterators -> class_declaration -> unit;
+    it_class_type_declaration:
+        'a type_iterators -> class_type_declaration -> unit;
+    it_functor_param: 'a type_iterators -> functor_parameter -> unit;
+    it_module_type: 'a type_iterators -> module_type -> unit;
+    it_class_type: 'a type_iterators -> class_type -> unit;
+    it_type_kind: 'a type_iterators -> type_decl_kind -> unit;
+    it_do_type_expr: 'a type_iterators -> 'a;
+    it_type_expr: 'a type_iterators -> type_expr -> unit;
+    it_path: Path.t -> unit; }
+
+type type_iterators_full = (type_expr -> unit) type_iterators
+type type_iterators_without_type_expr = (unit -> unit) type_iterators
+
+let type_iterators_without_type_expr =
   let it_signature it =
     List.iter (it.it_signature_item it)
   and it_signature_item it = function
@@ -405,6 +461,17 @@ let type_iterators =
         it.it_class_type it cty
   and it_type_kind it kind =
     iter_type_expr_kind (it.it_type_expr it) kind
+  and it_path _p = ()
+  in
+  { it_path; it_type_expr = (fun _ _ -> ()); it_do_type_expr = (fun _ _ -> ());
+    it_type_kind; it_class_type; it_functor_param; it_module_type;
+    it_signature; it_class_type_declaration; it_class_declaration;
+    it_modtype_declaration; it_module_declaration; it_extension_constructor;
+    it_type_declaration; it_value_description; it_signature_item; }
+
+let type_iterators mark =
+  let it_type_expr it ty =
+    if try_mark_node mark ty then it.it_do_type_expr it ty
   and it_do_type_expr it ty =
     iter_type_expr (it.it_type_expr it) ty;
     match get_desc ty with
@@ -415,13 +482,12 @@ let type_iterators =
     | Tvariant row ->
         Option.iter (fun (p,_) -> it.it_path p) (row_name row)
     | _ -> ()
-  and it_path _p = ()
   in
-  { it_path; it_type_expr = it_do_type_expr; it_do_type_expr;
-    it_type_kind; it_class_type; it_functor_param; it_module_type;
-    it_signature; it_class_type_declaration; it_class_declaration;
-    it_modtype_declaration; it_module_declaration; it_extension_constructor;
-    it_type_declaration; it_value_description; it_signature_item; }
+  {type_iterators_without_type_expr with it_type_expr; it_do_type_expr}
+
+                  (**********************************)
+                  (*  Utilities for copying         *)
+                  (**********************************)
 
 let copy_row f fixed row keep more =
   let Row {fields = orig_fields; fixed = orig_fixed; closed; name = orig_name} =
@@ -467,8 +533,7 @@ let rec copy_type_desc ?(keep_names=false) f = function
       Tpoly (f ty, tyl)
   | Tpackage (p, fl)  -> Tpackage (p, List.map (fun (n, ty) -> (n, f ty)) fl)
 
-(* Utilities for copying *)
-
+(* TODO: rename to [module Copy_scope] *)
 module For_copy : sig
   type copy_scope
 
@@ -492,9 +557,8 @@ end = struct
 
   let with_scope f =
     let scope = { saved_desc = [] } in
-    let res = f scope in
-    cleanup scope;
-    res
+    Fun.protect ~finally:(fun () -> cleanup scope) (fun () -> f scope)
+
 end
 
                   (*******************************************)
@@ -711,66 +775,10 @@ let instance_variable_type label sign =
   | (_, _, ty) -> ty
   | exception Not_found -> assert false
 
-                  (**********************************)
-                  (*  Utilities for level-marking   *)
-                  (**********************************)
-
-let not_marked_node ty = get_level ty >= lowest_level
-    (* type nodes with negative levels are "marked" *)
-
-let flip_mark_node ty =
-  let ty = Transient_expr.repr ty in
-  Transient_expr.set_level ty (pivot_level - ty.level)
-let logged_mark_node ty =
-  set_level ty (pivot_level - get_level ty)
-
-let try_mark_node ty = not_marked_node ty && (flip_mark_node ty; true)
-let try_logged_mark_node ty = not_marked_node ty && (logged_mark_node ty; true)
-
-let rec mark_type ty =
-  if not_marked_node ty then begin
-    flip_mark_node ty;
-    iter_type_expr mark_type ty
-  end
-
-let mark_type_params ty =
-  iter_type_expr mark_type ty
-
-let type_iterators =
-  let it_type_expr it ty =
-    if try_mark_node ty then it.it_do_type_expr it ty
-  in
-  {type_iterators with it_type_expr}
-
-
-(* Remove marks from a type. *)
-let rec unmark_type ty =
-  if get_level ty < lowest_level then begin
-    (* flip back the marked level *)
-    flip_mark_node ty;
-    iter_type_expr unmark_type ty
-  end
-
-let unmark_iterators =
-  let it_type_expr _it ty = unmark_type ty in
-  {type_iterators with it_type_expr}
-
-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;
-  Option.iter unmark_type ext.ext_ret_type
-
-let unmark_class_signature sign =
-  unmark_type sign.csig_self;
-  unmark_type sign.csig_self_row;
-  Vars.iter (fun _l (_m, _v, t) -> unmark_type t) sign.csig_vars;
-  Meths.iter (fun _l (_m, _v, t) -> unmark_type t) sign.csig_meths
 
-let unmark_class_type cty =
-  unmark_iterators.it_class_type unmark_iterators cty
+                  (**********)
+                  (*  Misc  *)
+                  (**********)
 
 (**** Type information getter ****)
 

diff --git a/typing/btype.mli b/typing/btype.mli
index 077fb726525494635dfe2289e1211ce0949e0207..f8fd3ad3e817b5ced982fa4002003e926a803b93 100644 (file)
--- a/typing/btype.mli
+++ b/typing/btype.mli
@@ -58,6 +58,22 @@ end
 (**** Levels ****)
 
 val generic_level: int
+        (* level of polymorphic variables; = Ident.highest_scope *)
+val lowest_level: int
+        (* lowest level for type nodes; = Ident.lowest_scope *)
+
+val with_new_pool: level:int -> (unit -> 'a) -> 'a * transient_expr list
+        (* [with_new_pool ~level f] executes [f] and returns the nodes
+           that were created at level [level] and above *)
+val add_to_pool: level:int -> transient_expr -> unit
+        (* Add a type node to the pool associated to the level (which should
+           be the level of the type node).
+           Do nothing if [level = generic_level] or [level = lowest_level]. *)
+
+val newty3: level:int -> scope:int -> type_desc -> type_expr
+        (* Create a type with a fresh id *)
+val newty2: level:int -> type_desc -> type_expr
+        (* Create a type with a fresh id and no scope *)
 
 val newgenty: type_desc -> type_expr
         (* Create a generic type *)
@@ -67,21 +83,16 @@ val newgenstub: scope:int -> type_expr
         (* Return a fresh generic node, to be instantiated
            by [Transient_expr.set_stub_desc] *)
 
-(* Use Tsubst instead
-val newmarkedvar: int -> type_expr
-        (* Return a fresh marked variable *)
-val newmarkedgenvar: unit -> type_expr
-        (* Return a fresh marked generic variable *)
-*)
-
 (**** Types ****)
 
 val is_Tvar: type_expr -> bool
 val is_Tunivar: type_expr -> bool
 val is_Tconstr: type_expr -> bool
+val is_poly_Tpoly: type_expr -> bool
 val dummy_method: label
 val type_kind_is_abstract: type_declaration -> bool
-val type_origin : type_declaration -> type_origin
+val type_origin: type_declaration -> type_origin
+val label_is_poly: label_description -> bool
 
 (**** polymorphic variants ****)
 
@@ -136,29 +147,47 @@ val iter_type_expr_cstr_args: (type_expr -> unit) ->
 val map_type_expr_cstr_args: (type_expr -> type_expr) ->
   (constructor_arguments -> constructor_arguments)
 
+(**** Utilities for type marking ****)
 
-type type_iterators =
-  { it_signature: type_iterators -> signature -> unit;
-    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_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;
-    it_class_type_declaration: type_iterators -> class_type_declaration -> unit;
-    it_functor_param: type_iterators -> functor_parameter -> unit;
-    it_module_type: type_iterators -> module_type -> unit;
-    it_class_type: type_iterators -> class_type -> unit;
-    it_type_kind: type_iterators -> type_decl_kind -> unit;
-    it_do_type_expr: type_iterators -> type_expr -> unit;
-    it_type_expr: type_iterators -> type_expr -> unit;
+val mark_type: type_mark -> type_expr -> unit
+        (* Mark a type recursively *)
+val mark_type_params: type_mark -> type_expr -> unit
+        (* Mark the sons of a type node recursively *)
+
+(**** (Object-oriented) iterator ****)
+
+type 'a type_iterators =
+  { it_signature: 'a type_iterators -> signature -> unit;
+    it_signature_item: 'a type_iterators -> signature_item -> unit;
+    it_value_description: 'a type_iterators -> value_description -> unit;
+    it_type_declaration: 'a type_iterators -> type_declaration -> unit;
+    it_extension_constructor:
+        'a type_iterators -> extension_constructor -> unit;
+    it_module_declaration: 'a type_iterators -> module_declaration -> unit;
+    it_modtype_declaration: 'a type_iterators -> modtype_declaration -> unit;
+    it_class_declaration: 'a type_iterators -> class_declaration -> unit;
+    it_class_type_declaration:
+        'a type_iterators -> class_type_declaration -> unit;
+    it_functor_param: 'a type_iterators -> functor_parameter -> unit;
+    it_module_type: 'a type_iterators -> module_type -> unit;
+    it_class_type: 'a type_iterators -> class_type -> unit;
+    it_type_kind: 'a type_iterators -> type_decl_kind -> unit;
+    it_do_type_expr: 'a type_iterators -> 'a;
+    it_type_expr: 'a type_iterators -> type_expr -> unit;
     it_path: Path.t -> unit; }
-val type_iterators: type_iterators
-        (* Iteration on arbitrary type information.
+
+type type_iterators_full = (type_expr -> unit) type_iterators
+type type_iterators_without_type_expr = (unit -> unit) type_iterators
+
+val type_iterators: type_mark -> type_iterators_full
+        (* Iteration on arbitrary type information, including [type_expr].
            [it_type_expr] calls [mark_node] to avoid loops. *)
-val unmark_iterators: type_iterators
-        (* Unmark any structure containing types. See [unmark_type] below. *)
+
+val type_iterators_without_type_expr: type_iterators_without_type_expr
+        (* Iteration on arbitrary type information.
+           Cannot recurse on [type_expr]. *)
+
+(**** Utilities for copying ****)
 
 val copy_type_desc:
     ?keep_names:bool -> (type_expr -> type_expr) -> type_desc -> type_desc
@@ -184,41 +213,6 @@ module For_copy : sig
            before returning its result. *)
 end
 
-val lowest_level: int
-        (* Marked type: ty.level < lowest_level *)
-
-val not_marked_node: type_expr -> bool
-        (* Return true if a type node is not yet marked *)
-
-val logged_mark_node: type_expr -> unit
-        (* Mark a type node, logging the marking so it can be backtracked *)
-val try_logged_mark_node: type_expr -> bool
-        (* Mark a type node if it is not yet marked, logging the marking so it
-           can be backtracked.
-           Return false if it was already marked *)
-
-val flip_mark_node: type_expr -> unit
-        (* Mark a type node.
-           The marking is not logged and will have to be manually undone using
-           one of the various [unmark]'ing functions below. *)
-val try_mark_node: type_expr -> bool
-        (* Mark a type node if it is not yet marked.
-           The marking is not logged and will have to be manually undone using
-           one of the various [unmark]'ing functions below.
-
-           Return false if it was already marked *)
-val mark_type: type_expr -> unit
-        (* Mark a type recursively *)
-val mark_type_params: type_expr -> unit
-        (* Mark the sons of a type node recursively *)
-
-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 *)
-
 (**** Memorization of abbreviation expansion ****)
 
 val find_expans: private_flag -> Path.t -> abbrev_memo -> type_expr option
@@ -312,9 +306,6 @@ val method_type : label -> class_signature -> type_expr
    @raises [Assert_failure] if the class has no such method. *)
 val instance_variable_type : label -> class_signature -> type_expr
 
-(**** Forward declarations ****)
-val print_raw: (Format.formatter -> type_expr -> unit) ref
-
 (**** Type information getter ****)
 
 val cstr_type_path : constructor_description -> Path.t

diff --git a/typing/cmt2annot.ml b/typing/cmt2annot.ml
index e8850e503ab19365753776b0f3a93ceae59809a7..698cccab99721c44a43328408182e18ae341c0a3 100644 (file)
--- a/typing/cmt2annot.ml
+++ b/typing/cmt2annot.ml
@@ -100,10 +100,12 @@ let rec iterator ~scope rebuild_env =
         bind_bindings exp.exp_loc bindings
     | Texp_let (Nonrecursive, bindings, body) ->
         bind_bindings body.exp_loc bindings
-    | Texp_match (_, f1, _) ->
-        bind_cases f1
-    | Texp_try (_, f) ->
-        bind_cases f
+    | Texp_match (_, f1, f2, _) ->
+        bind_cases f1;
+        bind_cases f2
+    | Texp_try (_, f1, f2) ->
+        bind_cases f1;
+        bind_cases f2
     | Texp_function (params, _) ->
         List.iter (bind_function_param exp.exp_loc) params
     | Texp_letmodule (_, modname, _, _, body ) ->

diff --git a/typing/cmt2annot.mli b/typing/cmt2annot.mli
index 2dfa8dec2ace48c1c3766d75fe703e4f737908fd..978e00d36b067914be9cd765dd4db393ee429ec1 100644 (file)
--- a/typing/cmt2annot.mli
+++ b/typing/cmt2annot.mli
@@ -20,3 +20,7 @@ val gen_annot :
   sourcefile:string option ->
   use_summaries:bool -> Cmt_format.binary_annots ->
   unit
+
+val iterator : scope:Location.t -> bool -> Tast_iterator.iterator
+
+val binary_part : Tast_iterator.iterator -> Cmt_format.binary_part -> unit

diff --git a/typing/ctype.ml b/typing/ctype.ml
index 8e7c35bb39af7fedbe0f6a36f0277101a1c08a6d..c54a2b7a2a61de430885748a74417b6268fe462c 100644 (file)
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -23,16 +23,6 @@ open Errortrace
 
 open Local_store
 
-(*
-   Type manipulation after type inference
-   ======================================
-   If one wants to manipulate a type after type inference (for
-   instance, during code generation or in the debugger), one must
-   first make sure that the type levels are correct, using the
-   function [correct_levels]. Then, this type can be correctly
-   manipulated by [apply], [expand_head] and [moregeneral].
-*)
-
 (*
    General notes
    =============
@@ -119,10 +109,11 @@ let raise_scope_escape_exn ty = raise (scope_escape_exn ty)
 exception Tags of label * label
 
 let () =
+  let open Format_doc in
   Location.register_error_of_exn
     (function
       | Tags (l, l') ->
-          let pp_tag ppf s = Format.fprintf ppf "`%s" s in
+          let pp_tag ppf s = fprintf ppf "`%s" s in
           let inline_tag = Misc.Style.as_inline_code pp_tag in
           Some
             Location.
@@ -142,10 +133,37 @@ exception Cannot_subst
 
 exception Cannot_unify_universal_variables
 
+exception Out_of_scope_universal_variable
+
 exception Matches_failure of Env.t * unification_error
 
 exception Incompatible
 
+(**** Control tracing of GADT instances *)
+
+let trace_gadt_instances = ref false
+let check_trace_gadt_instances ?(force=false) env =
+  not !trace_gadt_instances && (force || Env.has_local_constraints env) &&
+  (trace_gadt_instances := true; cleanup_abbrev (); true)
+
+let reset_trace_gadt_instances b =
+  if b then trace_gadt_instances := false
+
+let wrap_trace_gadt_instances ?force env f x =
+  let b = check_trace_gadt_instances ?force env in
+  Misc.try_finally (fun () -> f x)
+    ~always:(fun () -> reset_trace_gadt_instances b)
+
+(**** Abbreviations without parameters ****)
+(* Shall reset after generalizing *)
+
+let simple_abbrevs = ref Mnil
+
+let proper_abbrevs tl abbrev =
+  if tl <> [] || !trace_gadt_instances || !Clflags.principal
+  then abbrev
+  else simple_abbrevs
+
 (**** Type level management ****)
 
 let current_level = s_ref 0
@@ -169,11 +187,81 @@ let end_def () =
   saved_level := List.tl !saved_level;
   current_level := cl; nongen_level := nl
 let create_scope () =
-  init_def (!current_level + 1);
-  !current_level
+  let level = !current_level + 1 in
+  init_def level;
+  level
 
 let wrap_end_def f = Misc.try_finally f ~always:end_def
 
+(* [with_local_level_gen] handles both the scoping structure of levels
+   and automatic generalization through pools (cf. btype.ml) *)
+let with_local_level_gen ~begin_def ~structure ?before_generalize f =
+  begin_def ();
+  let level = !current_level in
+  let result, pool =
+    with_new_pool ~level:!current_level begin fun () ->
+      let result = wrap_end_def f in
+      Option.iter (fun g -> g result) before_generalize;
+      result
+    end
+  in
+  simple_abbrevs := Mnil;
+  (* Nodes in [pool] were either created by the above calls to [f]
+     and [before_generalize], or they were created before, generalized,
+     and then added to the pool by [update_level].
+     In the latter case, their level was already kept for backtracking
+     by a call to [set_level] inside [update_level].
+     Since backtracking can only go back to a snapshot taken before [f] was
+     called, this means that either they did not exists in that snapshot,
+     or that they original level is already stored, so that there is no need
+     to register levels for backtracking when we change them with
+     [Transient_expr.set_level] here *)
+  List.iter begin fun ty ->
+    (* Already generic nodes are not tracked *)
+    if ty.level = generic_level then () else
+    match ty.desc with
+    | Tvar _ when structure ->
+        (* In structure mode, we do do not generalize type variables,
+           so we need to lower their level, and move them to an outer pool.
+           The goal of this mode is to allow unsharing inner nodes
+           without introducing polymorphism *)
+        if ty.level >= level then Transient_expr.set_level ty !current_level;
+        add_to_pool ~level:ty.level ty
+    | Tlink _ -> ()
+        (* If a node is no longer used as representative, no need
+           to track it anymore *)
+    | _ ->
+        if ty.level < level then
+          (* If a node was introduced locally, but its level was lowered
+             through unification, keeping that node as representative,
+             then we need to move it to an outer pool. *)
+          add_to_pool ~level:ty.level ty
+        else begin
+          (* Generalize all remaining nodes *)
+          Transient_expr.set_level ty generic_level;
+          if structure then match ty.desc with
+            Tconstr (_, _, abbrev) ->
+              (* In structure mode, we drop abbreviations, as the goal of
+                 this mode is to reduce sharing *)
+              abbrev := Mnil
+          | _ -> ()
+        end
+  end pool;
+  result
+
+let with_local_level_generalize_structure f =
+  with_local_level_gen ~begin_def ~structure:true f
+let with_local_level_generalize ?before_generalize f =
+  with_local_level_gen ~begin_def ~structure:false ?before_generalize f
+let with_local_level_generalize_if cond ?before_generalize f =
+  if cond then with_local_level_generalize ?before_generalize f else f ()
+let with_local_level_generalize_structure_if cond f =
+  if cond then with_local_level_generalize_structure f else f ()
+let with_local_level_generalize_structure_if_principal f =
+  if !Clflags.principal then with_local_level_generalize_structure f else f ()
+let with_local_level_generalize_for_class f =
+  with_local_level_gen ~begin_def:begin_class_def ~structure:false f
+
 let with_local_level ?post f =
   begin_def ();
   let result = wrap_end_def f in
@@ -183,7 +271,7 @@ let with_local_level_if cond f ~post =
   if cond then with_local_level f ~post else f ()
 let with_local_level_iter f ~post =
   begin_def ();
-  let result, l = wrap_end_def f in
+  let (result, l) = wrap_end_def f in
   List.iter post l;
   result
 let with_local_level_iter_if cond f ~post =
@@ -194,8 +282,7 @@ let with_local_level_iter_if_principal f ~post =
   with_local_level_iter_if !Clflags.principal f ~post
 let with_level ~level f =
   begin_def (); init_def level;
-  let result = wrap_end_def f in
-  result
+  wrap_end_def f
 let with_level_if cond ~level f =
   if cond then with_level ~level f else f ()
 
@@ -219,32 +306,6 @@ let increase_global_level () =
 let restore_global_level gl =
   global_level := gl
 
-(**** Control tracing of GADT instances *)
-
-let trace_gadt_instances = ref false
-let check_trace_gadt_instances env =
-  not !trace_gadt_instances && Env.has_local_constraints env &&
-  (trace_gadt_instances := true; cleanup_abbrev (); true)
-
-let reset_trace_gadt_instances b =
-  if b then trace_gadt_instances := false
-
-let wrap_trace_gadt_instances env f x =
-  let b = check_trace_gadt_instances env in
-  let y = f x in
-  reset_trace_gadt_instances b;
-  y
-
-(**** Abbreviations without parameters ****)
-(* Shall reset after generalizing *)
-
-let simple_abbrevs = ref Mnil
-
-let proper_abbrevs tl abbrev =
-  if tl <> [] || !trace_gadt_instances || !Clflags.principal
-  then abbrev
-  else simple_abbrevs
-
 (**** Some type creators ****)
 
 (* Re-export generic type creators *)
@@ -291,10 +352,6 @@ end
 
 (**** unification mode ****)
 
-type equations_generation =
-  | Forbidden
-  | Allowed of { equated_types : TypePairs.t }
-
 type unification_environment =
   | Expression of
       { env : Env.t;
@@ -302,7 +359,7 @@ type unification_environment =
     (* normal unification mode *)
   | Pattern of
       { penv : Pattern_env.t;
-        equations_generation : equations_generation;
+        equated_types : TypePairs.t;
         assume_injective : bool;
         unify_eq_set : TypePairs.t; }
     (* GADT constraint unification mode:
@@ -349,16 +406,12 @@ let in_subst_mode = function
   | Expression {in_subst} -> in_subst
   | Pattern _ -> false
 
-let can_generate_equations = function
-  | Expression _ | Pattern { equations_generation = Forbidden } -> false
-  | Pattern { equations_generation = Allowed _ } -> true
-
 (* Can only be called when generate_equations is true *)
 let record_equation uenv t1 t2 =
   match uenv with
-  | Expression _ | Pattern { equations_generation = Forbidden } ->
+  | Expression _ ->
       invalid_arg "Ctype.record_equation"
-  | Pattern { equations_generation = Allowed { equated_types } } ->
+  | Pattern { equated_types } ->
       TypePairs.add equated_types (t1, t2)
 
 let can_assume_injective = function
@@ -380,11 +433,6 @@ let without_assume_injective uenv f =
   | Expression _ as uenv -> f uenv
   | Pattern r -> f (Pattern { r with assume_injective = false })
 
-let without_generating_equations uenv f =
-  match uenv with
-  | Expression _ as uenv -> f uenv
-  | Pattern r -> f (Pattern { r with equations_generation = Forbidden })
-
 (*** Checks for type definitions ***)
 
 let rec in_current_module = function
@@ -534,35 +582,34 @@ let rec filter_row_fields erase = function
 type variable_kind = Row_variable | Type_variable
 exception Non_closed of type_expr * variable_kind
 
-(* [free_vars] collects the variables of the input type expression. It
+(* [free_vars] walks over the variables of the input type expression. It
    is used for several different things in the type-checker, with the
    following bells and whistles:
    - If [env] is Some typing environment, types in the environment
      are expanded to check whether the apparently-free variable would vanish
      during expansion.
-   - We collect both type variables and row variables, paired with
-     a [variable_kind] to distinguish them.
    - We do not count "virtual" free variables -- free variables stored in
      the abbreviation of an object type that has been expanded (we store
      the abbreviations for use when displaying the type).
 
-   [free_vars] returns a [(variable * bool) list], while
-   [free_variables] below drops the type/row information
-   and only returns a [variable list].
+   [free_vars] accumulates its answer in a monoid-like structure, with
+   an initial element [zero] and a combining function [add_one], passing
+   [add_one] information about whether the variable is a normal type variable
+   or a row variable.
  *)
-let free_vars ?env ty =
+let free_vars ~init ~add_one ?env mark ty =
   let rec fv ~kind acc ty =
-    if not (try_mark_node ty) then acc
+    if not (try_mark_node mark ty) then acc
     else match get_desc ty, env with
       | Tvar _, _ ->
-          (ty, kind) :: acc
+          add_one ty kind acc
       | Tconstr (path, tl, _), Some env ->
           let acc =
             match Env.find_type_expansion path env with
             | exception Not_found -> acc
             | (_, body, _) ->
                 if get_level body = generic_level then acc
-                else (ty, kind) :: acc
+                else add_one ty kind acc
           in
           List.fold_left (fv ~kind:Type_variable) acc tl
       | Tobject (ty, _), _ ->
@@ -578,29 +625,30 @@ let free_vars ?env ty =
           else fv ~kind:Row_variable acc (row_more row)
       | _    ->
           fold_type_expr (fv ~kind) acc ty
-  in fv ~kind:Type_variable [] ty
+  in fv ~kind:Type_variable init ty
 
 let free_variables ?env ty =
-  let tl = List.map fst (free_vars ?env ty) in
-  unmark_type ty;
-  tl
+  let add_one ty _kind acc = ty :: acc in
+  with_type_mark (fun mark -> free_vars ~init:[] ~add_one ?env mark ty)
 
-let closed_type ty =
-  match free_vars ty with
-      []           -> ()
-  | (v, real) :: _ -> raise (Non_closed (v, real))
+let closed_type ?env mark ty =
+  let add_one ty kind _acc = raise (Non_closed (ty, kind)) in
+  free_vars ~init:() ~add_one ?env mark ty
+
+let closed_type_expr ?env ty =
+  with_type_mark (fun mark ->
+    try closed_type ?env mark ty; true
+    with Non_closed _ -> false)
 
 let closed_parameterized_type params ty =
-  List.iter mark_type params;
-  let ok =
-    try closed_type ty; true with Non_closed _ -> false in
-  List.iter unmark_type params;
-  unmark_type ty;
-  ok
+  with_type_mark begin fun mark ->
+    List.iter (mark_type mark) params;
+    try closed_type mark ty; true with Non_closed _ -> false
+  end
 
 let closed_type_decl decl =
-  try
-    List.iter mark_type decl.type_params;
+  with_type_mark begin fun mark -> try
+    List.iter (mark_type mark) decl.type_params;
     begin match decl.type_kind with
       Type_abstract _ ->
         ()
@@ -611,36 +659,35 @@ let closed_type_decl decl =
             | Some _ -> ()
             | None ->
                 match cd_args with
-                | Cstr_tuple l ->  List.iter closed_type l
-                | Cstr_record l -> List.iter (fun l -> closed_type l.ld_type) l
+                | Cstr_tuple l ->  List.iter (closed_type mark) l
+                | Cstr_record l ->
+                    List.iter (fun l -> closed_type mark l.ld_type) l
           )
           v
     | Type_record(r, _rep) ->
-        List.iter (fun l -> closed_type l.ld_type) r
+        List.iter (fun l -> closed_type mark l.ld_type) r
     | Type_open -> ()
     end;
     begin match decl.type_manifest with
       None    -> ()
-    | Some ty -> closed_type ty
+    | Some ty -> closed_type mark ty
     end;
-    unmark_type_decl decl;
     None
   with Non_closed (ty, _) ->
-    unmark_type_decl decl;
     Some ty
+  end
 
 let closed_extension_constructor ext =
-  try
-    List.iter mark_type ext.ext_type_params;
+  with_type_mark begin fun mark -> try
+    List.iter (mark_type mark) ext.ext_type_params;
     begin match ext.ext_ret_type with
     | Some _ -> ()
-    | None -> iter_type_expr_cstr_args closed_type ext.ext_args
+    | None -> iter_type_expr_cstr_args (closed_type mark) ext.ext_args
     end;
-    unmark_extension_constructor ext;
     None
   with Non_closed (ty, _) ->
-    unmark_extension_constructor ext;
     Some ty
+  end
 
 type closed_class_failure = {
   free_variable: type_expr * variable_kind;
@@ -650,13 +697,14 @@ type closed_class_failure = {
 exception CCFailure of closed_class_failure
 
 let closed_class params sign =
-  List.iter mark_type params;
-  ignore (try_mark_node sign.csig_self_row);
+  with_type_mark begin fun mark ->
+  List.iter (mark_type mark) params;
+  ignore (try_mark_node mark sign.csig_self_row);
   try
     Meths.iter
       (fun lab (priv, _, ty) ->
         if priv = Mpublic then begin
-          try closed_type ty with Non_closed (ty0, variable_kind) ->
+          try closed_type mark ty with Non_closed (ty0, variable_kind) ->
             raise (CCFailure {
               free_variable = (ty0, variable_kind);
               meth = lab;
@@ -664,14 +712,10 @@ let closed_class params sign =
             })
         end)
       sign.csig_meths;
-    List.iter unmark_type params;
-    unmark_class_signature sign;
     None
   with CCFailure reason ->
-    List.iter unmark_type params;
-    unmark_class_signature sign;
     Some reason
-
+  end
 
                             (**********************)
                             (*  Type duplication  *)
@@ -691,76 +735,53 @@ let duplicate_class_type ty =
                          (*  Type level manipulation  *)
                          (*****************************)
 
-(*
-   It would be a bit more efficient to remove abbreviation expansions
-   rather than generalizing them: these expansions will usually not be
-   used anymore. However, this is not possible in the general case, as
-   [expand_abbrev] (via [subst]) requires these expansions to be
-   preserved. Does it worth duplicating this code ?
-*)
-let rec generalize ty =
-  let level = get_level ty in
-  if (level > !current_level) && (level <> generic_level) then begin
-    set_level ty generic_level;
-    (* recur into abbrev for the speed *)
-    begin match get_desc ty with
-      Tconstr (_, _, abbrev) ->
-        iter_abbrev generalize !abbrev
-    | _ -> ()
-    end;
-    iter_type_expr generalize ty
-  end
 
-let generalize ty =
-  simple_abbrevs := Mnil;
-  generalize ty
-
-(* Generalize the structure and lower the variables *)
-
-let rec generalize_structure ty =
-  let level = get_level ty in
-  if level <> generic_level then begin
-    if is_Tvar ty && level > !current_level then
-      set_level ty !current_level
-    else if level > !current_level then begin
-      begin match get_desc ty with
-        Tconstr (_, _, abbrev) ->
-          abbrev := Mnil
-      | _ -> ()
-      end;
-      set_level ty generic_level;
-      iter_type_expr generalize_structure ty
-    end
-  end
-
-let generalize_structure ty =
-  simple_abbrevs := Mnil;
-  generalize_structure ty
-
-(* Generalize the spine of a function, if the level >= !current_level *)
+(*
+   Build a copy of a type in which nodes reachable through a path composed
+   only of Tarrow, Tpoly, Ttuple, Tpackage and Tconstr, and whose level
+   was no lower than [!current_level], are at [generic_level].
+   This is different from [with_local_level_gen], which generalizes in place,
+   and only nodes with a level higher than [!current_level].
+   This is used for typing classes, to indicate which types have been
+   inferred in the first pass, and can be considered as "known" during the
+   second pass.
+ *)
 
-let rec generalize_spine ty =
-  let level = get_level ty in
-  if level < !current_level || level = generic_level then () else
+let rec copy_spine copy_scope ty =
   match get_desc ty with
-    Tarrow (_, ty1, ty2, _) ->
-      set_level ty generic_level;
-      generalize_spine ty1;
-      generalize_spine ty2;
-  | Tpoly (ty', _) ->
-      set_level ty generic_level;
-      generalize_spine ty'
-  | Ttuple tyl ->
-      set_level ty generic_level;
-      List.iter generalize_spine tyl
-  | Tpackage (_, fl) ->
-      set_level ty generic_level;
-      List.iter (fun (_n, ty) -> generalize_spine ty) fl
-  | Tconstr (_, tyl, memo) ->
-      set_level ty generic_level;
-      memo := Mnil;
-      List.iter generalize_spine tyl
-  | _ -> ()
+  | Tsubst (ty, _) -> ty
+  | Tvar _
+  | Tfield _
+  | Tnil
+  | Tvariant _
+  | Tobject _
+  | Tlink _
+  | Tunivar _ -> ty
+  | (Tarrow _ | Tpoly _ | Ttuple _ | Tpackage _ | Tconstr _) as desc ->
+      let level = get_level ty in
+      if level < !current_level || level = generic_level then ty else
+      let t = newgenstub ~scope:(get_scope ty) in
+      For_copy.redirect_desc copy_scope ty (Tsubst (t, None));
+      let copy_rec = copy_spine copy_scope in
+      let desc' = match desc with
+      | Tarrow (lbl, ty1, ty2, _) ->
+          Tarrow (lbl, copy_rec ty1, copy_rec ty2, commu_ok)
+      | Tpoly (ty', tvl) ->
+          Tpoly (copy_rec ty', tvl)
+      | Ttuple tyl ->
+          Ttuple (List.map copy_rec tyl)
+      | Tpackage (path, fl) ->
+          let fl = List.map (fun (n, ty) -> n, copy_rec ty) fl in
+          Tpackage (path, fl)
+      | Tconstr (path, tyl, _) ->
+          Tconstr (path, List.map copy_rec tyl, ref Mnil)
+      | _ -> assert false
+      in
+      Transient_expr.set_stub_desc t desc';
+      t
+
+let copy_spine ty =
+  For_copy.with_scope (fun copy_scope -> copy_spine copy_scope ty)
 
 let forward_try_expand_safe = (* Forward declaration *)
   ref (fun _env _ty -> assert false)
@@ -786,35 +807,35 @@ let rec normalize_package_path env p =
           normalize_package_path env (Path.Pdot (p1', s))
       | _ -> p
 
-let rec check_scope_escape env level ty =
+let rec check_scope_escape mark env level ty =
   let orig_level = get_level ty in
-  if try_logged_mark_node ty then begin
+  if try_mark_node mark ty then begin
     if level < get_scope ty then
       raise_scope_escape_exn ty;
     begin match get_desc ty with
     | Tconstr (p, _, _) when level < Path.scope p ->
         begin match !forward_try_expand_safe env ty with
         | ty' ->
-            check_scope_escape env level ty'
+            check_scope_escape mark env level ty'
         | exception Cannot_expand ->
             raise_escape_exn (Constructor p)
         end
     | Tpackage (p, fl) when level < Path.scope p ->
         let p' = normalize_package_path env p in
         if Path.same p p' then raise_escape_exn (Module_type p);
-        check_scope_escape env level
+        check_scope_escape mark env level
           (newty2 ~level:orig_level (Tpackage (p', fl)))
     | _ ->
-        iter_type_expr (check_scope_escape env level) ty
+        iter_type_expr (check_scope_escape mark env level) ty
     end;
   end
 
 let check_scope_escape env level ty =
-  let snap = snapshot () in
-  try check_scope_escape env level ty; backtrack snap
+  with_type_mark begin fun mark -> try
+    check_scope_escape mark env level ty
   with Escape e ->
-    backtrack snap;
     raise (Escape { e with context = Some ty })
+  end
 
 let rec update_scope scope ty =
   if get_scope ty < scope then begin
@@ -838,8 +859,14 @@ let update_scope_for tr_exn scope ty =
 *)
 
 let rec update_level env level expand ty =
-  if get_level ty > level then begin
+  let ty_level = get_level ty in
+  if ty_level > level then begin
     if level < get_scope ty then raise_scope_escape_exn ty;
+    let set_level () =
+      set_level ty level;
+      if ty_level = generic_level then
+        add_to_pool ~level (Transient_expr.repr ty)
+    in
     match get_desc ty with
       Tconstr(p, _tl, _abbrev) when level < Path.scope p ->
         (* Try first to replace an abbreviation by its expansion. *)
@@ -866,7 +893,7 @@ let rec update_level env level expand ty =
           link_type ty ty';
           update_level env level expand ty'
         with Cannot_expand ->
-          set_level ty level;
+          set_level ();
           iter_type_expr (update_level env level expand) ty
         end
     | Tpackage (p, fl) when level < Path.scope p ->
@@ -884,13 +911,13 @@ let rec update_level env level expand ty =
             set_type_desc ty (Tvariant (set_row_name row None))
         | _ -> ()
         end;
-        set_level ty level;
+        set_level ();
         iter_type_expr (update_level env level expand) ty
     | Tfield(lab, _, ty1, _)
       when lab = dummy_method && level < get_scope ty1 ->
         raise_escape_exn Self
     | _ ->
-        set_level ty level;
+        set_level ();
         (* XXX what about abbreviations in Tconstr ? *)
         iter_type_expr (update_level env level expand) ty
   end
@@ -969,11 +996,11 @@ let lower_contravariant env ty =
   simple_abbrevs := Mnil;
   lower_contravariant env !nongen_level (Hashtbl.create 7) false ty
 
-let rec generalize_class_type' gen =
+let rec generalize_class_type gen =
   function
     Cty_constr (_, params, cty) ->
       List.iter gen params;
-      generalize_class_type' gen cty
+      generalize_class_type gen cty
   | Cty_signature csig ->
       gen csig.csig_self;
       gen csig.csig_self_row;
@@ -981,20 +1008,10 @@ let rec generalize_class_type' gen =
       Meths.iter (fun _ (_, _, ty) -> gen ty) csig.csig_meths
   | Cty_arrow (_, ty, cty) ->
       gen ty;
-      generalize_class_type' gen cty
-
-let generalize_class_type cty =
-  generalize_class_type' generalize cty
-
-let generalize_class_type_structure cty =
-  generalize_class_type' generalize_structure cty
-
-(* Correct the levels of type [ty]. *)
-let correct_levels ty =
-  duplicate_type ty
+      generalize_class_type gen cty
 
 (* Only generalize the type ty0 in ty *)
-let limited_generalize ty0 ty =
+let limited_generalize ty0 ~inside:ty =
   let graph = TypeHash.create 17 in
   let roots = ref [] in
 
@@ -1034,8 +1051,8 @@ let limited_generalize ty0 ty =
        if get_level ty <> generic_level then set_level ty !current_level)
     graph
 
-let limited_generalize_class_type rv cty =
-  generalize_class_type' (limited_generalize rv) cty
+let limited_generalize_class_type rv ~inside:cty =
+  generalize_class_type (fun inside -> limited_generalize rv ~inside) cty
 
 (* Compute statically the free univars of all nodes in a type *)
 (* This avoids doing it repeatedly during instantiation *)
@@ -1078,15 +1095,14 @@ let compute_univars ty =
 
 
 let fully_generic ty =
-  let rec aux ty =
-    if not_marked_node ty then
-      if get_level ty = generic_level then
-        (flip_mark_node ty; iter_type_expr aux ty)
-      else raise Exit
-  in
-  let res = try aux ty; true with Exit -> false in
-  unmark_type ty;
-  res
+  with_type_mark begin fun mark ->
+    let rec aux ty =
+      if try_mark_node mark ty then
+        if get_level ty = generic_level then iter_type_expr aux ty
+        else raise Exit
+    in
+    try aux ty; true with Exit -> false
+  end
 
 
                               (*******************)
@@ -1243,11 +1259,7 @@ let instance ?partial sch =
     copy ?partial copy_scope sch)
 
 let generic_instance sch =
-  let old = !current_level in
-  current_level := generic_level;
-  let ty = instance sch in
-  current_level := old;
-  ty
+  with_level ~level:generic_level (fun () -> instance sch)
 
 let instance_list schl =
   For_copy.with_scope (fun copy_scope ->
@@ -1288,7 +1300,7 @@ let new_local_type ?(loc = Location.none) ?manifest_and_scope origin =
     type_attributes = [];
     type_immediate = Unknown;
     type_unboxed_default = false;
-    type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+    type_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
   }
 
 let existential_name name_counter ty =
@@ -1370,11 +1382,7 @@ let instance_declaration decl =
   )
 
 let generic_instance_declaration decl =
-  let old = !current_level in
-  current_level := generic_level;
-  let decl = instance_declaration decl in
-  current_level := old;
-  decl
+  with_level ~level:generic_level (fun () -> instance_declaration decl)
 
 let instance_class params cty =
   let rec copy_class_type copy_scope = function
@@ -1515,33 +1523,31 @@ let unify_var' = (* Forward declaration *)
 
 let subst env level priv abbrev oty params args body =
   if List.length params <> List.length args then raise Cannot_subst;
-  let old_level = !current_level in
-  current_level := level;
-  let body0 = newvar () in          (* Stub *)
-  let undo_abbrev =
-    match oty with
-    | None -> fun () -> () (* No abbreviation added *)
-    | Some ty ->
-        match get_desc ty with
-          Tconstr (path, tl, _) ->
-            let abbrev = proper_abbrevs tl abbrev in
-            memorize_abbrev abbrev priv path ty body0;
-            fun () -> forget_abbrev abbrev path
-        | _ -> assert false
-  in
-  abbreviations := abbrev;
-  let (params', body') = instance_parameterized_type params body in
-  abbreviations := ref Mnil;
-  let uenv = Expression {env; in_subst = true} in
-  try
-    !unify_var' uenv body0 body';
-    List.iter2 (!unify_var' uenv) params' args;
-    current_level := old_level;
-    body'
-  with Unify _ ->
-    current_level := old_level;
-    undo_abbrev ();
-    raise Cannot_subst
+  with_level ~level begin fun () ->
+    let body0 = newvar () in          (* Stub *)
+    let undo_abbrev =
+      match oty with
+      | None -> fun () -> () (* No abbreviation added *)
+      | Some ty ->
+          match get_desc ty with
+            Tconstr (path, tl, _) ->
+              let abbrev = proper_abbrevs tl abbrev in
+              memorize_abbrev abbrev priv path ty body0;
+              fun () -> forget_abbrev abbrev path
+          | _ -> assert false
+    in
+    abbreviations := abbrev;
+    let (params', body') = instance_parameterized_type params body in
+    abbreviations := ref Mnil;
+    let uenv = Expression {env; in_subst = true} in
+    try
+      !unify_var' uenv body0 body';
+      List.iter2 (!unify_var' uenv) params' args;
+      body'
+    with Unify _ ->
+      undo_abbrev ();
+      raise Cannot_subst
+  end
 
 (*
    Default to generic level. Usually, only the shape of the type matters, not
@@ -1573,6 +1579,7 @@ let check_abbrev_env env =
   if not (Env.same_type_declarations env !previous_env) then begin
     (* prerr_endline "cleanup expansion cache"; *)
     cleanup_abbrev ();
+    simple_abbrevs := Mnil;
     previous_env := env
   end
 
@@ -1782,8 +1789,8 @@ let full_expand ~may_forget_scope env ty =
         (* #10277: forget scopes when printing trace *)
         with_level ~level:(get_level ty) begin fun () ->
           (* The same as [expand_head], except in the failing case we return the
-           *original* type, not [correct_levels ty].*)
-          try try_expand_head try_expand_safe env (correct_levels ty) with
+           *original* type, not [duplicate_type ty].*)
+          try try_expand_head try_expand_safe env (duplicate_type ty) with
           | Cannot_expand -> ty
         end
     else expand_head env ty
@@ -1935,6 +1942,17 @@ let local_non_recursive_abbrev uenv p ty =
                    (*  Polymorphic Unification  *)
                    (*****************************)
 
+(* Polymorphic unification is hard in the presence of recursive types.  A
+   correctness argument for the approach below can be made by reference to
+   "Numbering matters: first-order canonical forms for second-order recursive
+   types" (ICFP'04) by Gauthier & Pottier. That work describes putting numbers
+   on nodes; we do not do that here, but instead make a decision about whether
+   to abort or continue based on the comparison of the numbers if we calculated
+   them. A different approach would actually store the relevant numbers in the
+   [Tpoly] nodes. (The algorithm here actually pre-dates that paper, which was
+   developed independently. But reading and understanding the paper will help
+   guide intuition for reading this algorithm nonetheless.) *)
+
 (* Since we cannot duplicate universal variables, unification must
    be done at meta-level, using bindings in univar_pairs *)
 let rec unify_univar t1 t2 = function
@@ -1954,23 +1972,32 @@ let rec unify_univar t1 t2 = function
       | _ ->
           raise Cannot_unify_universal_variables
       end
-  | [] -> raise Cannot_unify_universal_variables
+  | [] ->
+      raise Out_of_scope_universal_variable
 
 (* The same as [unify_univar], but raises the appropriate exception instead of
    [Cannot_unify_universal_variables] *)
-let unify_univar_for tr_exn t1 t2 univar_pairs =
-  try unify_univar t1 t2 univar_pairs
-  with Cannot_unify_universal_variables -> raise_unexplained_for tr_exn
+let unify_univar_for (type a) (tr_exn : a trace_exn) t1 t2 univar_pairs =
+  try unify_univar t1 t2 univar_pairs with
+  | Cannot_unify_universal_variables -> raise_unexplained_for tr_exn
+  | Out_of_scope_universal_variable ->
+      (* Allow unscoped univars when checking for equality, since one
+         might want to compare arbitrary subparts of types, ignoring scopes;
+         see Typedecl_variance (#13514) for instance *)
+      match tr_exn with
+      | Equality -> raise_unexplained_for tr_exn
+      | _ -> fatal_error "Ctype.unify_univar_for: univar not in scope"
 
 (* Test the occurrence of free univars in a type *)
 (* That's way too expensive. Must do some kind of caching *)
 (* If [inj_only=true], only check injective positions *)
 let occur_univar ?(inj_only=false) env ty =
   let visited = ref TypeMap.empty in
+  with_type_mark begin fun mark ->
   let rec occur_rec bound ty =
-    if not_marked_node ty then
+    if not_marked_node mark ty then
       if TypeSet.is_empty bound then
-        (flip_mark_node ty; occur_desc bound ty)
+        (ignore (try_mark_node mark ty); occur_desc bound ty)
       else try
         let bound' = TypeMap.find ty !visited in
         if not (TypeSet.subset bound' bound) then begin
@@ -2009,10 +2036,8 @@ let occur_univar ?(inj_only=false) env ty =
           end
       | _ -> iter_type_expr (occur_rec bound) ty
   in
-  Misc.try_finally (fun () ->
-      occur_rec TypeSet.empty ty
-    )
-    ~always:(fun () -> unmark_type ty)
+  occur_rec TypeSet.empty ty
+  end
 
 let has_free_univars env ty =
   try occur_univar ~inj_only:false env ty; false with Escape _ -> true
@@ -2043,10 +2068,9 @@ let get_univar_family univar_pairs univars =
 (* Whether a family of univars escapes from a type *)
 let univars_escape env univar_pairs vl ty =
   let family = get_univar_family univar_pairs vl in
-  let visited = ref TypeSet.empty in
+  with_type_mark begin fun mark ->
   let rec occur t =
-    if TypeSet.mem t !visited then () else begin
-      visited := TypeSet.add t !visited;
+    if try_mark_node mark t then begin
       match get_desc t with
         Tpoly (t, tl) ->
           if List.exists (fun t -> TypeSet.mem t family) tl then ()
@@ -2068,9 +2092,18 @@ let univars_escape env univar_pairs vl ty =
     end
   in
   occur ty
+  end
+
+let univar_pairs = ref []
+
+let with_univar_pairs pairs f =
+  let old = !univar_pairs in
+  univar_pairs := pairs;
+  Misc.try_finally f
+    ~always:(fun () -> univar_pairs := old)
 
 (* Wrapper checking that no variable escapes and updating univar_pairs *)
-let enter_poly env univar_pairs t1 tl1 t2 tl2 f =
+let enter_poly env t1 tl1 t2 tl2 f =
   let old_univars = !univar_pairs in
   let known_univars =
     List.fold_left (fun s (cl,_) -> add_univars s cl)
@@ -2082,17 +2115,15 @@ let enter_poly env univar_pairs t1 tl1 t2 tl2 f =
     univars_escape env old_univars tl2 (newty(Tpoly(t1,tl1)));
   let cl1 = List.map (fun t -> t, ref None) tl1
   and cl2 = List.map (fun t -> t, ref None) tl2 in
-  univar_pairs := (cl1,cl2) :: (cl2,cl1) :: old_univars;
-  Misc.try_finally (fun () -> f t1 t2)
-    ~always:(fun () -> univar_pairs := old_univars)
+  with_univar_pairs
+    ((cl1,cl2) :: (cl2,cl1) :: old_univars)
+    (fun () -> f t1 t2)
 
-let enter_poly_for tr_exn env univar_pairs t1 tl1 t2 tl2 f =
+let enter_poly_for tr_exn env t1 tl1 t2 tl2 f =
   try
-    enter_poly env univar_pairs t1 tl1 t2 tl2 f
+    enter_poly env t1 tl1 t2 tl2 f
   with Escape e -> raise_for tr_exn (Escape e)
 
-let univar_pairs = ref []
-
 (**** Instantiate a generic type into a poly type ***)
 
 let polyfy env ty vars =
@@ -2179,16 +2210,18 @@ let unexpanded_diff ~got ~expected =
 
 (* Return whether [t0] occurs in [ty]. Objects are also traversed. *)
 let deep_occur t0 ty =
+  with_type_mark begin fun mark ->
   let rec occur_rec ty =
-    if get_level ty >= get_level t0 && try_mark_node ty then begin
+    if get_level ty >= get_level t0 && try_mark_node mark ty then begin
       if eq_type ty t0 then raise Occur;
       iter_type_expr occur_rec ty
     end
   in
   try
-    occur_rec ty; unmark_type ty; false
+    occur_rec ty; false
   with Occur ->
-    unmark_type ty; true
+    true
+  end
 
 
 (* A local constraint can be added only if the rhs
@@ -2273,6 +2306,21 @@ let compatible_paths p1 p2 =
   Path.same p1 path_bytes && Path.same p2 path_string ||
   Path.same p1 path_string && Path.same p2 path_bytes
 
+(* Two labels are considered compatible under certain conditions.
+  - they are the same
+  - in classic mode, only optional labels are relavant
+  - in pattern mode, we act as if we were in classic mode. If not, interactions
+    with GADTs from files compiled in classic mode would be unsound.
+*)
+let compatible_labels ~in_pattern_mode l1 l2 =
+  l1 = l2
+  || (!Clflags.classic || in_pattern_mode)
+      && not (is_optional l1 || is_optional l2)
+
+let eq_labels error_mode ~in_pattern_mode l1 l2 =
+  if not (compatible_labels ~in_pattern_mode l1 l2) then
+    raise_for error_mode (Function_label_mismatch {got=l1; expected=l2})
+
 (* Check for datatypes carefully; see PR#6348 *)
 let rec expands_to_datatype env ty =
   match get_desc ty with
@@ -2284,12 +2332,21 @@ let rec expands_to_datatype env ty =
       end
   | _ -> false
 
-(* [mcomp] tests if two types are "compatible" -- i.e., if they could ever
-   unify.  (This is distinct from [eqtype], which checks if two types *are*
-   exactly the same.)  This is used to decide whether GADT cases are
-   unreachable.  It is broadly part of unification. *)
+(* [mcomp] tests if two types are "compatible" -- i.e., if there could
+   exist a witness of their equality. This is distinct from [eqtype],
+   which checks if two types *are*  exactly the same.
+   [mcomp] is used to decide whether GADT cases are unreachable.
+   The existence of a witness is necessarily an incomplete property,
+   i.e. there exists types for which we cannot tell if an equality
+   witness could exist or not. Typically, this is the case for
+   abstract types, which could be equal to anything, depending on
+   their actual definition. As a result [mcomp] overapproximates
+   compatibilty, i.e. when it says that two types are incompatible, we
+   are sure that there exists no equality witness, but if it does not
+   say so, there is no guarantee that such a witness could exist.
+ *)
 
-(* mcomp type_pairs subst env t1 t2 does not raise an
+(* [mcomp type_pairs subst env t1 t2] should not raise an
    exception if it is possible that t1 and t2 are actually
    equal, assuming the types in type_pairs are equal and
    that the mapping subst holds.
@@ -2317,7 +2374,7 @@ let rec mcomp type_pairs env t1 t2 =
         | (_, Tvar _)  ->
             ()
         | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _))
-          when l1 = l2 || not (is_optional l1 || is_optional l2) ->
+          when compatible_labels ~in_pattern_mode:true l1 l2 ->
             mcomp type_pairs env t1 t2;
             mcomp type_pairs env u1 u2;
         | (Ttuple tl1, Ttuple tl2) ->
@@ -2352,12 +2409,14 @@ let rec mcomp type_pairs env t1 t2 =
             mcomp type_pairs env t1 t2
         | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
             (try
-               enter_poly env univar_pairs
+               enter_poly env
                  t1 tl1 t2 tl2 (mcomp type_pairs env)
              with Escape _ -> raise Incompatible)
         | (Tunivar _, Tunivar _) ->
-            (try unify_univar t1' t2' !univar_pairs
-             with Cannot_unify_universal_variables -> raise Incompatible)
+            begin try unify_univar t1' t2' !univar_pairs with
+            | Cannot_unify_universal_variables -> raise Incompatible
+            | Out_of_scope_universal_variable -> ()
+            end
         | (_, _) ->
             raise Incompatible
       end
@@ -2499,14 +2558,16 @@ let mcomp_for tr_exn env t1 t2 =
 
 let find_lowest_level ty =
   let lowest = ref generic_level in
-  let rec find ty =
-    if not_marked_node ty then begin
-      let level = get_level ty in
-      if level < !lowest then lowest := level;
-      flip_mark_node ty;
-      iter_type_expr find ty
-    end
-  in find ty; unmark_type ty; !lowest
+  with_type_mark begin fun mark ->
+    let rec find ty =
+      if try_mark_node mark ty then begin
+        let level = get_level ty in
+        if level < !lowest then lowest := level;
+        iter_type_expr find ty
+      end
+    in find ty
+  end;
+  !lowest
 
 (* This function can be called only in [Pattern] mode. *)
 let add_gadt_equation uenv source destination =
@@ -2553,11 +2614,7 @@ let rec concat_longident lid1 =
 let nondep_instance env level id ty =
   let ty = !nondep_type' env [id] ty in
   if level = generic_level then duplicate_type ty else
-  let old = !current_level in
-  current_level := level;
-  let ty = instance ty in
-  current_level := old;
-  ty
+  with_level ~level (fun () -> instance ty)
 
 (* Find the type paths nl1 in the module type mty2, and add them to the
    list (nl2, tl2). raise Not_found if impossible *)
@@ -2609,10 +2666,10 @@ let unify_package env unify_list lv1 p1 fl1 lv2 p2 fl2 =
   let ntl2 = complete_type_list env fl1 lv2 (Mty_ident p2) fl2
   and ntl1 = complete_type_list env fl2 lv1 (Mty_ident p1) fl1 in
   unify_list (List.map snd ntl1) (List.map snd ntl2);
-  if eq_package_path env p1 p2
-  || !package_subtype env p1 fl1 p2 fl2
-  && !package_subtype env p2 fl2 p1 fl1 then () else raise Not_found
-
+  if eq_package_path env p1 p2 then Ok ()
+  else Result.bind
+      (!package_subtype env p1 fl1 p2 fl2)
+      (fun () -> !package_subtype env p2 fl2 p1 fl1)
 
 (* force unification in Reither when one side has a non-conjunctive type *)
 (* Code smell: this could also be put in unification_environment.
@@ -2646,10 +2703,8 @@ let unify3_var uenv t1' t2 t2' =
   | exception Unify_trace _ when in_pattern_mode uenv ->
       reify uenv t1';
       reify uenv t2';
-      if can_generate_equations uenv then begin
-        occur_univar ~inj_only:true (get_env uenv) t2';
-        record_equation uenv t1' t2';
-      end
+      occur_univar ~inj_only:true (get_env uenv) t2';
+      record_equation uenv t1' t2'
 
 (*
    1. When unifying two non-abbreviated types, one type is made a link
@@ -2796,9 +2851,8 @@ and unify3 uenv t1 t1' t2 t2' =
     end;
     try
       begin match (d1, d2) with
-        (Tarrow (l1, t1, u1, c1), Tarrow (l2, t2, u2, c2)) when l1 = l2 ||
-        (!Clflags.classic || in_pattern_mode uenv) &&
-        not (is_optional l1 || is_optional l2) ->
+        (Tarrow (l1, t1, u1, c1), Tarrow (l2, t2, u2, c2)) ->
+          eq_labels Unify ~in_pattern_mode:(in_pattern_mode uenv) l1 l2;
           unify uenv t1 t2; unify uenv u1 u2;
           begin match is_commu_ok c1, is_commu_ok c2 with
           | false, true -> set_commu_ok c1
@@ -2809,7 +2863,7 @@ and unify3 uenv t1 t1' t2 t2' =
       | (Ttuple tl1, Ttuple tl2) ->
           unify_list uenv tl1 tl2
       | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 ->
-          if not (can_generate_equations uenv) then
+          if not (in_pattern_mode uenv) then
             unify_list uenv tl1 tl2
           else if can_assume_injective uenv then
             without_assume_injective uenv (fun uenv -> unify_list uenv tl1 tl2)
@@ -2825,21 +2879,16 @@ and unify3 uenv t1 t1' t2 t2' =
             in
             List.iter2
               (fun i (t1, t2) ->
-                if i then unify uenv t1 t2 else
-                without_generating_equations uenv
-                  begin fun uenv ->
-                    let snap = snapshot () in
-                    try unify uenv t1 t2 with Unify_trace _ ->
-                      backtrack snap;
-                      reify uenv t1;
-                      reify uenv t2
-                  end)
+                if i then unify uenv t1 t2 else begin
+                  reify uenv t1;
+                  reify uenv t2
+                end)
               inj (List.combine tl1 tl2)
       | (Tconstr (path,[],_),
          Tconstr (path',[],_))
-        when let env = get_env uenv in
-        is_instantiable env path && is_instantiable env path'
-        && can_generate_equations uenv ->
+        when in_pattern_mode uenv &&
+        let env = get_env uenv in
+        is_instantiable env path && is_instantiable env path' ->
           let source, destination =
             if Path.scope path > Path.scope path'
             then  path , t2'
@@ -2848,24 +2897,20 @@ and unify3 uenv t1 t1' t2 t2' =
           record_equation uenv t1' t2';
           add_gadt_equation uenv source destination
       | (Tconstr (path,[],_), _)
-        when is_instantiable (get_env uenv) path
-        && can_generate_equations uenv ->
+        when in_pattern_mode uenv && is_instantiable (get_env uenv) path ->
           reify uenv t2';
           record_equation uenv t1' t2';
           add_gadt_equation uenv path t2'
       | (_, Tconstr (path,[],_))
-        when is_instantiable (get_env uenv) path
-        && can_generate_equations uenv ->
+        when in_pattern_mode uenv && is_instantiable (get_env uenv) path ->
           reify uenv t1';
           record_equation uenv t1' t2';
           add_gadt_equation uenv path t1'
       | (Tconstr (_,_,_), _) | (_, Tconstr (_,_,_)) when in_pattern_mode uenv ->
           reify uenv t1';
           reify uenv t2';
-          if can_generate_equations uenv then (
-            mcomp_for Unify (get_env uenv) t1' t2';
-            record_equation uenv t1' t2'
-          )
+          mcomp_for Unify (get_env uenv) t1' t2';
+          record_equation uenv t1' t2'
       | (Tobject (fi1, nm1), Tobject (fi2, _)) ->
           unify_fields uenv fi1 fi2;
           (* Type [t2'] may have been instantiated by [unify_fields] *)
@@ -2887,10 +2932,8 @@ and unify3 uenv t1 t1' t2 t2' =
               backtrack snap;
               reify uenv t1';
               reify uenv t2';
-              if can_generate_equations uenv then (
-                mcomp_for Unify (get_env uenv) t1' t2';
-                record_equation uenv t1' t2'
-              )
+              mcomp_for Unify (get_env uenv) t1' t2';
+              record_equation uenv t1' t2'
           end
       | (Tfield(f,kind,_,rem), Tnil) | (Tnil, Tfield(f,kind,_,rem)) ->
           begin match field_kind_repr kind with
@@ -2911,13 +2954,19 @@ and unify3 uenv t1 t1' t2 t2' =
       | (Tpoly (t1, []), Tpoly (t2, [])) ->
           unify uenv t1 t2
       | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
-          enter_poly_for Unify (get_env uenv) univar_pairs t1 tl1 t2 tl2
+          enter_poly_for Unify (get_env uenv) t1 tl1 t2 tl2
             (unify uenv)
       | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
-          begin try
+          begin match
             unify_package (get_env uenv) (unify_list uenv)
               (get_level t1) p1 fl1 (get_level t2) p2 fl2
-          with Not_found ->
+          with
+          | Ok () -> ()
+          | Error fm_err ->
+              if not (in_pattern_mode uenv) then
+                raise_for Unify (Errortrace.First_class_module fm_err);
+              List.iter (fun (_n, ty) -> reify uenv ty) (fl1 @ fl2);
+          | exception Not_found ->
             if not (in_pattern_mode uenv) then raise_unexplained_for Unify;
             List.iter (fun (_n, ty) -> reify uenv ty) (fl1 @ fl2);
             (* if !generate_equations then List.iter2 (mcomp !env) tl1 tl2 *)
@@ -3231,17 +3280,29 @@ let unify uenv ty1 ty2 =
       raise (Unify (expand_to_unification_error (get_env uenv) trace))
 
 let unify_gadt (penv : Pattern_env.t) ty1 ty2 =
-  univar_pairs := [];
   let equated_types = TypePairs.create 0 in
-  let equations_generation = Allowed { equated_types } in
-  let uenv = Pattern
-      { penv;
-        equations_generation;
-        assume_injective = true;
-        unify_eq_set = TypePairs.create 11; }
+  let do_unify_gadt () =
+    let uenv = Pattern
+        { penv;
+          equated_types;
+          assume_injective = true;
+          unify_eq_set = TypePairs.create 11; }
+    in
+    unify uenv ty1 ty2;
+    equated_types
   in
-  unify uenv ty1 ty2;
-  equated_types
+  let no_leak = penv.allow_recursive_equations || closed_type_expr ty2 in
+  if no_leak then with_univar_pairs [] do_unify_gadt else
+  let snap = Btype.snapshot () in
+  try
+    (* If there are free variables, first try normal unification *)
+    let uenv = Expression {env = penv.env; in_subst = false} in
+    with_univar_pairs [] (fun () -> unify uenv ty1 ty2);
+    equated_types
+  with Unify _ ->
+    (* If it fails, retry in pattern mode *)
+    Btype.backtrack snap;
+    with_univar_pairs [] do_unify_gadt
 
 let unify_var uenv t1 t2 =
   if eq_type t1 t2 then () else
@@ -3273,8 +3334,8 @@ let unify_var env ty1 ty2 =
   unify_var (Expression {env; in_subst = false}) ty1 ty2
 
 let unify_pairs env ty1 ty2 pairs =
-  univar_pairs := pairs;
-  unify (Expression {env; in_subst = false}) ty1 ty2
+  with_univar_pairs pairs (fun () ->
+    unify (Expression {env; in_subst = false}) ty1 ty2)
 
 let unify env ty1 ty2 =
   unify_pairs env ty1 ty2 []
@@ -3686,40 +3747,35 @@ let close_class_signature env sign =
   let self = expand_head env sign.csig_self in
   close env (object_fields self)
 
-let generalize_class_signature_spine env sign =
+let generalize_class_signature_spine sign =
   (* Generalize the spine of methods *)
-  let meths = sign.csig_meths in
-  Meths.iter (fun _ (_, _, ty) -> generalize_spine ty) meths;
-  let new_meths =
-    Meths.map
-      (fun (priv, virt, ty) -> (priv, virt, generic_instance ty))
-      meths
-  in
-  (* But keep levels correct on the type of self *)
-  Meths.iter
-    (fun _ (_, _, ty) -> unify_var env (newvar ()) ty)
-    meths;
-  sign.csig_meths <- new_meths
+  sign.csig_meths <-
+    Meths.map (fun (priv, virt, ty) -> priv, virt, copy_spine ty)
+      sign.csig_meths
 
                         (***********************************)
                         (*  Matching between type schemes  *)
                         (***********************************)
 
+(* Level of the subject, should be just below generic_level *)
+let subject_level = generic_level - 1
+
 (*
    Update the level of [ty]. First check that the levels of generic
    variables from the subject are not lowered.
 *)
 let moregen_occur env level ty =
-  let rec occur ty =
-    let lv = get_level ty in
-    if lv <= level then () else
-    if is_Tvar ty && lv >= generic_level - 1 then raise Occur else
-    if try_mark_node ty then iter_type_expr occur ty
-  in
-  begin try
-    occur ty; unmark_type ty
-  with Occur ->
-    unmark_type ty; raise_unexplained_for Moregen
+  with_type_mark begin fun mark ->
+    let rec occur ty =
+      let lv = get_level ty in
+      if lv <= level then () else
+      if is_Tvar ty && lv >= subject_level then raise Occur else
+      if try_mark_node mark ty then iter_type_expr occur ty
+    in
+    try
+      occur ty
+    with Occur ->
+      raise_unexplained_for Moregen
   end;
   (* also check for free univars *)
   occur_univar_for Moregen env ty;
@@ -3727,7 +3783,7 @@ let moregen_occur env level ty =
 
 let may_instantiate inst_nongen t1 =
   let level = get_level t1 in
-  if inst_nongen then level <> generic_level - 1
+  if inst_nongen then level <> subject_level
                  else level =  generic_level
 
 let rec moregen inst_nongen type_pairs env t1 t2 =
@@ -3754,8 +3810,8 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
               moregen_occur env (get_level t1') t2;
               update_scope_for Moregen (get_scope t1') t2;
               link_type t1' t2
-          | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
-            || !Clflags.classic && not (is_optional l1 || is_optional l2) ->
+          | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) ->
+              eq_labels Moregen ~in_pattern_mode:false l1 l2;
               moregen inst_nongen type_pairs env t1 t2;
               moregen inst_nongen type_pairs env u1 u2
           | (Ttuple tl1, Ttuple tl2) ->
@@ -3764,10 +3820,13 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
                 when Path.same p1 p2 ->
               moregen_list inst_nongen type_pairs env tl1 tl2
           | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
-              begin try
+              begin match
                 unify_package env (moregen_list inst_nongen type_pairs env)
                   (get_level t1') p1 fl1 (get_level t2') p2 fl2
-              with Not_found -> raise_unexplained_for Moregen
+              with
+              | Ok () -> ()
+              | Error fme -> raise_for Moregen (First_class_module fme)
+              | exception Not_found -> raise_unexplained_for Moregen
               end
           | (Tnil,  Tconstr _ ) -> raise_for Moregen (Obj (Abstract_row Second))
           | (Tconstr _,  Tnil ) -> raise_for Moregen (Obj (Abstract_row First))
@@ -3783,7 +3842,7 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
           | (Tpoly (t1, []), Tpoly (t2, [])) ->
               moregen inst_nongen type_pairs env t1 t2
           | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
-              enter_poly_for Moregen env univar_pairs t1 tl1 t2 tl2
+              enter_poly_for Moregen env t1 tl1 t2 tl2
                 (moregen inst_nongen type_pairs env)
           | (Tunivar _, Tunivar _) ->
               unify_univar_for Moregen t1' t2' !univar_pairs
@@ -3946,8 +4005,8 @@ and moregen_row inst_nongen type_pairs env row1 row2 =
 
 (* Must empty univar_pairs first *)
 let moregen inst_nongen type_pairs env patt subj =
-  univar_pairs := [];
-  moregen inst_nongen type_pairs env patt subj
+  with_univar_pairs [] (fun () ->
+    moregen inst_nongen type_pairs env patt subj)
 
 (*
    Non-generic variable can be instantiated only if [inst_nongen] is
@@ -3958,37 +4017,37 @@ let moregen inst_nongen type_pairs env patt subj =
    is unimportant.  So, no need to propagate abbreviations.
 *)
 let moregeneral env inst_nongen pat_sch subj_sch =
-  let old_level = !current_level in
-  current_level := generic_level - 1;
-  (*
-     Generic variables are first duplicated with [instance].  So,
-     their levels are lowered to [generic_level - 1].  The subject is
-     then copied with [duplicate_type].  That way, its levels won't be
-     changed.
-  *)
-  let subj_inst = instance subj_sch in
-  let subj = duplicate_type subj_inst in
-  current_level := generic_level;
-  (* Duplicate generic variables *)
-  let patt = instance pat_sch in
-
-  Misc.try_finally
-    (fun () ->
-       try
-         moregen inst_nongen (TypePairs.create 13) env patt subj
-       with Moregen_trace trace ->
-         (* Moregen splits the generic level into two finer levels:
-            [generic_level] and [generic_level - 1].  In order to properly
-            detect and print weak variables when printing this error, we need to
-            merge them back together, by regeneralizing the levels of the types
-            after they were instantiated at [generic_level - 1] above.  Because
-            [moregen] does some unification that we need to preserve for more
-            legible error messages, we have to manually perform the
-            regeneralization rather than backtracking. *)
-         current_level := generic_level - 2;
-         generalize subj_inst;
-         raise (Moregen (expand_to_moregen_error env trace)))
-    ~always:(fun () -> current_level := old_level)
+  (* Moregen splits the generic level into two finer levels:
+     [generic_level] and [subject_level = generic_level - 1].
+     In order to properly detect and print weak variables when
+     printing errors, we need to merge those levels back together.
+     We do that by starting at level [subject_level - 1], using
+     [with_local_level_generalize] to first set the current level
+     to [subject_level], and then generalize nodes at [subject_level]
+     on exit.
+     Strictly speaking, we could avoid generalizing when there is no error,
+     as nodes at level [subject_level] are never unified with nodes of
+     the original types, but that would be rather ad hoc.
+ *)
+  with_level ~level:(subject_level - 1) begin fun () ->
+    match with_local_level_generalize begin fun () ->
+      assert (!current_level = subject_level);
+      (*
+        Generic variables are first duplicated with [instance].  So,
+        their levels are lowered to [subject_level].  The subject is
+        then copied with [duplicate_type].  That way, its levels won't be
+        changed.
+       *)
+      let subj_inst = instance subj_sch in
+      let subj = duplicate_type subj_inst in
+      (* Duplicate generic variables *)
+      let patt = generic_instance pat_sch in
+      try Ok (moregen inst_nongen (TypePairs.create 13) env patt subj)
+      with Moregen_trace trace -> Error trace
+    end with
+    | Ok () -> ()
+    | Error trace -> raise (Moregen (expand_to_moregen_error env trace))
+  end
 
 let is_moregeneral env inst_nongen pat_sch subj_sch =
   match moregeneral env inst_nongen pat_sch subj_sch with
@@ -3999,8 +4058,8 @@ let is_moregeneral env inst_nongen pat_sch subj_sch =
    and check validity after unification *)
 (* Simpler, no? *)
 
-let rec rigidify_rec vars ty =
-  if try_mark_node ty then
+let rec rigidify_rec mark vars ty =
+  if try_mark_node mark ty then
     begin match get_desc ty with
     | Tvar _ ->
         if not (TypeSet.mem ty !vars) then vars := TypeSet.add ty !vars
@@ -4013,18 +4072,17 @@ let rec rigidify_rec vars ty =
               ~name ~closed
           in link_type more (newty2 ~level:(get_level ty) (Tvariant row'))
         end;
-        iter_row (rigidify_rec vars) row;
+        iter_row (rigidify_rec mark vars) row;
         (* only consider the row variable if the variant is not static *)
         if not (static_row row) then
-          rigidify_rec vars (row_more row)
+          rigidify_rec mark vars (row_more row)
     | _ ->
-        iter_type_expr (rigidify_rec vars) ty
+        iter_type_expr (rigidify_rec mark vars) ty
     end
 
 let rigidify ty =
   let vars = ref TypeSet.empty in
-  rigidify_rec vars ty;
-  unmark_type ty;
+  with_type_mark (fun mark -> rigidify_rec mark vars ty);
   TypeSet.elements !vars
 
 let all_distinct_vars env vars =
@@ -4086,8 +4144,18 @@ let eqtype_subst type_pairs subst t1 t2 =
   end
 
 let rec eqtype rename type_pairs subst env t1 t2 =
-  if eq_type t1 t2 then () else
+  let check_phys_eq t1 t2 =
+    not rename && eq_type t1 t2
+  in
+  (* Checking for physical equality of type representatives when [rename] is
+     true would be incorrect: imagine comparing ['a * 'a] with ['b * 'a]. The
+     first ['a] and ['b] would be identified in [eqtype_subst], and then the
+     second ['a] and ['a] would be [eq_type]. So we do not call [eq_type] here.
 
+     On the other hand, when [rename] is false we need to check for physical
+     equality, as that's the only way variables can be identified.
+  *)
+  if check_phys_eq t1 t2 then () else
   try
     match (get_desc t1, get_desc t2) with
       (Tvar _, Tvar _) when rename ->
@@ -4098,26 +4166,29 @@ let rec eqtype rename type_pairs subst env t1 t2 =
         let t1' = expand_head_rigid env t1 in
         let t2' = expand_head_rigid env t2 in
         (* Expansion may have changed the representative of the types... *)
-        if eq_type t1' t2' then () else
+        if check_phys_eq t1' t2' then () else
         if not (TypePairs.mem type_pairs (t1', t2')) then begin
           TypePairs.add type_pairs (t1', t2');
           match (get_desc t1', get_desc t2') with
             (Tvar _, Tvar _) when rename ->
               eqtype_subst type_pairs subst t1' t2'
-          | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
-            || !Clflags.classic && not (is_optional l1 || is_optional l2) ->
+          | (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) ->
+              eq_labels Equality ~in_pattern_mode:false l1 l2;
               eqtype rename type_pairs subst env t1 t2;
-              eqtype rename type_pairs subst env u1 u2;
+              eqtype rename type_pairs subst env u1 u2
           | (Ttuple tl1, Ttuple tl2) ->
               eqtype_list rename type_pairs subst env tl1 tl2
           | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
                 when Path.same p1 p2 ->
-              eqtype_list rename type_pairs subst env tl1 tl2
+              eqtype_list_same_length rename type_pairs subst env tl1 tl2
           | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
-              begin try
+              begin match
                 unify_package env (eqtype_list rename type_pairs subst env)
                   (get_level t1') p1 fl1 (get_level t2') p2 fl2
-              with Not_found -> raise_unexplained_for Equality
+              with
+              | Ok () -> ()
+              | Error fme -> raise_for Equality (First_class_module fme)
+              | exception Not_found -> raise_unexplained_for Equality
               end
           | (Tnil,  Tconstr _ ) ->
               raise_for Equality (Obj (Abstract_row Second))
@@ -4135,7 +4206,7 @@ let rec eqtype rename type_pairs subst env t1 t2 =
           | (Tpoly (t1, []), Tpoly (t2, [])) ->
               eqtype rename type_pairs subst env t1 t2
           | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
-              enter_poly_for Equality env univar_pairs t1 tl1 t2 tl2
+              enter_poly_for Equality env t1 tl1 t2 tl2
                 (eqtype rename type_pairs subst env)
           | (Tunivar _, Tunivar _) ->
               unify_univar_for Equality t1' t2' !univar_pairs
@@ -4145,17 +4216,22 @@ let rec eqtype rename type_pairs subst env t1 t2 =
   with Equality_trace trace ->
     raise_trace_for Equality (Diff {got = t1; expected = t2} :: trace)
 
+and eqtype_list_same_length rename type_pairs subst env tl1 tl2 =
+  List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
+
 and eqtype_list rename type_pairs subst env tl1 tl2 =
   if List.length tl1 <> List.length tl2 then
     raise_unexplained_for Equality;
-  List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
+  eqtype_list_same_length rename type_pairs subst env tl1 tl2
 
 and eqtype_fields rename type_pairs subst env ty1 ty2 =
   let (fields1, rest1) = flatten_fields ty1 in
   let (fields2, rest2) = flatten_fields ty2 in
   (* First check if same row => already equal *)
   let same_row =
-    eq_type rest1 rest2 || TypePairs.mem type_pairs (rest1,rest2)
+    (* [not rename]: see comment at top of [eqtype] *)
+    (not rename && eq_type rest1 rest2) ||
+    TypePairs.mem type_pairs (rest1,rest2)
   in
   if same_row then () else
   (* Try expansion, needed when called from Includecore.type_manifest *)
@@ -4270,20 +4346,23 @@ and eqtype_row rename type_pairs subst env row1 row2 =
     pairs
 
 (* Must empty univar_pairs first *)
-let eqtype_list rename type_pairs subst env tl1 tl2 =
-  univar_pairs := [];
-  let snap = Btype.snapshot () in
-  Misc.try_finally
-    ~always:(fun () -> backtrack snap)
-    (fun () -> eqtype_list rename type_pairs subst env tl1 tl2)
+let eqtype_list_same_length rename type_pairs subst env tl1 tl2 =
+  with_univar_pairs [] (fun () ->
+    let snap = Btype.snapshot () in
+    Misc.try_finally
+      ~always:(fun () -> backtrack snap)
+      (fun () -> eqtype_list_same_length rename type_pairs subst env tl1 tl2))
 
 let eqtype rename type_pairs subst env t1 t2 =
-  eqtype_list rename type_pairs subst env [t1] [t2]
+  eqtype_list_same_length rename type_pairs subst env [t1] [t2]
 
 (* Two modes: with or without renaming of variables *)
 let equal env rename tyl1 tyl2 =
+  if List.length tyl1 <> List.length tyl2 then
+    raise_unexplained_for Equality;
+  if List.for_all2 eq_type tyl1 tyl2 then () else
   let subst = ref [] in
-  try eqtype_list rename (TypePairs.create 11) subst env tyl1 tyl2
+  try eqtype_list_same_length rename (TypePairs.create 11) subst env tyl1 tyl2
   with Equality_trace trace ->
     raise (Equality (expand_to_equality_error env trace !subst))
 
@@ -4447,48 +4526,48 @@ let match_class_types ?(trace=true) env pat_sch subj_sch =
   let errors = match_class_sig_shape ~strict:false sign1 sign2 in
   match errors with
   | [] ->
-      let old_level = !current_level in
-      current_level := generic_level - 1;
-      (*
-         Generic variables are first duplicated with [instance].  So,
-         their levels are lowered to [generic_level - 1].  The subject is
-         then copied with [duplicate_type].  That way, its levels won't be
-         changed.
-      *)
-      let (_, subj_inst) = instance_class [] subj_sch in
-      let subj = duplicate_class_type subj_inst in
-      current_level := generic_level;
-      (* Duplicate generic variables *)
-      let (_, patt) = instance_class [] pat_sch in
-      let type_pairs = TypePairs.create 53 in
-      let sign1 = signature_of_class_type patt in
-      let sign2 = signature_of_class_type subj in
-      let self1 = sign1.csig_self in
-      let self2 = sign2.csig_self in
-      let row1 = sign1.csig_self_row in
-      let row2 = sign2.csig_self_row in
-      TypePairs.add type_pairs (self1, self2);
-      (* Always succeeds *)
-      moregen true type_pairs env row1 row2;
-      let res =
-        match moregen_clty trace type_pairs env patt subj with
-        | () -> []
-        | exception Failure res ->
-          (* We've found an error.  Moregen splits the generic level into two
-             finer levels: [generic_level] and [generic_level - 1].  In order
-             to properly detect and print weak variables when printing this
-             error, we need to merge them back together, by regeneralizing the
-             levels of the types after they were instantiated at
-             [generic_level - 1] above.  Because [moregen] does some
-             unification that we need to preserve for more legible error
-             messages, we have to manually perform the regeneralization rather
-             than backtracking. *)
-          current_level := generic_level - 2;
-          generalize_class_type subj_inst;
-          res
-      in
-      current_level := old_level;
-      res
+      (* Moregen splits the generic level into two finer levels:
+         [generic_level] and [subject_level = generic_level - 1].
+         In order to properly detect and print weak variables when
+         printing errors, we need to merge those levels back together.
+         We do that by starting at level [subject_level - 1], using
+         [with_local_level_generalize] to first set the current level
+         to [subject_level], and then generalize nodes at [subject_level]
+         on exit.
+         Strictly speaking, we could avoid generalizing when there is no error,
+         as nodes at level [subject_level] are never unified with nodes of
+         the original types, but that would be rather ad hoc.
+       *)
+      with_level ~level:(subject_level - 1) begin fun () ->
+        with_local_level_generalize begin fun () ->
+          assert (!current_level = subject_level);
+          (*
+            Generic variables are first duplicated with [instance].  So,
+            their levels are lowered to [subject_level].  The subject is
+            then copied with [duplicate_type].  That way, its levels won't be
+            changed.
+           *)
+          let (_, subj_inst) = instance_class [] subj_sch in
+          let subj = duplicate_class_type subj_inst in
+          (* Duplicate generic variables *)
+          let (_, patt) =
+            with_level ~level:generic_level
+              (fun () -> instance_class [] pat_sch) in
+          let type_pairs = TypePairs.create 53 in
+          let sign1 = signature_of_class_type patt in
+          let sign2 = signature_of_class_type subj in
+          let self1 = sign1.csig_self in
+          let self2 = sign2.csig_self in
+          let row1 = sign1.csig_self_row in
+          let row2 = sign2.csig_self_row in
+          TypePairs.add type_pairs (self1, self2);
+          (* Always succeeds *)
+          moregen true type_pairs env row1 row2;
+          (* May fail *)
+          try moregen_clty trace type_pairs env patt subj; []
+          with Failure res -> res
+        end
+      end
   | errors ->
       CM_Class_type_mismatch (env, pat_sch, subj_sch) :: errors
 
@@ -4832,8 +4911,8 @@ let rec subtype_rec env trace t1 t2 cstrs =
     match (get_desc t1, get_desc t2) with
       (Tvar _, _) | (_, Tvar _) ->
         (trace, t1, t2, !univar_pairs)::cstrs
-    | (Tarrow(l1, t1, u1, _), Tarrow(l2, t2, u2, _)) when l1 = l2
-      || !Clflags.classic && not (is_optional l1 || is_optional l2) ->
+    | (Tarrow(l1, t1, u1, _), Tarrow(l2, t2, u2, _))
+      when compatible_labels ~in_pattern_mode:false l1 l2 ->
         let cstrs =
           subtype_rec
             env
@@ -4910,7 +4989,7 @@ let rec subtype_rec env trace t1 t2 cstrs =
         subtype_rec env trace u1' u2 cstrs
     | (Tpoly (u1, tl1), Tpoly (u2,tl2)) ->
         begin try
-          enter_poly env univar_pairs u1 tl1 u2 tl2
+          enter_poly env u1 tl1 u2 tl2
             (fun t1 t2 -> subtype_rec env trace t1 t2 cstrs)
         with Escape _ ->
           (trace, t1, t2, !univar_pairs)::cstrs
@@ -4932,7 +5011,7 @@ let rec subtype_rec env trace t1 t2 cstrs =
             (* need to check module subtyping *)
             let snap = Btype.snapshot () in
             match List.iter (fun (_, t1, t2, _) -> unify env t1 t2) cstrs' with
-            | () when !package_subtype env p1 fl1 p2 fl2 ->
+            | () when Result.is_ok (!package_subtype env p1 fl1 p2 fl2) ->
               Btype.backtrack snap; cstrs' @ cstrs
             | () | exception Unify _ ->
               Btype.backtrack snap; raise Not_found
@@ -5056,19 +5135,22 @@ and subtype_row env trace row1 row2 cstrs =
 
 let subtype env ty1 ty2 =
   TypePairs.clear subtypes;
-  univar_pairs := [];
-  (* Build constraint set. *)
-  let cstrs =
-    subtype_rec env [Subtype.Diff {got = ty1; expected = ty2}] ty1 ty2 []
-  in
-  TypePairs.clear subtypes;
-  (* Enforce constraints. *)
-  function () ->
-    List.iter
-      (function (trace0, t1, t2, pairs) ->
-         try unify_pairs env t1 t2 pairs with Unify {trace} ->
-           subtype_error ~env ~trace:trace0 ~unification_trace:(List.tl trace))
-      (List.rev cstrs)
+  with_univar_pairs [] (fun () ->
+    (* Build constraint set. *)
+    let cstrs =
+      subtype_rec env [Subtype.Diff {got = ty1; expected = ty2}] ty1 ty2 []
+    in
+    TypePairs.clear subtypes;
+    (* Enforce constraints. *)
+    function () ->
+      List.iter
+        (function (trace0, t1, t2, pairs) ->
+           try unify_pairs env t1 t2 pairs with Unify {trace} ->
+           subtype_error
+             ~env
+             ~trace:trace0
+             ~unification_trace:(List.tl trace))
+        (List.rev cstrs))
 
                               (*******************)
                               (*  Miscellaneous  *)
@@ -5217,9 +5299,8 @@ let nongen_vars_in_class_declaration cty =
 
 (* Normalize a type before printing, saving... *)
 (* Cannot use mark_type because deep_occur uses it too *)
-let rec normalize_type_rec visited ty =
-  if not (TypeSet.mem ty !visited) then begin
-    visited := TypeSet.add ty !visited;
+let rec normalize_type_rec mark ty =
+  if try_mark_node mark ty then begin
     let tm = row_of_type ty in
     begin if not (is_Tconstr ty) && is_constr_row ~allow_ident:false tm then
       match get_desc tm with (* PR#7348 *)
@@ -5278,11 +5359,11 @@ let rec normalize_type_rec visited ty =
         set_type_desc fi (get_desc fi')
     | _ -> ()
     end;
-    iter_type_expr (normalize_type_rec visited) ty;
+    iter_type_expr (normalize_type_rec mark) ty;
   end
 
 let normalize_type ty =
-  normalize_type_rec (ref TypeSet.empty) ty
+  with_type_mark (fun mark -> normalize_type_rec mark ty)
 
 
                               (*************************)

diff --git a/typing/ctype.mli b/typing/ctype.mli
index 78d991facfc918c982d18d02727cfc1a12c92114..169969321ad4ba46429c1f983774262b0b4bc369 100644 (file)
--- a/typing/ctype.mli
+++ b/typing/ctype.mli
@@ -35,6 +35,15 @@ exception Incompatible
 
 (* All the following wrapper functions revert to the original level,
    even in case of exception. *)
+val with_local_level_generalize:
+    ?before_generalize:('a -> unit) -> (unit -> 'a) -> 'a
+val with_local_level_generalize_if:
+        bool -> ?before_generalize:('a -> unit) -> (unit -> 'a) -> 'a
+val with_local_level_generalize_structure: (unit -> 'a) -> 'a
+val with_local_level_generalize_structure_if: bool -> (unit -> 'a) -> 'a
+val with_local_level_generalize_structure_if_principal: (unit -> 'a) -> 'a
+val with_local_level_generalize_for_class: (unit -> 'a) -> 'a
+
 val with_local_level: ?post:('a -> unit) -> (unit -> 'a) -> 'a
         (* [with_local_level (fun () -> cmd) ~post] evaluates [cmd] at a
            raised level.
@@ -129,8 +138,6 @@ val merge_row_fields:
 val filter_row_fields:
         bool -> (label * row_field) list -> (label * row_field) list
 
-val generalize: type_expr -> unit
-        (* Generalize in-place the given type *)
 val lower_contravariant: Env.t -> type_expr -> unit
         (* Lower level of type variables inside contravariant branches;
            to be used before generalize for expansive expressions *)
@@ -138,23 +145,16 @@ val lower_variables_only: Env.t -> int -> type_expr -> unit
         (* Lower all variables to the given level *)
 val enforce_current_level: Env.t -> type_expr -> unit
         (* Lower whole type to !current_level *)
-val generalize_structure: type_expr -> unit
-        (* Generalize the structure of a type, lowering variables
-           to !current_level *)
-val generalize_class_type : class_type -> unit
-        (* Generalize the components of a class type *)
-val generalize_class_type_structure : class_type -> unit
-       (* Generalize the structure of the components of a class type *)
-val generalize_class_signature_spine : Env.t -> class_signature -> unit
+val generalize_class_signature_spine: class_signature -> unit
        (* Special function to generalize methods during inference *)
-val correct_levels: type_expr -> type_expr
-        (* Returns a copy with decreasing levels *)
-val limited_generalize: type_expr -> type_expr -> unit
+val limited_generalize: type_expr -> inside:type_expr -> unit
         (* Only generalize some part of the type
            Make the remaining of the type non-generalizable *)
-val limited_generalize_class_type: type_expr -> class_type -> unit
+val limited_generalize_class_type: type_expr -> inside:class_type -> unit
         (* Same, but for class types *)
 
+val duplicate_type: type_expr -> type_expr
+        (* Returns a copy with non-variable nodes at generic level *)
 val fully_generic: type_expr -> bool
 
 val check_scope_escape : Env.t -> int -> type_expr -> unit
@@ -261,13 +261,19 @@ type typedecl_extraction_result =
 val extract_concrete_typedecl:
         Env.t -> type_expr -> typedecl_extraction_result
 
+val get_new_abstract_name : Env.t -> string -> string
+
 val unify: Env.t -> type_expr -> type_expr -> unit
         (* Unify the two types given. Raise [Unify] if not possible. *)
 val unify_gadt:
         Pattern_env.t -> type_expr -> type_expr -> Btype.TypePairs.t
-        (* Unify the two types given and update the environment with the
-           local constraints. Raise [Unify] if not possible.
-           Returns the pairs of types that have been equated.  *)
+        (* [unify_gadt penv ty1 ty2] unifies [ty1] and [ty2] in
+           [Pattern] mode, possible adding local constraints to the
+           environment in [penv]. Raises [Unify] if not possible.
+           Returns the pairs of types that have been equated.
+           Type variables in [ty1] are assumed to be non-leaking (safely
+           reifiable), moreover if [penv.allow_recursive_equations = true]
+           the same assumption is made for [ty2]. *)
 val unify_var: Env.t -> type_expr -> type_expr -> unit
         (* Same as [unify], but allow free univars when first type
            is a variable. *)
@@ -443,6 +449,7 @@ type closed_class_failure = {
 
 val free_variables: ?env:Env.t -> type_expr -> type_expr list
         (* If env present, then check for incomplete definitions too *)
+val closed_type_expr: ?env:Env.t -> type_expr -> bool
 val closed_type_decl: type_declaration -> type_expr option
 val closed_extension_constructor: extension_constructor -> type_expr option
 val closed_class:
@@ -459,14 +466,15 @@ val collapse_conj_params: Env.t -> type_expr list -> unit
         (* Collapse conjunctive types in class parameters *)
 
 val get_current_level: unit -> int
-val wrap_trace_gadt_instances: Env.t -> ('a -> 'b) -> 'a -> 'b
+val wrap_trace_gadt_instances: ?force:bool -> Env.t -> ('a -> 'b) -> 'a -> 'b
 
 val immediacy : Env.t -> type_expr -> Type_immediacy.t
 
 (* Stubs *)
 val package_subtype :
     (Env.t -> Path.t -> (Longident.t * type_expr) list ->
-      Path.t -> (Longident.t * type_expr) list -> bool) ref
+      Path.t -> (Longident.t * type_expr) list ->
+     (unit,Errortrace.first_class_module) Result.t) ref
 
 (* Raises [Incompatible] *)
 val mcomp : Env.t -> type_expr -> type_expr -> unit

diff --git a/typing/datarepr.ml b/typing/datarepr.ml
index 9213fe833734d793edd412477d66bfd71a4208fe..5228031155ec8e62a853243eccd9f94285d62701 100644 (file)
--- a/typing/datarepr.ml
+++ b/typing/datarepr.ml
@@ -23,24 +23,25 @@ open Btype
 (* Simplified version of Ctype.free_vars *)
 let free_vars ?(param=false) ty =
   let ret = ref TypeSet.empty in
-  let rec loop ty =
-    if try_mark_node ty then
-      match get_desc ty with
-      | Tvar _ ->
-          ret := TypeSet.add ty !ret
-      | Tvariant row ->
-          iter_row loop row;
-          if not (static_row row) then begin
-            match get_desc (row_more row) with
-            | Tvar _ when param -> ret := TypeSet.add ty !ret
-            | _ -> loop (row_more row)
-          end
-      (* XXX: What about Tobject ? *)
-      | _ ->
-          iter_type_expr loop ty
-  in
-  loop ty;
-  unmark_type ty;
+  with_type_mark begin fun mark ->
+    let rec loop ty =
+      if try_mark_node mark ty then
+        match get_desc ty with
+        | Tvar _ ->
+            ret := TypeSet.add ty !ret
+        | Tvariant row ->
+            iter_row loop row;
+            if not (static_row row) then begin
+              match get_desc (row_more row) with
+              | Tvar _ when param -> ret := TypeSet.add ty !ret
+              | _ -> loop (row_more row)
+            end
+                (* XXX: What about Tobject ? *)
+        | _ ->
+            iter_type_expr loop ty
+    in
+    loop ty
+  end;
   !ret
 
 let newgenconstr path tyl = newgenty (Tconstr (path, tyl, ref Mnil))

diff --git a/typing/datarepr.mli b/typing/datarepr.mli
index 38f05f74f08a088c8cba6ec94246f9a57f4226af..1ccb918e591b2b2defcb07f28704124378522ad7 100644 (file)
--- a/typing/datarepr.mli
+++ b/typing/datarepr.mli
@@ -19,14 +19,14 @@
 open Types
 
 val extension_descr:
-  current_unit:string -> Path.t -> extension_constructor ->
+  current_unit:(Unit_info.t option) -> Path.t -> extension_constructor ->
   constructor_description
 
 val labels_of_type:
   Path.t -> type_declaration ->
   (Ident.t * label_description) list
 val constructors_of_type:
-  current_unit:string -> Path.t -> type_declaration ->
+  current_unit:(Unit_info.t option) -> Path.t -> type_declaration ->
   (Ident.t * constructor_description) list
 
 

diff --git a/typing/env.ml b/typing/env.ml
index 5748afd8dc14a539f85c29b74c128139ebe063c2..07f7398ab731df3eb65000fde4495c713b8b04e7 100644 (file)
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -794,48 +794,63 @@ let rec print_address ppf = function
 
 (* The name of the compilation unit currently compiled.
    "" if outside a compilation unit. *)
-module Current_unit_name : sig
-  val get : unit -> modname
-  val set : modname -> unit
-  val is : modname -> bool
-  val is_ident : Ident.t -> bool
-  val is_path : Path.t -> bool
+module Current_unit : sig
+  val get : unit -> Unit_info.t option
+  val set : Unit_info.t -> unit
+  val unset : unit -> unit
+
+  module Name : sig
+    val get : unit -> modname
+    val is : modname -> bool
+    val is_ident : Ident.t -> bool
+    val is_path : Path.t -> bool
+  end
 end = struct
-  let current_unit =
-    ref ""
+  let current_unit : Unit_info.t option ref =
+    ref None
   let get () =
     !current_unit
-  let set name =
-    current_unit := name
-  let is name =
-    !current_unit = name
-  let is_ident id =
-    Ident.persistent id && is (Ident.name id)
-  let is_path = function
-  | Pident id -> is_ident id
-  | Pdot _ | Papply _ | Pextra_ty _ -> false
+  let set cu =
+    current_unit := Some cu
+  let unset () =
+    current_unit := None
+
+  module Name = struct
+    let get () =
+      match !current_unit with
+      | None -> ""
+      | Some cu -> Unit_info.modname cu
+    let is name =
+      get () = name
+    let is_ident id =
+      Ident.persistent id && is (Ident.name id)
+    let is_path = function
+    | Pident id -> is_ident id
+    | Pdot _ | Papply _ | Pextra_ty _ -> false
+  end
 end
 
-let set_unit_name = Current_unit_name.set
-let get_unit_name = Current_unit_name.get
+let set_current_unit = Current_unit.set
+let get_current_unit = Current_unit.get
+let get_current_unit_name = Current_unit.Name.get
 
 let find_same_module id tbl =
   match IdTbl.find_same id tbl with
   | x -> x
   | exception Not_found
-    when Ident.persistent id && not (Current_unit_name.is_ident id) ->
+    when Ident.persistent id && not (Current_unit.Name.is_ident id) ->
       Mod_persistent
 
 let find_name_module ~mark name tbl =
   match IdTbl.find_name wrap_module ~mark name tbl with
   | x -> x
-  | exception Not_found when not (Current_unit_name.is name) ->
+  | exception Not_found when not (Current_unit.Name.is name) ->
       let path = Pident(Ident.create_persistent name) in
       path, Mod_persistent
 
 let add_persistent_structure id env =
   if not (Ident.persistent id) then invalid_arg "Env.add_persistent_structure";
-  if Current_unit_name.is_ident id then env
+  if Current_unit.Name.is_ident id then env
   else begin
     let material =
       (* This addition only observably changes the environment if it shadows a
@@ -962,7 +977,7 @@ let reset_declaration_caches () =
   ()
 
 let reset_cache () =
-  Current_unit_name.set "";
+  Current_unit.unset ();
   Persistent_env.clear !persistent_env;
   reset_declaration_caches ();
   ()
@@ -1287,7 +1302,7 @@ let find_shape env (ns : Shape.Sig_component_kind.t) id =
              properly populated. *)
           assert false
       | exception Not_found
-        when Ident.persistent id && not (Current_unit_name.is_ident id) ->
+        when Ident.persistent id && not (Current_unit.Name.is_ident id) ->
           Shape.for_persistent_unit (Ident.name id)
       end
   | Module_type ->
@@ -1635,7 +1650,7 @@ let prefix_idents root prefixing_sub sg =
       let p = Pdot(root, Ident.name id) in
       prefix_idents root
         ((SigL_modtype(id, mtd, vis), p) :: items_and_paths)
-        (Subst.add_modtype id (Mty_ident p) prefixing_sub)
+        (Subst.add_modtype id p prefixing_sub)
         rem
     | SigL_class(id, cd, rs, vis) :: rem ->
       (* pretend this is a type, cf. PR#6650 *)
@@ -1682,16 +1697,6 @@ let module_declaration_address env id presence md =
   | Mp_present ->
       Lazy_backtrack.create_forced (Aident id)
 
-let is_identchar c =
-  (* This should be kept in sync with the [identchar_latin1] character class
-     in [lexer.mll] *)
-  match c with
-  | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214'
-  | '\216'..'\246' | '\248'..'\255' | '\'' | '0'..'9' ->
-    true
-  | _ ->
-    false
-
 let rec components_of_module_maker
           {cm_env; cm_prefixing_subst;
            cm_path; cm_addr; cm_mty; cm_shape} : _ result =
@@ -1739,7 +1744,7 @@ let rec components_of_module_maker
               | Type_variant (_,repr) ->
                   let cstrs = List.map snd
                     (Datarepr.constructors_of_type path final_decl
-                        ~current_unit:(get_unit_name ()))
+                        ~current_unit:(get_current_unit ()))
                   in
                   List.iter
                     (fun descr ->
@@ -1777,7 +1782,7 @@ let rec components_of_module_maker
         | SigL_typext(id, ext, _, _) ->
             let ext' = Subst.extension_constructor sub ext in
             let descr =
-              Datarepr.extension_descr ~current_unit:(get_unit_name ()) path
+              Datarepr.extension_descr ~current_unit:(get_current_unit ()) path
                 ext'
             in
             let addr = next_address () in
@@ -1897,7 +1902,8 @@ and check_value_name name loc =
   (* Note: we could also check here general validity of the
      identifier, to protect against bad identifiers forged by -pp or
      -ppx preprocessors. *)
-  if String.length name > 0 && not (is_identchar name.[0]) then
+  if String.length name > 0 && not
+       (Utf8_lexeme.starts_like_a_valid_identifier name) then
     for i = 1 to String.length name - 1 do
       if name.[i] = '#' then
         error (Illegal_value_name(loc, name))
@@ -1996,7 +2002,7 @@ and store_type ~check id info shape env =
     match info.type_kind with
     | Type_variant (_,repr) ->
         let constructors = Datarepr.constructors_of_type path info
-                            ~current_unit:(get_unit_name ())
+                            ~current_unit:(get_current_unit ())
         in
         Type_variant (List.map snd constructors, repr),
         List.fold_left
@@ -2043,7 +2049,8 @@ and store_type_infos ~tda_shape id info env =
 and store_extension ~check ~rebind id addr ext shape env =
   let loc = ext.ext_loc in
   let cstr =
-    Datarepr.extension_descr ~current_unit:(get_unit_name ()) (Pident id) ext
+    Datarepr.extension_descr
+      ~current_unit:(get_current_unit ()) (Pident id) ext
   in
   let cda =
     { cda_description = cstr;
@@ -2532,7 +2539,7 @@ let read_signature u =
 let unit_name_of_filename fn =
   match Filename.extension fn with
   | ".cmi" ->
-      let modname = Unit_info.modname_from_source fn in
+      let modname = Unit_info.strict_modname_from_source fn in
       if Unit_info.is_unit_name modname then Some modname
       else None
   | _ -> None
@@ -3283,7 +3290,7 @@ let bound_module name env =
   match IdTbl.find_name wrap_module ~mark:false name env.modules with
   | _ -> true
   | exception Not_found ->
-      if Current_unit_name.is name then false
+      if Current_unit.Name.is name then false
       else begin
         match find_pers_mod ~allow_hidden:false name with
         | _ -> true
@@ -3512,15 +3519,12 @@ let env_of_only_summary env_from_summary env =
 
 (* Error report *)
 
-open Format
+open Format_doc
 
 (* Forward declarations *)
 
-let print_longident =
-  ref ((fun _ _ -> assert false) : formatter -> Longident.t -> unit)
-
-let print_path =
-  ref ((fun _ _ -> assert false) : formatter -> Path.t -> unit)
+let print_path: Path.t printer ref = ref (fun _ _ -> assert false)
+let pp_path ppf l = !print_path ppf l
 
 let spellcheck ppf extract env lid =
   let choices ~path name = Misc.spellcheck (extract path env) name in
@@ -3560,10 +3564,12 @@ let extract_instance_variables env =
 
 module Style = Misc.Style
 
-let report_lookup_error _loc env ppf = function
+let quoted_longident = Style.as_inline_code Pprintast.Doc.longident
+let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
+
+let report_lookup_error_doc _loc env ppf = function
   | Unbound_value(lid, hint) -> begin
-      fprintf ppf "Unbound value %a"
-        (Style.as_inline_code !print_longident) lid;
+      fprintf ppf "Unbound value %a" quoted_longident lid;
       spellcheck ppf extract_values env lid;
       match hint with
       | No_hint -> ()
@@ -3579,52 +3585,52 @@ let report_lookup_error _loc env ppf = function
     end
   | Unbound_type lid ->
       fprintf ppf "Unbound type constructor %a"
-        (Style.as_inline_code !print_longident) lid;
+         quoted_longident lid;
       spellcheck ppf extract_types env lid;
   | Unbound_module lid -> begin
       fprintf ppf "Unbound module %a"
-        (Style.as_inline_code !print_longident) lid;
+        quoted_longident lid;
        match find_modtype_by_name lid env with
       | exception Not_found -> spellcheck ppf extract_modules env lid;
       | _ ->
          fprintf ppf
            "@.@[@{<hint>Hint@}: There is a module type named %a, %s@]"
-           (Style.as_inline_code !print_longident) lid
+           quoted_longident lid
            "but module types are not modules"
     end
   | Unbound_constructor lid ->
       fprintf ppf "Unbound constructor %a"
-        (Style.as_inline_code !print_longident) lid;
+        quoted_constr lid;
       spellcheck ppf extract_constructors env lid;
   | Unbound_label lid ->
       fprintf ppf "Unbound record field %a"
-        (Style.as_inline_code !print_longident) lid;
+        quoted_longident lid;
       spellcheck ppf extract_labels env lid;
   | Unbound_class lid -> begin
       fprintf ppf "Unbound class %a"
-        (Style.as_inline_code !print_longident) lid;
+        quoted_longident lid;
       match find_cltype_by_name lid env with
       | exception Not_found -> spellcheck ppf extract_classes env lid;
       | _ ->
          fprintf ppf
            "@.@[@{<hint>Hint@}: There is a class type named %a, %s@]"
-           (Style.as_inline_code !print_longident) lid
+           quoted_longident lid
            "but classes are not class types"
     end
   | Unbound_modtype lid -> begin
       fprintf ppf "Unbound module type %a"
-        (Style.as_inline_code !print_longident) lid;
+        quoted_longident lid;
       match find_module_by_name lid env with
       | exception Not_found -> spellcheck ppf extract_modtypes env lid;
       | _ ->
          fprintf ppf
            "@.@[@{<hint>Hint@}: There is a module named %a, %s@]"
-           (Style.as_inline_code !print_longident) lid
+           quoted_longident lid
            "but modules are not module types"
     end
   | Unbound_cltype lid ->
       fprintf ppf "Unbound class type %a"
-        (Style.as_inline_code !print_longident) lid;
+       quoted_longident lid;
       spellcheck ppf extract_cltypes env lid;
   | Unbound_instance_variable s ->
       fprintf ppf "Unbound instance variable %a" Style.inline_code s;
@@ -3637,47 +3643,47 @@ let report_lookup_error _loc env ppf = function
       fprintf ppf
         "The instance variable %a@ \
          cannot be accessed from the definition of another instance variable"
-        (Style.as_inline_code !print_longident) lid
+        quoted_longident lid
   | Masked_self_variable lid ->
       fprintf ppf
         "The self variable %a@ \
          cannot be accessed from the definition of an instance variable"
-        (Style.as_inline_code !print_longident) lid
+        quoted_longident lid
   | Masked_ancestor_variable lid ->
       fprintf ppf
         "The ancestor variable %a@ \
          cannot be accessed from the definition of an instance variable"
-       (Style.as_inline_code !print_longident) lid
+       quoted_longident lid
   | Illegal_reference_to_recursive_module ->
      fprintf ppf "Illegal recursive module reference"
   | Structure_used_as_functor lid ->
       fprintf ppf "@[The module %a is a structure, it cannot be applied@]"
-        (Style.as_inline_code !print_longident) lid
+        quoted_longident lid
   | Abstract_used_as_functor lid ->
       fprintf ppf "@[The module %a is abstract, it cannot be applied@]"
-        (Style.as_inline_code !print_longident) lid
+        quoted_longident lid
   | Functor_used_as_structure lid ->
       fprintf ppf "@[The module %a is a functor, \
-                   it cannot have any components@]" !print_longident lid
+                   it cannot have any components@]" quoted_longident lid
   | Abstract_used_as_structure lid ->
       fprintf ppf "@[The module %a is abstract, \
                    it cannot have any components@]"
-        (Style.as_inline_code !print_longident) lid
+        quoted_longident lid
   | Generative_used_as_applicative lid ->
       fprintf ppf "@[The functor %a is generative,@ it@ cannot@ be@ \
                    applied@ in@ type@ expressions@]"
-        (Style.as_inline_code !print_longident) lid
+        quoted_longident lid
   | Cannot_scrape_alias(lid, p) ->
       let cause =
-        if Current_unit_name.is_path p then "is the current compilation unit"
+        if Current_unit.Name.is_path p then "is the current compilation unit"
         else "is missing"
       in
       fprintf ppf
         "The module %a is an alias for module %a, which %s"
-        (Style.as_inline_code !print_longident) lid
-        (Style.as_inline_code !print_path) p cause
+        quoted_longident lid
+        (Style.as_inline_code pp_path) p cause
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Missing_module(_, path1, path2) ->
       fprintf ppf "@[@[<hov>";
       if Path.same path1 path2 then
@@ -3694,7 +3700,7 @@ let report_error ppf = function
   | Illegal_value_name(_loc, name) ->
       fprintf ppf "%a is not a valid value identifier."
        Style.inline_code name
-  | Lookup_error(loc, t, err) -> report_lookup_error loc t ppf err
+  | Lookup_error(loc, t, err) -> report_lookup_error_doc loc t ppf err
 
 let () =
   Location.register_error_of_exn
@@ -3709,9 +3715,12 @@ let () =
           let error_of_printer =
             if loc = Location.none
             then Location.error_of_printer_file
-            else Location.error_of_printer ~loc ?sub:None
+            else Location.error_of_printer ~loc ?sub:None ?footnote:None
           in
-          Some (error_of_printer report_error err)
+          Some (error_of_printer report_error_doc err)
       | _ ->
           None
     )
+
+let report_lookup_error = Format_doc.compat2 report_lookup_error_doc
+let report_error = Format_doc.compat report_error_doc

diff --git a/typing/env.mli b/typing/env.mli
index fa82444a1190d307cc21186e2d1ff13929ffddf1..1ad27a11bfc792f978a4b159536818291c397bbd 100644 (file)
--- a/typing/env.mli
+++ b/typing/env.mli
@@ -394,9 +394,10 @@ val reset_cache: unit -> unit
 (* To be called before each toplevel phrase. *)
 val reset_cache_toplevel: unit -> unit
 
-(* Remember the name of the current compilation unit. *)
-val set_unit_name: string -> unit
-val get_unit_name: unit -> string
+(* Remember the current compilation unit. *)
+val set_current_unit: Unit_info.t -> unit
+val get_current_unit : unit -> Unit_info.t option
+val get_current_unit_name: unit -> string
 
 (* Read, save a signature to/from a file *)
 val read_signature: Unit_info.Artifact.t -> signature
@@ -447,12 +448,14 @@ type error =
 
 exception Error of error
 
-open Format
 
-val report_error: formatter -> error -> unit
-
-val report_lookup_error: Location.t -> t -> formatter -> lookup_error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
 
+val report_lookup_error:
+  Location.t -> t -> lookup_error Format_doc.format_printer
+val report_lookup_error_doc:
+  Location.t -> t -> lookup_error Format_doc.printer
 val in_signature: bool -> t -> t
 
 val is_in_signature: t -> bool
@@ -482,9 +485,7 @@ val strengthen:
 (* Forward declaration to break mutual recursion with Ctype. *)
 val same_constr: (t -> type_expr -> type_expr -> bool) ref
 (* Forward declaration to break mutual recursion with Printtyp. *)
-val print_longident: (Format.formatter -> Longident.t -> unit) ref
-(* Forward declaration to break mutual recursion with Printtyp. *)
-val print_path: (Format.formatter -> Path.t -> unit) ref
+val print_path: Path.t Format_doc.printer ref
 
 
 (** Folds *)

diff --git a/typing/envaux.ml b/typing/envaux.ml
index 90e0da92c42d33d13c639949f20c48901ece53df..df75c5d5b6125ed5228c9f53ac181da1550e7028 100644 (file)
--- a/typing/envaux.ml
+++ b/typing/envaux.ml
@@ -101,17 +101,19 @@ let env_of_only_summary env =
 
 (* Error report *)
 
-open Format
+open Format_doc
 module Style = Misc.Style
 
-let report_error ppf = function
+let report_error_doc ppf = function
   | Module_not_found p ->
       fprintf ppf "@[Cannot find module %a@].@."
-        (Style.as_inline_code Printtyp.path) p
+        (Style.as_inline_code Printtyp.Doc.path) p
 
 let () =
   Location.register_error_of_exn
     (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | Error err -> Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/typing/envaux.mli b/typing/envaux.mli
index 2869890a142661820fa78d584f6a85c4926d5f7d..5fbb8410bd8a89d552b8f733f402e12acd32a8c3 100644 (file)
--- a/typing/envaux.mli
+++ b/typing/envaux.mli
@@ -14,8 +14,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Format
-
 (* Convert environment summaries to environments *)
 
 val env_from_summary : Env.summary -> Subst.t -> Env.t
@@ -33,4 +31,5 @@ type error =
 
 exception Error of error
 
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/typing/errortrace.ml b/typing/errortrace.ml
index ec380329be2aacbfc3ee6fc5e3f3d4b053141512..347e5c9a4f9b3d2d3014b101c638346e9e54115b 100644 (file)
--- a/typing/errortrace.ml
+++ b/typing/errortrace.ml
@@ -16,7 +16,7 @@
 (**************************************************************************)
 
 open Types
-open Format
+open Format_doc
 
 type position = First | Second
 
@@ -98,14 +98,21 @@ type 'variety obj =
   (* Unification *)
   | Self_cannot_be_closed : unification obj
 
+type first_class_module =
+    | Package_cannot_scrape of Path.t
+    | Package_inclusion of Format_doc.doc
+    | Package_coercion of Format_doc.doc
+
 type ('a, 'variety) elt =
   (* Common *)
   | Diff : 'a diff -> ('a, _) elt
   | Variant : 'variety variant -> ('a, 'variety) elt
   | Obj : 'variety obj -> ('a, 'variety) elt
   | Escape : 'a escape -> ('a, _) elt
+  | Function_label_mismatch of Asttypes.arg_label diff
   | Incompatible_fields : { name:string; diff: type_expr diff } -> ('a, _) elt
       (* Could move [Incompatible_fields] into [obj] *)
+  | First_class_module: first_class_module -> ('a,_) elt
   (* Unification & Moregen; included in Equality for simplicity *)
   | Rec_occur : type_expr * type_expr -> ('a, _) elt
 
@@ -120,7 +127,8 @@ let map_elt (type variety) f : ('a, variety) elt -> ('b, variety) elt = function
       Escape { kind = Equation (f x); context }
   | Escape {kind = (Univ _ | Self | Constructor _ | Module_type _ | Constraint);
             _}
-  | Variant _ | Obj _ | Incompatible_fields _ | Rec_occur (_, _) as x -> x
+  | Variant _ | Obj _ | Function_label_mismatch _ | Incompatible_fields _
+  | Rec_occur (_, _) | First_class_module _  as x -> x
 
 let map f t = List.map (map_elt f) t
 

diff --git a/typing/errortrace.mli b/typing/errortrace.mli
index 90148893fe36aea6b14d3735a0f185835b9da8a1..6b42b66a34bac854ed797c82561ed1d1050f2e0f 100644 (file)
--- a/typing/errortrace.mli
+++ b/typing/errortrace.mli
@@ -20,7 +20,7 @@ open Types
 type position = First | Second
 
 val swap_position : position -> position
-val print_pos : Format.formatter -> position -> unit
+val print_pos : position Format_doc.printer
 
 type expanded_type = { ty: type_expr; expanded: type_expr }
 
@@ -84,13 +84,20 @@ type 'variety obj =
   (* Unification *)
   | Self_cannot_be_closed : unification obj
 
+type first_class_module =
+    | Package_cannot_scrape of Path.t
+    | Package_inclusion of Format_doc.doc
+    | Package_coercion of Format_doc.doc
+
 type ('a, 'variety) elt =
   (* Common *)
   | Diff : 'a diff -> ('a, _) elt
   | Variant : 'variety variant -> ('a, 'variety) elt
   | Obj : 'variety obj -> ('a, 'variety) elt
   | Escape : 'a escape -> ('a, _) elt
+  | Function_label_mismatch of Asttypes.arg_label diff
   | Incompatible_fields : { name:string; diff: type_expr diff } -> ('a, _) elt
+  | First_class_module: first_class_module -> ('a,_) elt
   (* Unification & Moregen; included in Equality for simplicity *)
   | Rec_occur : type_expr * type_expr -> ('a, _) elt
 

diff --git a/typing/errortrace_report.ml b/typing/errortrace_report.ml
new file mode 100644 (file)
index 0000000..03012f7
--- /dev/null
+++ b/typing/errortrace_report.ml
@@ -0,0 +1,590 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*  Florian Angeletti, projet Cambium, INRIA Paris                        *)
+(*                                                                        *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Trace-specific printing *)
+
+(* A configuration type that controls which trace we print.  This could be
+   exposed, but we instead expose three separate
+   [{unification,equality,moregen}] functions.  This also lets us
+   give the unification case an extra optional argument without adding it to the
+   equality and moregen cases. *)
+type 'variety trace_format =
+  | Unification : Errortrace.unification trace_format
+  | Equality    : Errortrace.comparison  trace_format
+  | Moregen     : Errortrace.comparison  trace_format
+
+let incompatibility_phrase (type variety) : variety trace_format -> string =
+  function
+  | Unification -> "is not compatible with type"
+  | Equality    -> "is not equal to type"
+  | Moregen     -> "is not compatible with type"
+
+(* Print a unification error *)
+open Out_type
+open Format_doc
+module Fmt = Format_doc
+module Style = Misc.Style
+
+type 'a diff = 'a Out_type.diff = Same of 'a | Diff of 'a * 'a
+
+let trees_of_trace mode =
+  List.map (Errortrace.map_diff (trees_of_type_expansion mode))
+
+let rec trace fst txt ppf = function
+  | {Errortrace.got; expected} :: rem ->
+      if not fst then fprintf ppf "@,";
+      fprintf ppf "@[Type@;<1 2>%a@ %s@;<1 2>%a@]%a"
+       pp_type_expansion got txt pp_type_expansion expected
+       (trace false txt) rem
+  | _ -> ()
+
+type printing_status =
+  | Discard
+  | Keep
+  | Optional_refinement
+  (** An [Optional_refinement] printing status is attributed to trace
+      elements that are focusing on a new subpart of a structural type.
+      Since the whole type should have been printed earlier in the trace,
+      we only print those elements if they are the last printed element
+      of a trace, and there is no explicit explanation for the
+      type error.
+  *)
+
+let diff_printing_status Errortrace.{ got      = {ty = t1; expanded = t1'};
+                                      expected = {ty = t2; expanded = t2'} } =
+  if  Btype.is_constr_row ~allow_ident:true t1'
+   || Btype.is_constr_row ~allow_ident:true t2'
+  then Discard
+  else if same_path t1 t1' && same_path t2 t2' then Optional_refinement
+  else Keep
+
+let printing_status = function
+  | Errortrace.Diff d -> diff_printing_status d
+  | Errortrace.Escape {kind = Constraint} -> Keep
+  | _ -> Keep
+
+(** Flatten the trace and remove elements that are always discarded
+    during printing *)
+
+(* Takes [printing_status] to change behavior for [Subtype] *)
+let prepare_any_trace printing_status tr =
+  let clean_trace x l = match printing_status x with
+    | Keep -> x :: l
+    | Optional_refinement when l = [] -> [x]
+    | Optional_refinement | Discard -> l
+  in
+  match tr with
+  | [] -> []
+  | elt :: rem -> elt :: List.fold_right clean_trace rem []
+
+let prepare_trace f tr =
+  prepare_any_trace printing_status (Errortrace.map f tr)
+
+(** Keep elements that are [Diff _ ] and split the the last element if it is
+    optionally elidable, require a prepared trace *)
+let rec filter_trace = function
+  | [] -> [], None
+  | [Errortrace.Diff d as elt]
+    when printing_status elt = Optional_refinement -> [], Some d
+  | Errortrace.Diff d :: rem ->
+      let filtered, last = filter_trace rem in
+      d :: filtered, last
+  | _ :: rem -> filter_trace rem
+
+let may_prepare_expansion compact (Errortrace.{ty; expanded} as ty_exp) =
+  match Types.get_desc expanded with
+    Tvariant _ | Tobject _ when compact ->
+      Variable_names.reserve ty; Errortrace.{ty; expanded = ty}
+  | _ -> prepare_expansion ty_exp
+
+let print_path p =
+  Fmt.dprintf "%a" !Oprint.out_ident (namespaced_tree_of_path Type p)
+
+let print_tag ppf s = Style.inline_code ppf ("`" ^ s)
+
+let print_tags ppf tags  =
+  Fmt.(pp_print_list ~pp_sep:comma) print_tag ppf tags
+
+let is_unit env ty =
+  match Types.get_desc (Ctype.expand_head env ty) with
+  | Tconstr (p, _, _) -> Path.same p Predef.path_unit
+  | _ -> false
+
+let unifiable env ty1 ty2 =
+  let snap = Btype.snapshot () in
+  let res =
+    try Ctype.unify env ty1 ty2; true
+    with Ctype.Unify _ -> false
+  in
+  Btype.backtrack snap;
+  res
+
+let explanation_diff env t3 t4 =
+  match Types.get_desc t3, Types.get_desc t4 with
+  | Tarrow (_, ty1, ty2, _), _
+    when is_unit env ty1 && unifiable env ty2 t4 ->
+      Some (doc_printf
+          "@,@[@{<hint>Hint@}: Did you forget to provide %a as argument?@]"
+          Style.inline_code "()"
+        )
+  | _, Tarrow (_, ty1, ty2, _)
+    when is_unit env ty1 && unifiable env t3 ty2 ->
+      Some (doc_printf
+          "@,@[@{<hint>Hint@}: Did you forget to wrap the expression using \
+           %a?@]"
+          Style.inline_code "fun () ->"
+        )
+  | _ ->
+      None
+
+let explain_fixed_row_case = function
+  | Errortrace.Cannot_be_closed -> doc_printf "it cannot be closed"
+  | Errortrace.Cannot_add_tags tags ->
+      doc_printf "it may not allow the tag(s) %a"
+        print_tags tags
+
+let pp_path ppf p =
+  Style.as_inline_code Printtyp.Doc.path ppf p
+
+let explain_fixed_row pos expl = match expl with
+  | Types.Fixed_private ->
+    doc_printf "The %a variant type is private" Errortrace.print_pos pos
+  | Types.Univar x ->
+    Variable_names.reserve x;
+    doc_printf "The %a variant type is bound to the universal type variable %a"
+      Errortrace.print_pos pos
+      (Style.as_inline_code type_expr_with_reserved_names) x
+  | Types.Reified p ->
+    doc_printf "The %a variant type is bound to %a"
+      Errortrace.print_pos pos
+      (Style.as_inline_code
+         (fun ppf p ->
+           Internal_names.add p;
+           print_path p ppf))
+      p
+  | Types.Rigid -> Format_doc.Doc.empty
+
+let explain_variant (type variety) : variety Errortrace.variant -> _ = function
+  (* Common *)
+  | Errortrace.Incompatible_types_for s ->
+      Some(doc_printf "@,Types for tag %a are incompatible"
+             print_tag s
+          )
+  (* Unification *)
+  | Errortrace.No_intersection ->
+      Some(doc_printf "@,These two variant types have no intersection")
+  | Errortrace.No_tags(pos,fields) -> Some(
+      doc_printf
+        "@,@[The %a variant type does not allow tag(s)@ @[<hov>%a@]@]"
+        Errortrace.print_pos pos
+        print_tags (List.map fst fields)
+    )
+  | Errortrace.Fixed_row (pos,
+                          k,
+                          (Univar _ | Reified _ | Fixed_private as e)) ->
+      Some (
+        doc_printf "@,@[%a,@ %a@]" pp_doc (explain_fixed_row pos e)
+          pp_doc (explain_fixed_row_case k)
+      )
+  | Errortrace.Fixed_row (_,_, Rigid) ->
+      (* this case never happens *)
+      None
+  (* Equality & Moregen *)
+  | Errortrace.Presence_not_guaranteed_for (pos, s) -> Some(
+      doc_printf
+        "@,@[The tag %a is guaranteed to be present in the %a variant type,\
+         @ but not in the %a@]"
+        print_tag s
+        Errortrace.print_pos (Errortrace.swap_position pos)
+        Errortrace.print_pos pos
+    )
+  | Errortrace.Openness pos ->
+      Some(doc_printf "@,The %a variant type is open and the %a is not"
+             Errortrace.print_pos pos
+             Errortrace.print_pos (Errortrace.swap_position pos))
+
+let explain_escape pre = function
+  | Errortrace.Univ u ->
+      Variable_names.reserve u;
+      Some(
+        doc_printf "%a@,The universal variable %a would escape its scope"
+          pp_doc pre
+          (Style.as_inline_code type_expr_with_reserved_names) u
+      )
+  | Errortrace.Constructor p -> Some(
+      doc_printf
+        "%a@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
+        pp_doc pre pp_path p
+    )
+  | Errortrace.Module_type p -> Some(
+      doc_printf
+        "%a@,@[The module type@;<1 2>%a@ would escape its scope@]"
+        pp_doc pre pp_path p
+    )
+  | Errortrace.Equation Errortrace.{ty = _; expanded = t} ->
+      Variable_names.reserve t;
+      Some(
+        doc_printf "%a@ @[<hov>This instance of %a is ambiguous:@ %s@]"
+          pp_doc pre
+          (Style.as_inline_code type_expr_with_reserved_names) t
+          "it would escape the scope of its equation"
+      )
+  | Errortrace.Self ->
+      Some (doc_printf "%a@,Self type cannot escape its class" pp_doc pre)
+  | Errortrace.Constraint ->
+      None
+
+let explain_object (type variety) : variety Errortrace.obj -> _ = function
+  | Errortrace.Missing_field (pos,f) -> Some(
+      doc_printf "@,@[The %a object type has no method %a@]"
+        Errortrace.print_pos pos Style.inline_code f
+    )
+  | Errortrace.Abstract_row pos -> Some(
+      doc_printf
+        "@,@[The %a object type has an abstract row, it cannot be closed@]"
+        Errortrace.print_pos pos
+    )
+  | Errortrace.Self_cannot_be_closed ->
+      Some (doc_printf
+              "@,Self type cannot be unified with a closed object type"
+           )
+
+let explain_incompatible_fields name (diff: Types.type_expr Errortrace.diff) =
+  Variable_names.reserve diff.got;
+  Variable_names.reserve diff.expected;
+  doc_printf "@,@[The method %a has type@ %a,@ \
+  but the expected method type was@ %a@]"
+    Style.inline_code name
+    (Style.as_inline_code type_expr_with_reserved_names) diff.got
+    (Style.as_inline_code type_expr_with_reserved_names) diff.expected
+
+
+let explain_label_mismatch ~got ~expected =
+  let quoted_label ppf l = Style.inline_code ppf (Asttypes.string_of_label l) in
+  match got, expected with
+  | Asttypes.Nolabel, Asttypes.(Labelled _ | Optional _ )  ->
+      doc_printf "@,@[A label@ %a@ was expected@]"
+        quoted_label expected
+  | Asttypes.(Labelled _|Optional _), Asttypes.Nolabel  ->
+      doc_printf
+        "@,@[The first argument is labeled@ %a,@ \
+         but an unlabeled argument was expected@]"
+        quoted_label got
+ | Asttypes.Labelled g, Asttypes.Optional e when g = e ->
+      doc_printf
+        "@,@[The label@ %a@ was expected to be optional@]"
+        quoted_label got
+  | Asttypes.Optional g, Asttypes.Labelled e when g = e ->
+      doc_printf
+        "@,@[The label@ %a@ was expected to not be optional@]"
+        quoted_label got
+  | Asttypes.(Labelled _ | Optional _), Asttypes.(Labelled _ | Optional _) ->
+      doc_printf "@,@[Labels %a@ and@ %a do not match@]"
+        quoted_label got
+        quoted_label expected
+  | Asttypes.Nolabel, Asttypes.Nolabel ->
+      (* Two empty labels cannot be mismatched*)
+      assert false
+
+
+let explain_first_class_module = function
+  | Errortrace.Package_cannot_scrape p -> Some(
+      doc_printf "@,@[The module alias %a could not be expanded@]"
+        pp_path p
+    )
+  | Errortrace.Package_inclusion pr ->
+      Some(doc_printf "@,@[%a@]" Fmt.pp_doc pr)
+  | Errortrace.Package_coercion pr ->
+      Some(doc_printf "@,@[%a@]" Fmt.pp_doc pr)
+
+let explanation (type variety) intro prev env
+  : (Errortrace.expanded_type, variety) Errortrace.elt -> _ = function
+  | Errortrace.Diff {got; expected} ->
+    explanation_diff env got.expanded expected.expanded
+  | Errortrace.Escape {kind; context} ->
+    let pre =
+      match context, kind, prev with
+      | Some ctx, _, _ ->
+        Variable_names.reserve ctx;
+        doc_printf "@[%a@;<1 2>%a@]" pp_doc intro
+          (Style.as_inline_code type_expr_with_reserved_names) ctx
+      | None, Univ _, Some(Errortrace.Incompatible_fields {name; diff}) ->
+        explain_incompatible_fields name diff
+      | _ -> Format_doc.Doc.empty
+    in
+    explain_escape pre kind
+  | Errortrace.Incompatible_fields { name; diff} ->
+    Some(explain_incompatible_fields name diff)
+  | Errortrace.Function_label_mismatch diff ->
+    Some(explain_label_mismatch ~got:diff.got ~expected:diff.expected)
+  | Errortrace.Variant v ->
+    explain_variant v
+  | Errortrace.Obj o ->
+    explain_object o
+  | Errortrace.First_class_module fm ->
+    explain_first_class_module fm
+  | Errortrace.Rec_occur(x,y) ->
+    add_type_to_preparation x;
+    add_type_to_preparation y;
+    begin match Types.get_desc x with
+    | Tvar _ | Tunivar _  ->
+        Some(
+          doc_printf "@,@[<hov>The type variable %a occurs inside@ %a@]"
+            (Style.as_inline_code prepared_type_expr) x
+            (Style.as_inline_code prepared_type_expr) y
+        )
+    | _ ->
+        (* We had a delayed unification of the type variable with
+           a non-variable after the occur check. *)
+        Some Format_doc.Doc.empty
+        (* There is no need to search further for an explanation, but
+           we don't want to print a message of the form:
+             {[ The type int occurs inside int list -> 'a |}
+        *)
+    end
+
+let mismatch intro env trace =
+  Errortrace.explain trace (fun ~prev h -> explanation intro prev env h)
+
+let warn_on_missing_def env ppf t =
+  match Types.get_desc t with
+  | Tconstr (p,_,_) ->
+    begin match Env.find_type p env with
+    | exception Not_found ->
+        fprintf ppf
+          "@,@[<hov>Type %a is abstract because@ no corresponding\
+           @ cmi file@ was found@ in path.@]" pp_path p
+    | { type_manifest = Some _; _ } -> ()
+    | { type_manifest = None; _ } as decl ->
+        match Btype.type_origin decl with
+        | Rec_check_regularity ->
+            fprintf ppf
+              "@,@[<hov>Type %a was considered abstract@ when checking\
+               @ constraints@ in this@ recursive type definition.@]"
+              pp_path p
+        | Definition | Existential _ -> ()
+      end
+  | _ -> ()
+
+let prepare_expansion_head empty_tr = function
+  | Errortrace.Diff d ->
+      Some (Errortrace.map_diff (may_prepare_expansion empty_tr) d)
+  | _ -> None
+
+let head_error_printer mode txt_got txt_but = function
+  | None -> Format_doc.Doc.empty
+  | Some d ->
+      let d = Errortrace.map_diff (trees_of_type_expansion mode) d in
+      doc_printf "%a@;<1 2>%a@ %a@;<1 2>%a"
+        pp_doc txt_got pp_type_expansion d.Errortrace.got
+        pp_doc txt_but pp_type_expansion d.Errortrace.expected
+
+let warn_on_missing_defs env ppf = function
+  | None -> ()
+  | Some Errortrace.{got      = {ty=te1; expanded=_};
+                     expected = {ty=te2; expanded=_} } ->
+      warn_on_missing_def env ppf te1;
+      warn_on_missing_def env ppf te2
+
+(* [subst] comes out of equality, and is [[]] otherwise *)
+let error trace_format mode subst env tr txt1 ppf txt2 ty_expect_explanation =
+  reset ();
+  (* We want to substitute in the opposite order from [Eqtype] *)
+  Variable_names.add_subst (List.map (fun (ty1,ty2) -> ty2,ty1) subst);
+  let tr =
+    prepare_trace
+      (fun ty_exp ->
+         Errortrace.{ty_exp with expanded = hide_variant_name ty_exp.expanded})
+      tr
+  in
+  match tr with
+  | [] -> assert false
+  | (elt :: tr) as full_trace ->
+      with_labels (not !Clflags.classic) (fun () ->
+      let tr, last = filter_trace tr in
+      let head = prepare_expansion_head (tr=[] && last=None) elt in
+      let tr = List.map (Errortrace.map_diff prepare_expansion) tr in
+      let last = Option.map (Errortrace.map_diff prepare_expansion) last in
+      let head_error = head_error_printer mode txt1 txt2 head in
+      let tr = trees_of_trace mode tr in
+      let last =
+        Option.map (Errortrace.map_diff (trees_of_type_expansion mode)) last in
+      let mis = mismatch txt1 env full_trace in
+      let tr = match mis, last with
+        | None, Some elt -> tr @ [elt]
+        | Some _, _ | _, None -> tr
+       in
+       fprintf ppf
+        "@[<v>\
+          @[%a%a@]%a%a\
+         @]"
+        pp_doc head_error
+        pp_doc ty_expect_explanation
+        (trace false (incompatibility_phrase trace_format)) tr
+        (pp_print_option pp_doc) mis;
+      if env <> Env.empty
+      then warn_on_missing_defs env ppf head;
+       Internal_names.print_explanations env ppf;
+       Ident_conflicts.err_print ppf
+    )
+
+let report_error trace_format ppf mode env tr
+      ?(subst = [])
+      ?(type_expected_explanation = Fmt.Doc.empty)
+      txt1 txt2 =
+  wrap_printing_env ~error:true env (fun () ->
+    error trace_format mode subst env tr txt1 ppf txt2
+      type_expected_explanation)
+
+let unification
+      ppf env ({trace} : Errortrace.unification_error) =
+  report_error Unification ppf Type env
+    ?subst:None trace
+
+let equality
+      ppf mode env ({subst; trace} : Errortrace.equality_error) =
+  report_error Equality ppf mode env
+    ~subst ?type_expected_explanation:None trace
+
+let moregen
+      ppf mode env ({trace} : Errortrace.moregen_error) =
+  report_error Moregen ppf mode env
+    ?subst:None ?type_expected_explanation:None trace
+
+let comparison ppf mode env = function
+  | Errortrace.Equality_error error -> equality ppf mode env error
+  | Errortrace.Moregen_error  error -> moregen  ppf mode env error
+
+module Subtype = struct
+  (* There's a frustrating amount of code duplication between this module and
+     the outside code, particularly in [prepare_trace] and [filter_trace].
+     Unfortunately, [Subtype] is *just* similar enough to have code duplication,
+     while being *just* different enough (it's only [Diff]) for the abstraction
+     to be nonobvious.  Someday, perhaps... *)
+
+  let printing_status = function
+    | Errortrace.Subtype.Diff d -> diff_printing_status d
+
+  let prepare_unification_trace = prepare_trace
+
+  let prepare_trace f tr =
+    prepare_any_trace printing_status (Errortrace.Subtype.map f tr)
+
+  let trace filter_trace get_diff fst keep_last txt ppf tr =
+    with_labels (not !Clflags.classic) (fun () ->
+      match tr with
+      | elt :: tr' ->
+        let diffed_elt = get_diff elt in
+        let tr, last = filter_trace tr' in
+        let tr = match keep_last, last with
+          | true, Some last -> tr @ [last]
+          | _ -> tr
+        in
+        let tr =
+          trees_of_trace Type
+          @@ List.map (Errortrace.map_diff prepare_expansion) tr in
+        let tr =
+          match fst, diffed_elt with
+          | true, Some elt -> elt :: tr
+          | _, _ -> tr
+        in
+        trace fst txt ppf tr
+      | _ -> ()
+    )
+
+  let rec filter_subtype_trace = function
+    | [] -> [], None
+    | [Errortrace.Subtype.Diff d as elt]
+      when printing_status elt = Optional_refinement ->
+        [], Some d
+    | Errortrace.Subtype.Diff d :: rem ->
+        let ftr, last = filter_subtype_trace rem in
+        d :: ftr, last
+
+  let unification_get_diff = function
+    | Errortrace.Diff diff ->
+        Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
+    | _ -> None
+
+  let subtype_get_diff = function
+    | Errortrace.Subtype.Diff diff ->
+        Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
+
+  let error
+        ppf
+        env
+        (Errortrace.Subtype.{trace = tr_sub; unification_trace = tr_unif})
+        txt1 =
+    wrap_printing_env ~error:true env (fun () ->
+      reset ();
+      let tr_sub = prepare_trace prepare_expansion tr_sub in
+      let tr_unif = prepare_unification_trace prepare_expansion tr_unif in
+      let keep_first = match tr_unif with
+        | [Obj _ | Variant _ | Escape _ ] | [] -> true
+        | _ -> false in
+      fprintf ppf "@[<v>%a"
+        (trace filter_subtype_trace subtype_get_diff true keep_first txt1)
+        tr_sub;
+      if tr_unif = [] then fprintf ppf "@]" else
+        let mis = mismatch (doc_printf "Within this type") env tr_unif in
+        fprintf ppf "%a%a%t@]"
+          (trace filter_trace unification_get_diff false
+             (mis = None) "is not compatible with type") tr_unif
+          (pp_print_option pp_doc) mis
+          Ident_conflicts.err_print
+    )
+end
+
+let subtype = Subtype.error
+
+let quoted_ident ppf t =
+  Style.as_inline_code !Oprint.out_ident ppf t
+
+let type_path_expansion ppf = function
+  | Same p -> quoted_ident ppf p
+  | Diff(p,p') ->
+      fprintf ppf "@[<2>%a@ =@ %a@]"
+       quoted_ident p
+       quoted_ident p'
+
+let trees_of_type_path_expansion (tp,tp') =
+  let path_tree = namespaced_tree_of_path Type in
+  if Path.same tp tp' then Same(path_tree tp) else
+    Diff(path_tree tp, path_tree tp)
+
+let type_path_list ppf l =
+  Fmt.pp_print_list ~pp_sep:(fun ppf () -> Fmt.pp_print_break ppf 2 0)
+    type_path_expansion ppf l
+
+let ambiguous_type ppf env tp0 tpl txt1 txt2 txt3 =
+  wrap_printing_env ~error:true env (fun () ->
+    reset ();
+    let tp0 = trees_of_type_path_expansion tp0 in
+      match tpl with
+      [] -> assert false
+    | [tp] ->
+        fprintf ppf
+          "@[%a@;<1 2>%a@ \
+             %a@;<1 2>%a\
+           @]"
+          pp_doc txt1 type_path_expansion (trees_of_type_path_expansion tp)
+          pp_doc txt3 type_path_expansion tp0
+    | _ ->
+        fprintf ppf
+          "@[%a@;<1 2>@[<hv>%a@]\
+             @ %a@;<1 2>%a\
+           @]"
+          pp_doc txt2 type_path_list (List.map trees_of_type_path_expansion tpl)
+          pp_doc txt3 type_path_expansion tp0)

diff --git a/typing/errortrace_report.mli b/typing/errortrace_report.mli
new file mode 100644 (file)
index 0000000..bb6f0ea
--- /dev/null
+++ b/typing/errortrace_report.mli
@@ -0,0 +1,56 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*  Florian Angeletti, projet Cambium, INRIA Paris                        *)
+(*                                                                        *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Functions for reporting core level type errors. *)
+
+open Format_doc
+
+val ambiguous_type:
+    formatter -> Env.t -> (Path.t * Path.t) -> (Path.t * Path.t) list ->
+    Format_doc.t -> Format_doc.t -> Format_doc.t -> unit
+
+val unification :
+  formatter ->
+  Env.t -> Errortrace.unification_error ->
+  ?type_expected_explanation:Format_doc.t -> Format_doc.t -> Format_doc.t ->
+  unit
+
+val equality :
+  formatter ->
+  Out_type.type_or_scheme ->
+  Env.t -> Errortrace.equality_error ->
+   Format_doc.t -> Format_doc.t ->
+  unit
+
+val moregen :
+  formatter ->
+  Out_type.type_or_scheme ->
+  Env.t -> Errortrace.moregen_error ->
+  Format_doc.t -> Format_doc.t ->
+  unit
+
+val comparison :
+  formatter ->
+  Out_type.type_or_scheme ->
+  Env.t -> Errortrace.comparison_error ->
+  Format_doc.t -> Format_doc.t  ->
+  unit
+
+val subtype :
+  formatter ->
+  Env.t ->
+  Errortrace.Subtype.error ->
+  string ->
+  unit

diff --git a/typing/gprinttyp.ml b/typing/gprinttyp.ml
new file mode 100644 (file)
index 0000000..0056efb
--- /dev/null
+++ b/typing/gprinttyp.ml
@@ -0,0 +1,912 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Florian Angeletti, projet Cambium, Inria Paris             *)
+(*                                                                        *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(* Print a raw type expression, with sharing *)
+open Format
+
+module String_set = Set.Make(String)
+
+module Decoration = struct
+  type color =
+    | Named of string
+    | HSL of {h:float;s:float;l:float}
+
+  let red = Named "red"
+  let blue = Named "blue"
+  let green = Named "green"
+  let purple = Named "purple"
+  let lightgrey = Named "lightgrey"
+  let hsl ~h ~s ~l = HSL {h;s;l}
+
+  type style =
+    | Filled of color option
+    | Dotted
+    | Dash
+
+  type shape =
+    | Ellipse
+    | Circle
+    | Diamond
+
+  type property =
+    | Color of color
+    | Font_color of color
+    | Style of style
+    | Label of string list
+    | Shape of shape
+
+  let filled c = Style (Filled (Some c))
+
+  type r = {
+    color: color option;
+    font_color:color option;
+    style: style option;
+    label: string list;
+    shape: shape option;
+  }
+
+  let update r l = match l with
+    | Color c -> { r with color = Some c}
+    | Style s -> { r with style = Some s}
+    | Label s -> { r with label = s}
+    | Font_color c -> { r with font_color = Some c}
+    | Shape s -> { r with shape = Some s }
+
+  let none = { color=None; font_color=None; style=None; shape=None; label = [] }
+
+  let make l = List.fold_left update none l
+
+  let label r = if r.label = [] then None else Some (Label r.label)
+  let color r = Option.map (fun x -> Color x) r.color
+  let font_color r = Option.map (fun x -> Font_color x) r.font_color
+  let style r = Option.map (fun x -> Style x) r.style
+  let shape r = Option.map (fun x -> Shape x) r.shape
+
+  let decompose r =
+  let (@?) x l = match x with
+    | None -> l
+    | Some x -> x :: l
+   in
+  label r @? color r @? font_color r @? style r @? shape r @? []
+
+  let alt x y = match x with
+  | None -> y
+  | Some _ -> x
+
+  let merge_label l r =
+    let r' = String_set.of_list r in
+    let l' = String_set.of_list l in
+    List.filter (fun x -> not (String_set.mem x r') ) l
+    @ List.filter (fun x -> not (String_set.mem x l') ) r
+
+  let merge l r =
+    { color = alt l.color r.color;
+      style = alt l.style r.style;
+      label = merge_label l.label r.label;
+      font_color = alt l.font_color r.font_color;
+      shape = alt l.shape r.shape;
+    }
+  let txt t = Label [t]
+
+end
+type decoration = Decoration.r
+
+type dir = Toward | From
+
+let txt = Decoration.txt
+let std = Decoration.none
+let dotted = Decoration.(make [Style Dotted])
+let memo = Decoration.(make [txt "expand"; Style Dash] )
+
+
+type params = {
+  short_ids:bool;
+  elide_links:bool;
+  expansion_as_hyperedge:bool;
+  colorize:bool;
+  follow_expansions:bool;
+}
+
+let elide_links ty =
+  let rec follow_safe visited t =
+    let t = Types.Transient_expr.coerce t in
+    if List.memq t visited then t
+    else match t.Types.desc with
+      | Tlink t' -> follow_safe (t::visited) t'
+      | _ -> t
+  in
+  follow_safe [] ty
+
+let repr params ty =
+  if params.elide_links then elide_links ty
+  else Types.Transient_expr.coerce ty
+
+module Index: sig
+  type t = private
+    | Main of int
+    | Synthetic of int
+    | Named_subnode of { id:int; synth:bool; name:string }
+  val subnode: name:string -> t -> t
+  val either_ext: Types.row_field_cell ->  t
+  val split:
+    params -> Types.type_expr -> t * Decoration.color option * Types.type_desc
+  val colorize: params -> t -> Decoration.color option
+end = struct
+  type t =
+    | Main of int
+    | Synthetic of int
+    | Named_subnode of { id:int; synth:bool; name:string }
+
+  type name_map = {
+    (* We keep the main and synthetic and index space separate to avoid index
+       collision when we use the typechecker provided [id]s as main indices *)
+    main_last: int ref;
+    synthetic_last: int ref;
+    either_cell_ids: (Types.row_field_cell * int) list ref;
+    tbl: (int,int) Hashtbl.t;
+  }
+
+  let id_map = {
+    main_last = ref 0;
+    synthetic_last = ref 0;
+    either_cell_ids = ref [];
+    tbl = Hashtbl.create 20;
+  }
+
+  let fresh_main_id () =
+    incr id_map.main_last;
+    !(id_map.main_last)
+
+  let fresh_synthetic_id () =
+    incr id_map.synthetic_last;
+    !(id_map.synthetic_last)
+
+  let stable_id = function
+    | Main id | Synthetic id | Named_subnode {id;_} -> id
+
+  let pretty_id params id =
+    if not params.short_ids then Main id else
+      match Hashtbl.find_opt id_map.tbl id with
+      | Some x -> Main x
+      | None ->
+          let last = fresh_main_id () in
+          Hashtbl.replace id_map.tbl id last;
+          Main last
+
+  (** Generate color from the node id to keep the color stable inbetween
+      different calls to the typechecker on the same input. *)
+  let colorize_id params id =
+    if not params.colorize then None
+    else
+      (* Generate pseudo-random color by cycling over 200 hues while keeping
+         pastel level of saturation and lightness *)
+      let nhues = 200 in
+      (* 17 and 200 are relatively prime, thus 17 is of order 200 in Z/200Z. A
+         step size around 20 makes it relatively easy to spot different hues. *)
+      let h = float_of_int (17 * id mod nhues) /. float_of_int nhues in
+      (* Add a modulation of period 3 and 7 to the saturation and lightness *)
+      let s = match id mod 3 with
+        | 0 -> 0.3
+        | 1 -> 0.5
+        | 2 | _ -> 0.7
+      in
+      let l = match id mod 7 with
+        | 0 -> 0.5
+        | 1 -> 0.55
+        | 2 -> 0.60
+        | 3 -> 0.65
+        | 4 -> 0.70
+        | 5 -> 0.75
+        | 6 | _ -> 0.8
+      in
+      (* With 3, 7 and 200 relatively prime, we cycle over the full parameter
+         space with 4200 different colors. *)
+      Some (Decoration.hsl ~h ~s ~l)
+
+  let colorize params index = colorize_id params (stable_id index)
+
+  let split params x =
+    let x = repr params x in
+    let color = colorize_id params x.id in
+    pretty_id params x.id, color, x.desc
+
+  let subnode ~name x = match x with
+    | Main id -> Named_subnode {id;name;synth=false}
+    | Named_subnode r -> Named_subnode {r with name}
+    | Synthetic id -> Named_subnode {id;name;synth=true}
+
+  let either_ext r =
+    let either_ids = !(id_map.either_cell_ids) in
+    match List.assq_opt r either_ids with
+    | Some n -> Synthetic n
+    | None ->
+        let n = fresh_synthetic_id () in
+        id_map.either_cell_ids := (r,n) :: either_ids;
+        Synthetic n
+
+end
+
+
+type index = Index.t
+module Node_set = Set.Make(struct
+    type t = Index.t
+    let compare = Stdlib.compare
+end)
+
+module Edge_set = Set.Make(struct
+    type t = Index.t * Index.t
+    let compare = Stdlib.compare
+end)
+
+module Hyperedge_set = Set.Make(struct
+    type t = (dir * Decoration.r * index) list
+    let compare = Stdlib.compare
+end)
+
+type subgraph =
+  {
+    nodes: Node_set.t;
+    edges: Edge_set.t;
+    hyperedges: Hyperedge_set.t;
+    subgraphes: (Decoration.r * subgraph) list;
+  }
+
+
+let empty_subgraph=
+  { nodes = Node_set.empty;
+    edges=Edge_set.empty;
+    hyperedges = Hyperedge_set.empty;
+    subgraphes = [];
+  }
+
+
+type 'index elt =
+  | Node of 'index
+  | Edge of 'index * 'index
+  | Hyperedge of (dir * Decoration.r * 'index) list
+type element = Types.type_expr elt
+
+
+module Elt_map = Map.Make(struct
+    type t = Index.t elt
+    let compare = Stdlib.compare
+  end)
+let (.%()) map e =
+  Option.value ~default:Decoration.none @@
+  Elt_map.find_opt e map
+
+type digraph = {
+  elts: Decoration.r Elt_map.t;
+  graph: subgraph
+}
+
+module Pp = struct
+
+  let semi ppf () = fprintf ppf ";@ "
+  let space ppf () = fprintf ppf "@ "
+  let empty ppf () = fprintf ppf ""
+  let string =pp_print_string
+  let list ~sep = pp_print_list ~pp_sep:sep
+  let seq ~sep = pp_print_seq ~pp_sep:sep
+  let rec longident ppf = function
+    | Longident.Lident s -> fprintf ppf "%s" s
+    | Longident.Ldot (l,s) -> fprintf ppf "%a.%s"  longident l s
+    | Longident.Lapply(f,x) -> fprintf ppf "%a(%a)" longident f  longident x
+
+  let color ppf = function
+    | Decoration.Named s -> fprintf ppf "%s" s
+    | Decoration.HSL r -> fprintf ppf "%1.3f %1.3f %1.3f" r.h r.s r.l
+
+  let style ppf = function
+    | Decoration.Filled _ -> fprintf ppf "filled"
+    | Decoration.Dash -> fprintf ppf "dashed"
+    | Decoration.Dotted -> fprintf ppf "dotted"
+
+  let shape ppf = function
+    | Decoration.Circle -> fprintf ppf "circle"
+    | Decoration.Diamond -> fprintf ppf "diamond"
+    | Decoration.Ellipse -> fprintf ppf "ellipse"
+
+  let property ppf = function
+    | Decoration.Color c -> fprintf ppf {|color="%a"|} color c
+    | Decoration.Font_color c -> fprintf ppf {|fontcolor="%a"|} color c
+    | Decoration.Style s ->
+        fprintf ppf {|style="%a"|} style s;
+        begin match s with
+        | Filled (Some c) -> fprintf ppf {|;@ fillcolor="%a"|} color c;
+        | _ -> ()
+        end;
+    | Decoration.Shape s -> fprintf ppf {|shape="%a"|} shape s
+    | Decoration.Label s ->
+        fprintf ppf {|label=<%a>|} (list ~sep:space string) s
+
+  let inline_decoration ppf r =
+    match Decoration.decompose r with
+    | [] -> ()
+    | l -> fprintf ppf "@[<v>%a@]" (list ~sep:semi property) l
+
+  let decoration ppf r =
+    match Decoration.decompose r with
+    | [] -> ()
+    | l -> fprintf ppf "[@[<h>%a@]]" (list ~sep:semi property) l
+
+  let row_fixed ppf = function
+    | None -> fprintf ppf ""
+    | Some Types.Fixed_private -> fprintf ppf "private"
+    | Some Types.Rigid -> fprintf ppf "rigid"
+    | Some Types.Univar _t -> fprintf ppf "univar"
+    | Some Types.Reified _p -> fprintf ppf "reified"
+
+  let field_kind ppf v =
+    match Types.field_kind_repr v with
+    | Fpublic -> fprintf ppf "public"
+    | Fabsent -> fprintf ppf "absent"
+    | Fprivate -> fprintf ppf "private"
+
+  let index ppf = function
+    | Index.Main id -> fprintf ppf "i%d" id
+    | Index.Synthetic id -> fprintf ppf "s%d" id
+    | Index.Named_subnode r ->
+        fprintf ppf "%s%dRF%s" (if r.synth then "s" else "i") r.id r.name
+
+  let prettier_index ppf = function
+    | Index.Main id -> fprintf ppf "%d" id
+    | Index.Synthetic id -> fprintf ppf "[%d]" id
+    | Index.Named_subnode r -> fprintf ppf "%d(%s)" r.id r.name
+
+  let hyperedge_id ppf l =
+    let sep ppf () = fprintf ppf "h" in
+    let elt ppf (_,_,x) = index ppf x in
+    fprintf ppf "h%a" (list ~sep elt) l
+
+  let node graph ppf x =
+    let d = graph.%(Node x) in
+    fprintf ppf "%a%a;@ " index x decoration d
+
+  let edge graph ppf (x,y) =
+    let d = graph.%(Edge (x,y)) in
+    fprintf ppf "%a->%a%a;@ " index x index y decoration d
+
+  let hyperedge graph ppf l =
+    let d = graph.%(Hyperedge l) in
+    fprintf ppf "%a%a;@ " hyperedge_id l decoration d;
+    List.iter (fun (dir,d,x) ->
+        match dir with
+        | From ->
+            fprintf ppf "%a->%a%a;@ " index x hyperedge_id l decoration d
+        | Toward ->
+            fprintf ppf "%a->%a%a;@ " hyperedge_id l index x decoration d
+      ) l
+
+  let cluster_counter = ref 0
+  let pp_cluster ppf =
+    incr cluster_counter;
+    fprintf ppf "cluster_%d" !cluster_counter
+
+  let exponent_of_label ppf = function
+    | Asttypes.Nolabel -> ()
+    | Asttypes.Labelled s -> fprintf ppf "<SUP>%s</SUP>" s
+    | Asttypes.Optional s -> fprintf ppf "<SUP>?%s</SUP>" s
+
+  let pretty_var ppf name =
+    let name = Option.value ~default:"_" name in
+    let name' =
+      match name with
+      | "a" -> "𝛼"
+      | "b" -> "𝛽"
+      | "c" -> "𝛾"
+      | "d" -> "𝛿"
+      | "e" -> "𝜀"
+      | "f" -> "𝜑"
+      | "t" -> "𝜏"
+      | "r" -> "𝜌"
+      | "s" -> "𝜎"
+      | "p" -> "𝜋"
+      | "i" -> "𝜄"
+      | "h" -> "𝜂"
+      | "k" -> "𝜅"
+      | "l" -> "𝜆"
+      | "m" -> "𝜇"
+      | "x" -> "𝜒"
+      | "n" -> "𝜐"
+      | "o" -> "𝜔"
+      | name -> name
+    in
+    if name = name' then
+      fprintf ppf "'%s" name
+    else pp_print_string ppf name'
+
+  let rec subgraph elts ppf (d,sg) =
+    fprintf ppf
+      "@[<v 2>subgraph %t {@,\
+       %a;@ \
+       %a%a%a%a}@]@."
+      pp_cluster
+      inline_decoration d
+      (seq ~sep:empty (node elts)) (Node_set.to_seq sg.nodes)
+      (seq ~sep:empty (edge elts)) (Edge_set.to_seq sg.edges)
+      (seq ~sep:empty (hyperedge elts)) (Hyperedge_set.to_seq sg.hyperedges)
+      (list ~sep:empty (subgraph elts)) sg.subgraphes
+
+  let graph ppf {elts;graph} =
+    fprintf ppf "@[<v 2>digraph {@,%a%a%a%a}@]@."
+    (seq ~sep:empty (node elts)) (Node_set.to_seq graph.nodes)
+    (seq ~sep:empty (edge elts)) (Edge_set.to_seq graph.edges)
+    (seq ~sep:empty (hyperedge elts)) (Hyperedge_set.to_seq graph.hyperedges)
+    (list ~sep:empty (subgraph elts)) graph.subgraphes
+
+end
+
+
+module Digraph = struct
+
+  type t = digraph = {
+    elts: Decoration.r Elt_map.t;
+    graph: subgraph
+  }
+
+  let empty = { elts = Elt_map.empty; graph = empty_subgraph }
+
+  let add_to_subgraph s = function
+    | Node ty ->
+        let nodes = Node_set.add ty s.nodes in
+        { s with nodes }
+    | Edge (x,y) ->
+        let edges = Edge_set.add (x,y) s.edges in
+        { s with edges }
+    | Hyperedge l ->
+        let hyperedges = Hyperedge_set.add l s.hyperedges in
+        { s with hyperedges }
+
+  let add_subgraph sub g =
+    { g with subgraphes = sub :: g.subgraphes }
+
+  let add ?(override=false) d entry dg =
+    match Elt_map.find_opt entry dg.elts with
+    | Some d' ->
+        let d =
+          if override then Decoration.merge d d'
+          else Decoration.merge d' d
+        in
+        { dg with elts = Elt_map.add entry d dg.elts }
+    | None ->
+        let elts = Elt_map.add entry d dg.elts in
+        { elts; graph = add_to_subgraph dg.graph entry }
+
+  let rec hyperedges_of_memo ty params id abbrev dg =
+    match abbrev with
+    | Types.Mnil -> dg
+    | Types.Mcons (_priv, _p, t1, t2, rem) ->
+        let s, dg = ty params t1 dg in
+        let exp, dg = ty params t2 dg in
+        dg |>
+        add memo
+          (Hyperedge
+             [From, dotted, id;
+              Toward, dotted, s;
+              Toward, Decoration.make [txt "expand"], exp
+             ])
+        |> hyperedges_of_memo ty params id rem
+    | Types.Mlink rem -> hyperedges_of_memo ty params id !rem dg
+
+  let rec edges_of_memo ty params abbrev dg =
+    match abbrev with
+    | Types.Mnil -> dg
+    | Types.Mcons (_priv, _p, t1, t2, rem) ->
+        let x, dg = ty params t1 dg in
+        let y, dg = ty params t2 dg in
+        dg |> add memo (Edge (x,y)) |> edges_of_memo ty params rem
+    | Types.Mlink rem -> edges_of_memo ty params !rem dg
+
+  let expansions ty params id memo dg =
+    if params.expansion_as_hyperedge then
+      hyperedges_of_memo ty params id memo dg
+    else
+      edges_of_memo ty params memo dg
+
+  let labelk k fmt = kasprintf (fun s -> k  [txt s]) fmt
+  let labelf fmt = labelk Fun.id fmt
+  let labelr fmt = labelk Decoration.make fmt
+
+  let add_node explicit_d color id tynode dg =
+    let d = labelf "<SUB>%a</SUB>" Pp.prettier_index id in
+    let d = match color with
+    | None -> Decoration.make d
+    | Some x -> Decoration.(make (filled x :: d))
+    in
+    let d = Decoration.merge explicit_d d in
+    add d tynode dg
+
+  let field_node color lbl rf =
+    let col = match color with
+      | None -> []
+      | Some c -> [Decoration.Color c]
+    in
+    let pr_lbl ppf = match lbl with
+      | None -> ()
+      | Some lbl -> fprintf ppf "`%s" lbl
+    in
+    let lbl =
+      Types.match_row_field
+        ~absent:(fun _ -> labelf "`-%t" pr_lbl)
+        ~present:(fun _ -> labelf "&gt;%t" pr_lbl)
+        ~either:(fun c _tl m _e ->
+            labelf "%s%t%s"
+              (if m then "?" else "")
+              pr_lbl
+              (if c then "(∅)" else "")
+          )
+        rf
+    in
+    Decoration.(make (Shape Diamond::col@lbl))
+
+  let group ty id0 lbl l dg =
+    match l with
+    | [] -> dg
+    | first :: l ->
+      let sub = { dg with graph = empty_subgraph } in
+      let id, sub = ty first sub in
+      let sub = List.fold_left (fun dg t -> snd (ty t dg)) sub l in
+      let dg = { sub with graph = add_subgraph (lbl,sub.graph) dg.graph } in
+      dg |> add std (Edge(id0,id))
+
+  let split_fresh_typ params ty0 g =
+    let (id, color, desc) = Index.split params ty0 in
+    let tynode = Node id in
+    if Elt_map.mem tynode g then id, None else id, Some (tynode,color,desc)
+
+  let pp_path = Format_doc.compat Path.print
+
+  let rec inject_typ params ty0 dg =
+    let id, next = split_fresh_typ params ty0 dg.elts in
+    match next with
+    | None -> id, dg
+    | Some (tynode,color,desc) ->
+        id, node params color id tynode desc dg
+  and edge params id0 lbl ty gh =
+    let id, gh = inject_typ params ty gh in
+    add lbl (Edge(id0,id)) gh
+  and poly_edge ~color params id0 gh ty =
+    let id, gh = inject_typ params ty gh in
+    match color with
+    | None -> add (labelr "bind") (Edge (id0,id)) gh
+    | Some c ->
+        let d = Decoration.(make [txt "bind"; Color c]) in
+        let gh = add d (Edge (id0,id)) gh in
+        add ~override:true Decoration.(make [filled c]) (Node id) gh
+  and numbered_edge params id0 (i,gh) ty =
+    let l = labelr "%d" i in
+    i + 1, edge params id0 l ty gh
+  and numbered_edges params id0 l gh =
+    snd @@ List.fold_left
+      (numbered_edge params id0)
+      (0,gh) l
+  and node params color id tynode desc dg =
+    let add_tynode l = add_node l color id tynode dg in
+    let mk fmt = labelk (fun l -> add_tynode (Decoration.make l)) fmt in
+    let numbered = numbered_edges params id in
+    let edge = edge params id in
+    let std_edge = edge std in
+    match desc with
+    | Types.Tvar name -> mk "%a" Pp.pretty_var name
+    | Types.Tarrow(l,t1,t2,_) ->
+       mk "→%a" Pp.exponent_of_label l |> numbered [t1; t2]
+    | Types.Ttuple tl ->
+        mk "*" |> numbered tl
+    | Types.Tconstr (p,tl,abbrevs) ->
+        let constr = mk "%a" pp_path p |> numbered tl in
+        if not params.follow_expansions then
+          constr
+        else
+          expansions inject_typ params id !abbrevs constr
+    | Types.Tobject (t, name) ->
+        let dg =
+          begin match !name with
+          | None -> mk "[obj]"
+          | Some (p,[]) -> (* invalid format *)
+              mk "[obj(%a)]" pp_path p
+          | Some (p, (rv_or_nil :: tl)) ->
+              match Types.get_desc rv_or_nil with
+              | Tnil ->
+                  mk "[obj(%a)]" pp_path p |> std_edge t |> numbered tl
+              | _ ->
+                  mk "[obj(#%a)]" pp_path p
+                  |> edge (labelr "row variable") rv_or_nil
+                  |> numbered tl
+          end
+        in
+        begin match split_fresh_typ params t dg.elts with
+        | _, None -> dg
+        | next_id, Some (_, color, desc) ->
+            group_fields ~params ~prev_id:id
+              dg.elts dg.graph empty_subgraph
+              ~id:next_id ~color ~desc
+        end
+    | Types.Tfield _ ->
+        group_fields ~params ~prev_id:id
+          dg.elts dg.graph empty_subgraph
+          ~color ~id ~desc
+    | Types.Tnil -> mk "[Nil]"
+    | Types.Tlink t -> add_tynode Decoration.(make [Style Dash]) |> std_edge t
+    | Types.Tsubst (t, o) ->
+        let dg = add_tynode (labelr "[Subst]") |> std_edge t in
+        begin match o with
+        | None -> dg
+        | Some row -> edge (labelr "parent polyvar") row dg
+        end
+    | Types.Tunivar name ->
+        mk "%a<SUP>∀</SUP>" Pp.pretty_var name
+    | Types.Tpoly (t, tl) ->
+        let dg = mk "∀" |> std_edge t in
+        List.fold_left (poly_edge ~color params id) dg tl
+    | Types.Tvariant row ->
+        let Row {fields; more; name; fixed; closed} = Types.row_repr row in
+        let closed = if closed then "<SUP>closed</SUP>" else "" in
+        let dg = match name with
+          | None -> mk "[Row%s]" closed
+          | Some (p,tl) ->
+              mk "[Row %a%s]" pp_path p closed
+              |> numbered tl
+        in
+        let more_lbl = labelr "%a row variable" Pp.row_fixed fixed in
+        let dg = dg |> edge more_lbl more in
+        let elts, main, fields =
+          List.fold_left (variant params id)
+            (dg.elts, dg.graph, empty_subgraph)
+            fields
+        in
+        { elts; graph = add_subgraph (labelr "polyvar", fields) main }
+    | Types.Tpackage (p, fl) ->
+        let types = List.map snd fl in
+        mk "[mod %a with %a]"
+          pp_path p
+          Pp.(list ~sep:semi longident) (List.map fst fl)
+        |> numbered types
+  and variant params id0 (elts,main,fields) (name,rf)  =
+    let id = Index.subnode ~name id0 in
+    let fnode = Node id in
+    let color = Index.colorize params id in
+    let fgraph = { elts; graph=fields } in
+    let fgraph = add (field_node color (Some name) rf) fnode fgraph  in
+    let { elts; graph=fields} = add dotted (Edge(id0,id)) fgraph in
+    let mgraph = { elts; graph=main } in
+    let {elts; graph=main} =
+      variant_inside params id rf mgraph
+    in
+    elts, main, fields
+  and variant_inside params id rf dg =
+    Types.match_row_field
+      ~absent:(fun () -> dg)
+      ~present:(function
+          | None -> dg
+          | Some arg -> numbered_edges params id [arg] dg
+        )
+      ~either:(fun _ tl _ (cell,e) ->
+          let dg = match tl with
+            | [] -> dg
+            | [x] -> edge params id std x dg
+            | _ :: _ as tls ->
+                let label = Decoration.(make [txt "⋀"; filled lightgrey]) in
+                group (inject_typ params) id label tls dg
+          in
+          match e with
+          | None -> dg
+          | Some f ->
+              let id_ext = Index.either_ext cell in
+              let color = Index.colorize params id_ext in
+              let dg = add (field_node color None f) (Node id_ext) dg in
+              let dg = add std (Edge(id,id_ext)) dg in
+              variant_inside params id_ext f dg
+        )
+      rf
+  and group_fields ~params ~prev_id elts main fields
+      ~color ~id ~desc =
+    let add_tynode dg l = add_node l color id (Node id) dg in
+    let mk dg fmt = labelk (fun l -> add_tynode dg (Decoration.make l)) fmt in
+    let merge elts ~main ~fields =
+      {elts; graph= add_subgraph (labelr "fields", fields) main }
+    in
+    match desc with
+    | Types.Tfield (f, k,typ, next) ->
+        let fgraph = { elts; graph=fields } in
+        let fgraph = mk fgraph "%s<SUP>%a</SUP>" f Pp.field_kind k in
+        let {elts; graph=fields} = add dotted (Edge (prev_id,id)) fgraph in
+        let {elts; graph=main} =
+          edge params id (labelr "method type") typ
+            {elts; graph= main}
+        in
+        let id_next, next = split_fresh_typ params next elts in
+        begin match next with
+        | None -> {elts; graph=main}
+        | Some (_,color,desc) ->
+            group_fields ~params ~prev_id:id
+              elts main fields
+              ~id:id_next ~desc ~color
+        end
+    | Types.Tvar name ->
+        let dg  = mk {elts; graph= fields } "%a" Pp.pretty_var name in
+        let {elts; graph=fields} =
+          add (labelr "row variable") (Edge(prev_id,id)) dg
+        in
+        merge elts ~main ~fields
+    | Types.Tnil -> merge elts ~main ~fields
+    | _ ->
+        let dg = merge elts ~main ~fields in
+        node params color id (Node id) desc dg
+end
+
+let params
+    ?(elide_links=true)
+    ?(expansion_as_hyperedge=false)
+    ?(short_ids=true)
+    ?(colorize=true)
+    ?(follow_expansions=true)
+    () =
+  {
+    expansion_as_hyperedge;
+    short_ids;
+    elide_links;
+    colorize;
+    follow_expansions;
+  }
+
+let update_params ?elide_links
+    ?expansion_as_hyperedge
+    ?short_ids
+    ?colorize
+    ?follow_expansions
+    params =
+  {
+    elide_links = Option.value ~default:params.elide_links elide_links;
+    expansion_as_hyperedge =
+      Option.value ~default:params.expansion_as_hyperedge
+        expansion_as_hyperedge;
+    short_ids = Option.value ~default:params.short_ids short_ids;
+    colorize = Option.value ~default:params.colorize colorize;
+    follow_expansions =
+      Option.value ~default:params.follow_expansions follow_expansions;
+  }
+
+
+let translate params dg (label,entry) =
+  let node, dg = match entry with
+    | Node ty ->
+        let id, dg = Digraph.inject_typ params ty dg in
+        Node id, dg
+    | Edge (ty,ty') ->
+        let id, dg = Digraph.inject_typ params ty dg in
+        let id', dg = Digraph.inject_typ params ty' dg in
+        Edge(id,id'), dg
+    | Hyperedge l ->
+        let l, dg = List.fold_left (fun (l,dg) (d,lbl,ty) ->
+            let id, dg = Digraph.inject_typ params ty dg in
+            (d,lbl,id)::l, dg
+          ) ([],dg) l
+        in
+       Hyperedge l, dg
+  in
+  Digraph.add ~override:true label node dg
+
+let add params ts dg =
+  List.fold_left (translate params) dg ts
+
+
+let make params ts =
+  add params ts Digraph.empty
+let pp = Pp.graph
+
+let add_subgraph params d elts dg =
+  let sub = add params elts { dg with graph = empty_subgraph } in
+  { sub with graph = Digraph.add_subgraph (d,sub.graph) dg.graph }
+
+let group_nodes (decoration, {graph=sub; elts=_}) ({elts;graph=main} as gmain) =
+  let nodes = Node_set.inter sub.nodes main.nodes in
+  if Node_set.cardinal nodes > 1 then
+  let sub = { empty_subgraph with nodes } in
+  let graph =
+    { main with
+      nodes = Node_set.diff main.nodes sub.nodes;
+      subgraphes = (decoration,sub) :: main.subgraphes
+    }
+  in { graph; elts}
+  else gmain
+
+let file_counter = ref 0
+
+let compact_loc ppf (loc:Warnings.loc) =
+  let startline = loc.loc_start.pos_lnum in
+  let endline = loc.loc_end.pos_lnum in
+  let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in
+  let endchar = loc.loc_end.pos_cnum - loc.loc_end.pos_bol in
+  if startline = endline then
+    fprintf ppf "l%d[%d-%d]" startline startchar endchar
+  else
+    fprintf ppf "l%d-%d[%d-%d]" startline endline startchar endchar
+
+type 'a context = 'a option ref * (Format.formatter -> 'a -> unit)
+
+let set_context (r,_pr) x = r := Some x
+let pp_context (r,pr) ppf = match !r with
+  | None -> ()
+  | Some x -> fprintf ppf "%a" pr x
+
+let with_context (r,_) x f =
+  let old = !r in
+  r:= Some x;
+  Fun.protect f ~finally:(fun () -> r := old)
+
+let global = ref None, pp_print_string
+let loc = ref None, compact_loc
+let context = [pp_context global; pp_context loc]
+let dash ppf () = fprintf ppf "-"
+
+let node_register = ref []
+let register_type (label,ty) =
+  node_register := (label,Node ty) :: !node_register
+
+let subgraph_register = ref []
+let default_style = Decoration.(make [filled lightgrey])
+let register_subgraph params ?(decoration=default_style) tys =
+  let node x = Decoration.none, Node x in
+  let subgraph = make params (List.map node tys) in
+  subgraph_register := (decoration, subgraph) :: !subgraph_register
+
+let forget () =
+  node_register := [];
+  subgraph_register := []
+
+let node x = Node x
+let edge x y = Edge(x,y)
+let hyperedge l = Hyperedge l
+
+let nodes ~title params ts =
+  incr file_counter;
+  let filename =
+    match !Clflags.dump_dir with
+    | None -> asprintf "%04d-%s.dot"  !file_counter title
+    | Some d ->
+        asprintf "%s%s%04d-%s-%a.dot"
+          d Filename.dir_sep
+          !file_counter
+          title
+          Pp.(list ~sep:dash (fun ppf pr -> pr ppf)) context
+  in
+  Out_channel.with_open_bin filename (fun ch ->
+      let ppf = Format.formatter_of_out_channel ch in
+      let ts = List.map (fun (l,t) -> l, t) ts in
+      let g = make params (ts @ !node_register) in
+      let g =
+        List.fold_left (fun g sub -> group_nodes sub g) g !subgraph_register
+      in
+      Pp.graph ppf g
+    )
+
+let types ~title params ts =
+  nodes ~title params (List.map (fun (lbl,ty) -> lbl, Node ty) ts)
+
+let make params elts = make params elts
+let add params elts = add params elts
+
+
+(** Debugging hooks *)
+let debug_on = ref (fun () -> false)
+let debug f = if !debug_on () then f ()
+
+let debug_off f =
+  let old = !debug_on in
+  debug_on := Fun.const false;
+  Fun.protect f
+    ~finally:(fun () -> debug_on := old)

diff --git a/typing/gprinttyp.mli b/typing/gprinttyp.mli
new file mode 100644 (file)
index 0000000..1feef0c
--- /dev/null
+++ b/typing/gprinttyp.mli
@@ -0,0 +1,325 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Florian Angeletti, projet Cambium, Inria Paris             *)
+(*                                                                        *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+(**
+ This module provides function for printing type expressions as digraph using
+    graphviz format. This is mostly aimed at providing a better representation
+    of type expressions during debugging session.
+*)
+(**
+A type node is printed as
+{[
+    .------------.
+    | <desc>  id |---->
+    |            |--->
+    .------------.
+]}
+where the description part might be:
+- a path: [list/8!]
+- a type variable: ['name], [α], [β], [γ]
+- [*] for tuples
+- [→] for arrows type
+- an universal type variable: [[β]∀], ['name ∀], ...
+- [[mod X with ...]] for a first class module
+
+- [∀] for a universal type binder
+
+The more complex encoding for polymorphic variants and object types uses nodes
+as head of the subgraph representing those types
+
+- [[obj...]] for the head of an object subgraph
+- [[Nil]] for the end of an object subgraph
+- [[Row...]] for the head of a polymorphic variant subgraph
+
+- [[Subst]] for a temporary substitution node
+
+Then each nodes is relied by arrows to any of its children types.
+
+- Type variables, universal type variables, [Nil], and [Subst] nodes don't have
+  children.
+
+- For tuples, the children types are the elements of the tuple. For instance,
+  [int * float] is represented as
+{[
+  .------.   0     .-------.
+  | *  1 |-------->| int! 2|
+  .------.         .-------.
+     |
+     | 1
+     v
+   .----------.
+   | float! 3 |
+   .----------.
+]}
+
+- For arrows, the children types are the type of the argument and the result
+  type. For instance, for [int -> float]:
+{[
+  .------.   0     .-------.
+  | →  4 |-------->| int! 2|
+  .------.         .-------.
+     |
+     | 1
+     v
+   .----------.
+   | float! 3 |
+   .----------.
+]}
+
+- For type constructor, like list the main children nodes are the argument
+  types. For instance, [(int,float) result] is represented as:
+
+{[
+  .-------------.   0     .-------.
+  | Result.t  5 |-------->| int! 2|
+  .-------------.         .-------.
+     |
+     | 1
+     v
+   .----------.
+   | float! 3 |
+   .----------.
+]}
+
+Moreover, type abbreviations might be linked to the expanded nodes.
+If I define: [type 'a pair = 'a * 'a], a type expression [int pair] might
+correspond to the nodes:
+
+{[
+  .--------.   0    .--------.
+  | pair 6 |------> | int! 2 |
+  .--------.        .--------.
+     ┆                  ^
+     ┆ expand           |
+     ┆                  |
+  .------.   0 + 1      |
+  | *  7 |------>-------.
+  .------.
+]}
+
+- Universal type binders have two kind of children: bound variables,
+  and the main body. For instance, ['a. 'a -> 'a] is represented as
+{[
+
+  .------.   bind    .-------.
+  |  ∀ 8 |----------> | 𝛼 10 |
+  .------.            .------.
+     |                  ^
+     |                  |
+     v                  |
+  .------.   0 + 1      |
+  | →  9 |------>-------.
+  .------.
+
+]}
+
+- [[Subst]] node are children are the type graph guarded by the
+  substitution node, and an eventual link to the parent row variable.
+
+- The children of first-class modules are the type expressions that may appear
+  in the right hand side of constraints.
+  For instance, [module M with type t = 'a and type u = 'b] is represented as
+{[
+  .----------------------.   0     .-----.
+  | [mod M with t, u] 11 |-------->| 𝛼 12|
+  .----------------------.         .-----
+     |
+     | 1
+     v
+   .------.
+   | 𝛽 13 |
+   .------.
+]}
+
+
+- The children of [obj] (resp. [row]) are the methods (resp. constructor) of the
+  object type (resp. polymorphic variant). Each method is then linked to its
+  type. To make them easier to read they are grouped inside graphviz cluster.
+  For instance, [<a:int; m:'self; ..> as 'self] will be represented as:
+
+{[
+
+  .----------------.
+  | .----------.    |
+  | | [obj] 14 |<------<-----<-----.
+  | .----------.    |              |
+  |       ┆         |              |
+  | .-------------. |    .------.  |    .-------.
+  | | a public 15 |----->| ∀ 18 |----->| int! 2 |
+  | .-------------. |    .------.  |    .-------.
+  |        ┆        |              |
+  | .-------------. |   .------.   |
+  | | m public 16 |-----| ∀ 19 |>--|
+  | .------------.  |   .------.
+  |     ┆           |
+  |     ┆ row var   |
+  |     ┆           |
+  |   .-------.     |
+  |   | '_ 17 |     |
+  |   .-------.     |
+  .-----------------.
+
+]}
+*)
+
+type digraph
+(** Digraph with nodes, edges, hyperedges and subgraphes *)
+
+type params
+(** Various possible choices on how to represent types, see the {!params}
+    functions for more detail.*)
+
+type element
+(** Graph element, see the {!node}, {!edge} and {!hyperedge} function *)
+
+type decoration
+(** Visual decoration on graph elements, see the {!Decoration} module.*)
+
+
+val types: title:string -> params -> (decoration * Types.type_expr) list -> unit
+(** Print a graph to the file
+    [asprintf "%s/%04d-%s-%a.dot"
+       dump_dir
+       session_unique_id
+       title
+       pp_context context
+    ]
+
+ If the [dump_dir] flag is not set, the local directory is used.
+ See the {!context} type on how and why to setup the context. *)
+
+(** Full version of {!types} that allow to print any kind of graph element *)
+val nodes: title:string -> params -> (decoration * element) list -> unit
+
+val params:
+  ?elide_links:bool ->
+  ?expansion_as_hyperedge:bool ->
+  ?short_ids:bool ->
+  ?colorize:bool ->
+  ?follow_expansions:bool ->
+  unit -> params
+(** Choice of details for printing type graphes:
+    - if [elide_links] is [true] link nodes are not displayed (default:[true])
+    - with [expansion_as_hyperedge], memoized constructor expansion are
+    displayed as a hyperedge between the node storing the memoized expansion,
+    the expanded node and the expansion (default:[false]).
+    - with [short_ids], we use an independent counter for node ids, in order to
+     have shorter ids for small digraphs (default:[true]).
+    - with [colorize] nodes are colorized according to their typechecker ids
+      (default:[true]).
+    - with [follow_expansions], we add memoized type constructor expansions to
+      the digraph (default:[true]).
+*)
+
+(** Update an existing [params] with new values. *)
+val update_params:
+  ?elide_links:bool ->
+  ?expansion_as_hyperedge:bool ->
+  ?short_ids:bool ->
+  ?colorize:bool ->
+  ?follow_expansions:bool ->
+  params -> params
+
+val node: Types.type_expr -> element
+val edge: Types.type_expr -> Types.type_expr -> element
+
+type dir = Toward | From
+val hyperedge: (dir * decoration * Types.type_expr) list -> element
+(** Edges between more than two elements. *)
+
+(** {1 Node and decoration types} *)
+module Decoration: sig
+  type color =
+    | Named of string
+    | HSL of {h:float;s:float;l:float}
+
+  val green: color
+  val blue: color
+  val red:color
+  val purple:color
+  val hsl: h:float -> s:float -> l:float -> color
+
+  type style =
+    | Filled of color option
+    | Dotted
+    | Dash
+
+  type shape =
+    | Ellipse
+    | Circle
+    | Diamond
+
+  type property =
+    | Color of color
+    | Font_color of color
+    | Style of style
+    | Label of string list
+    | Shape of shape
+  val filled: color -> property
+  val txt: string -> property
+  val make: property list -> decoration
+end
+
+(** {1 Digraph construction and printing}*)
+
+val make: params -> (decoration * element) list -> digraph
+val add: params -> (decoration * element) list -> digraph -> digraph
+
+(** add a subgraph to a digraph, only fresh nodes are added to the subgraph *)
+val add_subgraph:
+  params -> decoration -> (decoration * element) list -> digraph -> digraph
+
+(** groups existing nodes inside a subgraph *)
+val group_nodes: decoration * digraph -> digraph -> digraph
+
+val pp: Format.formatter -> digraph -> unit
+
+
+(** {1 Debugging helper functions } *)
+
+(** {2 Generic print debugging function} *)
+
+(** Conditional graph printing *)
+val debug_on: (unit -> bool) ref
+
+(** [debug_off f] switches off debugging before running [f]. *)
+val debug_off: (unit -> 'a) -> 'a
+
+(** [debug f] runs [f] when [!debug_on ()]*)
+val debug: (unit -> unit) -> unit
+
+(** {2 Node tracking functions }*)
+
+(** [register_type (lbl,ty)] adds the type [t] to all graph printed until
+    {!forget} is called *)
+val register_type: decoration * Types.type_expr -> unit
+
+(** [register_subgraph params tys] groups together all types reachable from
+    [tys] at this point in printed digraphs, until {!forget} is called *)
+val register_subgraph:
+  params -> ?decoration:decoration -> Types.type_expr list -> unit
+
+(** Forget all recorded context types *)
+val forget : unit -> unit
+
+(** {2 Contextual information}
+
+  Those functions can be used to modify the filename of the generated digraphs.
+  Use those functions to provide contextual information on a graph emitted
+  during an execution trace.*)
+type 'a context
+val global: string context
+val loc: Warnings.loc context
+val set_context: 'a context -> 'a -> unit
+val with_context: 'a context -> 'a -> (unit -> 'b) -> 'b

diff --git a/typing/ident.ml b/typing/ident.ml
index 287c0ac86d3095bbc8265db1b77e75614b723644..9a736abed4dd2f06634748335af360d7f4625a74 100644 (file)
--- a/typing/ident.ml
+++ b/typing/ident.ml
@@ -16,7 +16,8 @@
 open Local_store
 
 let lowest_scope  = 0
-let highest_scope = 100000000
+let highest_scope = 100_000_000
+  (* assumed to fit in 27 bits, see Types.scope_field *)
 
 type t =
   | Local of { name: string; stamp: int }
@@ -111,6 +112,9 @@ let stamp = function
   | Scoped { stamp; _ } -> stamp
   | _ -> 0
 
+let compare_stamp id1 id2 =
+  compare (stamp id1) (stamp id2)
+
 let scope = function
   | Scoped { scope; _ } -> scope
   | Local _ -> highest_scope
@@ -134,24 +138,24 @@ let is_predef = function
   | _ -> false
 
 let print ~with_scope ppf =
-  let open Format in
+  let open Format_doc in
   function
   | Global name -> fprintf ppf "%s!" name
   | Predef { name; stamp = n } ->
       fprintf ppf "%s%s!" name
-        (if !Clflags.unique_ids then sprintf "/%i" n else "")
+        (if !Clflags.unique_ids then asprintf "/%i" n else "")
   | Local { name; stamp = n } ->
       fprintf ppf "%s%s" name
-        (if !Clflags.unique_ids then sprintf "/%i" n else "")
+        (if !Clflags.unique_ids then asprintf "/%i" n else "")
   | Scoped { name; stamp = n; scope } ->
       fprintf ppf "%s%s%s" name
-        (if !Clflags.unique_ids then sprintf "/%i" n else "")
-        (if with_scope then sprintf "[%i]" scope else "")
+        (if !Clflags.unique_ids then asprintf "/%i" n else "")
+        (if with_scope then asprintf "[%i]" scope else "")
 
 let print_with_scope ppf id = print ~with_scope:true ppf id
 
-let print ppf id = print ~with_scope:false ppf id
-
+let doc_print ppf id = print ~with_scope:false ppf id
+let print ppf id = Format_doc.compat doc_print ppf id
 (* For the documentation of ['a Ident.tbl], see ident.mli.
 
    The implementation is a copy-paste specialization of

diff --git a/typing/ident.mli b/typing/ident.mli
index 4132b1fbef836a7369a85a0e8d717f3d667715dd..588123242da7a0359c7846e8504f6a7ce099704a 100644 (file)
--- a/typing/ident.mli
+++ b/typing/ident.mli
@@ -24,7 +24,8 @@ include Identifiable.S with type t := t
    - [compare] compares identifiers by binding location
 *)
 
-val print_with_scope : Format.formatter -> t -> unit
+val doc_print: t Format_doc.printer
+val print_with_scope : t Format_doc.printer
         (** Same as {!print} except that it will also add a "[n]" suffix
             if the scope of the argument is [n]. *)
 
@@ -50,7 +51,11 @@ val same: t -> t -> bool
             [create_*], or if they are both persistent and have the same
             name. *)
 
+val compare_stamp: t -> t -> int
+        (** Compare only the internal stamps, 0 if absent *)
+
 val compare: t -> t -> int
+        (** Compare identifiers structurally, including the name *)
 
 val global: t -> bool
 val is_predef: t -> bool

diff --git a/typing/includeclass.ml b/typing/includeclass.ml
index 39f00f9cf54a6d121b0aa4e902280829505214b2..5c560c156b7ccfd1208a7838bafb1f2f6339564a 100644 (file)
--- a/typing/includeclass.ml
+++ b/typing/includeclass.ml
@@ -40,8 +40,9 @@ let class_declarations env cty1 cty2 =
         cty1.cty_params cty1.cty_type
         cty2.cty_params cty2.cty_type
 
-open Format
+open Format_doc
 open Ctype
+module Printtyp=Printtyp.Doc
 
 (*
 let rec hide_params = function
@@ -50,6 +51,7 @@ let rec hide_params = function
 *)
 
 let include_err mode ppf =
+  let msg fmt = Format_doc.Doc.msg fmt in
   function
   | CM_Virtual_class ->
       fprintf ppf "A class cannot be changed from virtual to concrete"
@@ -57,12 +59,10 @@ let include_err mode ppf =
       fprintf ppf
         "The classes do not have the same number of type parameters"
   | CM_Type_parameter_mismatch (n, env, err) ->
-      Printtyp.report_equality_error ppf mode env err
-        (function ppf ->
-           fprintf ppf "The %d%s type parameter has type"
+     Errortrace_report.equality ppf mode env err
+        (msg "The %d%s type parameter has type"
              n (Misc.ordinal_suffix n))
-        (function ppf ->
-           fprintf ppf "but is expected to have type")
+        (msg "but is expected to have type")
   | CM_Class_type_mismatch (env, cty1, cty2) ->
       Printtyp.wrap_printing_env ~error:true env (fun () ->
         fprintf ppf
@@ -71,24 +71,18 @@ let include_err mode ppf =
           "is not matched by the class type"
           Printtyp.class_type cty2)
   | CM_Parameter_mismatch (n, env, err) ->
-      Printtyp.report_moregen_error ppf mode env err
-        (function ppf ->
-           fprintf ppf "The %d%s parameter has type"
+      Errortrace_report.moregen ppf mode env err
+        (msg "The %d%s parameter has type"
              n (Misc.ordinal_suffix n))
-        (function ppf ->
-          fprintf ppf "but is expected to have type")
+        (msg "but is expected to have type")
   | CM_Val_type_mismatch (lab, env, err) ->
-      Printtyp.report_comparison_error ppf mode env err
-        (function ppf ->
-          fprintf ppf "The instance variable %s@ has type" lab)
-        (function ppf ->
-          fprintf ppf "but is expected to have type")
+      Errortrace_report.comparison ppf mode env err
+        (msg "The instance variable %s@ has type" lab)
+        (msg "but is expected to have type")
   | CM_Meth_type_mismatch (lab, env, err) ->
-      Printtyp.report_comparison_error ppf mode env err
-        (function ppf ->
-          fprintf ppf "The method %s@ has type" lab)
-        (function ppf ->
-          fprintf ppf "but is expected to have type")
+      Errortrace_report.comparison ppf mode env err
+        (msg "The method %s@ has type" lab)
+        (msg "but is expected to have type")
   | CM_Non_mutable_value lab ->
       fprintf ppf
        "@[The non-mutable instance variable %s cannot become mutable@]" lab
@@ -110,9 +104,11 @@ let include_err mode ppf =
   | CM_Private_method lab ->
       fprintf ppf "@[The private method %s cannot become public@]" lab
 
-let report_error mode ppf = function
+let report_error_doc mode ppf = function
   |  [] -> ()
   | err :: errs ->
       let print_errs ppf errs =
         List.iter (fun err -> fprintf ppf "@ %a" (include_err mode) err) errs in
       fprintf ppf "@[<v>%a%a@]" (include_err mode) err print_errs errs
+
+let report_error = Format_doc.compat1 report_error_doc

diff --git a/typing/includeclass.mli b/typing/includeclass.mli
index 84de6212c4a9cec417cd694c200c9ea15b2fedfc..a4d4d8588225879b69cafe800faf53998cc4f08d 100644 (file)
--- a/typing/includeclass.mli
+++ b/typing/includeclass.mli
@@ -17,7 +17,6 @@
 
 open Types
 open Ctype
-open Format
 
 val class_types:
         Env.t -> class_type -> class_type -> class_match_failure list
@@ -30,4 +29,6 @@ val class_declarations:
   class_match_failure list
 
 val report_error :
-  Printtyp.type_or_scheme -> formatter -> class_match_failure list -> unit
+  Out_type.type_or_scheme -> class_match_failure list Format_doc.format_printer
+val report_error_doc :
+  Out_type.type_or_scheme -> class_match_failure list Format_doc.printer

diff --git a/typing/includecore.ml b/typing/includecore.ml
index 595c07e935c3b417fbfd740dc38339a5015d0015..e23315f1ee601c4be4e203f753ae38e4a0eeff78 100644 (file)
--- a/typing/includecore.ml
+++ b/typing/includecore.ml
@@ -70,6 +70,26 @@ type value_mismatch =
 
 exception Dont_match of value_mismatch
 
+(* A value description [vd1] is consistent with the value description [vd2] if
+   there is a context E such that [E |- vd1 <: vd2] for the ordinary subtyping.
+   For values, this is the case as soon as the kind of [vd1] is a subkind of the
+   [vd2] kind. *)
+let value_descriptions_consistency env vd1 vd2 =
+  match (vd1.val_kind, vd2.val_kind) with
+  | (Val_prim p1, Val_prim p2) -> begin
+      match primitive_descriptions p1 p2 with
+      | None -> Tcoerce_none
+      | Some err -> raise (Dont_match (Primitive_mismatch err))
+    end
+  | (Val_prim p, _) ->
+      let pc =
+        { pc_desc = p; pc_type = vd2.Types.val_type;
+          pc_env = env; pc_loc = vd1.Types.val_loc; }
+      in
+      Tcoerce_primitive pc
+  | (_, Val_prim _) -> raise (Dont_match Not_a_primitive)
+  | (_, _) -> Tcoerce_none
+
 let value_descriptions ~loc env name
     (vd1 : Types.value_description)
     (vd2 : Types.value_description) =
@@ -81,22 +101,7 @@ let value_descriptions ~loc env name
     name;
   match Ctype.moregeneral env true vd1.val_type vd2.val_type with
   | exception Ctype.Moregen err -> raise (Dont_match (Type err))
-  | () -> begin
-      match (vd1.val_kind, vd2.val_kind) with
-      | (Val_prim p1, Val_prim p2) -> begin
-          match primitive_descriptions p1 p2 with
-          | None -> Tcoerce_none
-          | Some err -> raise (Dont_match (Primitive_mismatch err))
-        end
-      | (Val_prim p, _) ->
-          let pc =
-            { pc_desc = p; pc_type = vd2.Types.val_type;
-              pc_env = env; pc_loc = vd1.Types.val_loc; }
-          in
-          Tcoerce_primitive pc
-      | (_, Val_prim _) -> raise (Dont_match Not_a_primitive)
-      | (_, _) -> Tcoerce_none
-    end
+  | () -> value_descriptions_consistency env vd1 vd2
 
 (* Inclusion between manifest types (particularly for private row types) *)
 
@@ -203,9 +208,11 @@ type type_mismatch =
   | Immediate of Type_immediacy.Violation.t
 
 module Style = Misc.Style
+module Fmt = Format_doc
+module Printtyp = Printtyp.Doc
 
 let report_primitive_mismatch first second ppf err =
-  let pr fmt = Format.fprintf ppf fmt in
+  let pr fmt = Fmt.fprintf ppf fmt in
   match (err : primitive_mismatch) with
   | Name ->
       pr "The names of the primitives are not the same"
@@ -226,7 +233,7 @@ let report_primitive_mismatch first second ppf err =
         n (Misc.ordinal_suffix n)
 
 let report_value_mismatch first second env ppf err =
-  let pr fmt = Format.fprintf ppf fmt in
+  let pr fmt = Fmt.fprintf ppf fmt in
   pr "@ ";
   match (err : value_mismatch) with
   | Primitive_mismatch pm ->
@@ -234,14 +241,16 @@ let report_value_mismatch first second env ppf err =
   | Not_a_primitive ->
       pr "The implementation is not a primitive."
   | Type trace ->
-      Printtyp.report_moregen_error ppf Type_scheme env trace
-        (fun ppf -> Format.fprintf ppf "The type")
-        (fun ppf -> Format.fprintf ppf "is not compatible with the type")
+      let msg = Fmt.Doc.msg in
+      Errortrace_report.moregen ppf Type_scheme env trace
+        (msg "The type")
+        (msg "is not compatible with the type")
 
 let report_type_inequality env ppf err =
-  Printtyp.report_equality_error ppf Type_scheme env err
-    (fun ppf -> Format.fprintf ppf "The type")
-    (fun ppf -> Format.fprintf ppf "is not equal to the type")
+  let msg = Fmt.Doc.msg in
+  Errortrace_report.equality ppf Type_scheme env err
+    (msg "The type")
+    (msg "is not equal to the type")
 
 let report_privacy_mismatch ppf err =
   let singular, item =
@@ -251,7 +260,7 @@ let report_privacy_mismatch ppf err =
     | Private_record_type        -> true,  "record constructor"
     | Private_extensible_variant -> true,  "extensible variant"
     | Private_row_type           -> true,  "row type"
-  in Format.fprintf ppf "%s %s would be revealed."
+  in Format_doc.fprintf ppf "%s %s would be revealed."
        (if singular then "A private" else "Private")
        item
 
@@ -260,20 +269,20 @@ let report_label_mismatch first second env ppf err =
   | Type err ->
       report_type_inequality env ppf err
   | Mutability ord ->
-      Format.fprintf ppf "%s is mutable and %s is not."
+      Format_doc.fprintf ppf "%s is mutable and %s is not."
         (String.capitalize_ascii (choose ord first second))
         (choose_other ord first second)
 
 let pp_record_diff first second prefix decl env ppf (x : record_change) =
   match x with
   | Delete cd ->
-      Format.fprintf ppf "%aAn extra field, %a, is provided in %s %s."
+      Fmt.fprintf ppf "%aAn extra field, %a, is provided in %s %s."
         prefix x Style.inline_code (Ident.name cd.delete.ld_id) first decl
   | Insert cd ->
-      Format.fprintf  ppf "%aA field, %a, is missing in %s %s."
+      Fmt.fprintf  ppf "%aA field, %a, is missing in %s %s."
         prefix x Style.inline_code (Ident.name cd.insert.ld_id) first decl
   | Change Type {got=lbl1; expected=lbl2; reason} ->
-      Format.fprintf ppf
+      Fmt.fprintf ppf
         "@[<hv>%aFields do not match:@;<1 2>\
          %a@ is not the same as:\
          @;<1 2>%a@ %a@]"
@@ -282,34 +291,34 @@ let pp_record_diff first second prefix decl env ppf (x : record_change) =
         (Style.as_inline_code Printtyp.label) lbl2
         (report_label_mismatch first second env) reason
   | Change Name n ->
-      Format.fprintf ppf "%aFields have different names, %a and %a."
+      Fmt.fprintf ppf "%aFields have different names, %a and %a."
         prefix x
         Style.inline_code n.got
         Style.inline_code n.expected
   | Swap sw ->
-      Format.fprintf ppf "%aFields %a and %a have been swapped."
+      Fmt.fprintf ppf "%aFields %a and %a have been swapped."
         prefix x
         Style.inline_code sw.first
         Style.inline_code sw.last
   | Move {name; got; expected } ->
-      Format.fprintf ppf
+      Fmt.fprintf ppf
         "@[<2>%aField %a has been moved@ from@ position %d@ to %d.@]"
         prefix x Style.inline_code name expected got
 
 let report_patch pr_diff first second decl env ppf patch =
-  let nl ppf () = Format.fprintf ppf "@," in
+  let nl ppf () = Fmt.fprintf ppf "@," in
   let no_prefix _ppf _ = () in
   match patch with
   | [ elt ] ->
-      Format.fprintf ppf "@[<hv>%a@]"
+      Fmt.fprintf ppf "@[<hv>%a@]"
         (pr_diff first second no_prefix decl env) elt
   | _ ->
       let pp_diff = pr_diff first second Diffing_with_keys.prefix decl env in
-      Format.fprintf ppf "@[<hv>%a@]"
-        (Format.pp_print_list ~pp_sep:nl pp_diff) patch
+      Fmt.fprintf ppf "@[<hv>%a@]"
+        (Fmt.pp_print_list ~pp_sep:nl pp_diff) patch
 
 let report_record_mismatch first second decl env ppf err =
-  let pr fmt = Format.fprintf ppf fmt in
+  let pr fmt = Fmt.fprintf ppf fmt in
   match err with
   | Label_mismatch patch ->
       report_patch pp_record_diff first second decl env ppf patch
@@ -319,7 +328,7 @@ let report_record_mismatch first second decl env ppf err =
         "uses unboxed float representation"
 
 let report_constructor_mismatch first second decl env ppf err =
-  let pr fmt  = Format.fprintf ppf fmt in
+  let pr fmt  = Fmt.fprintf ppf fmt in
   match (err : constructor_mismatch) with
   | Type err -> report_type_inequality env ppf err
   | Arity -> pr "They have different arities."
@@ -337,13 +346,13 @@ let report_constructor_mismatch first second decl env ppf err =
 let pp_variant_diff first second prefix decl env ppf (x : variant_change) =
   match x with
   | Delete cd ->
-      Format.fprintf ppf  "%aAn extra constructor, %a, is provided in %s %s."
+      Fmt.fprintf ppf  "%aAn extra constructor, %a, is provided in %s %s."
         prefix x Style.inline_code (Ident.name cd.delete.cd_id) first decl
   | Insert cd ->
-      Format.fprintf ppf "%aA constructor, %a, is missing in %s %s."
+      Fmt.fprintf ppf "%aA constructor, %a, is missing in %s %s."
         prefix x Style.inline_code (Ident.name cd.insert.cd_id) first decl
   | Change Type {got; expected; reason} ->
-      Format.fprintf ppf
+      Fmt.fprintf ppf
         "@[<hv>%aConstructors do not match:@;<1 2>\
          %a@ is not the same as:\
          @;<1 2>%a@ %a@]"
@@ -352,24 +361,24 @@ let pp_variant_diff first second prefix decl env ppf (x : variant_change) =
         (Style.as_inline_code Printtyp.constructor) expected
         (report_constructor_mismatch first second decl env) reason
   | Change Name n ->
-      Format.fprintf ppf
+      Fmt.fprintf ppf
         "%aConstructors have different names, %a and %a."
         prefix x
         Style.inline_code n.got
         Style.inline_code n.expected
   | Swap sw ->
-      Format.fprintf ppf
+      Fmt.fprintf ppf
         "%aConstructors %a and %a have been swapped."
         prefix x
         Style.inline_code sw.first
         Style.inline_code sw.last
   | Move {name; got; expected} ->
-      Format.fprintf ppf
+      Fmt.fprintf ppf
         "@[<2>%aConstructor %a has been moved@ from@ position %d@ to %d.@]"
         prefix x Style.inline_code name expected got
 
 let report_extension_constructor_mismatch first second decl env ppf err =
-  let pr fmt = Format.fprintf ppf fmt in
+  let pr fmt = Fmt.fprintf ppf fmt in
   match (err : extension_constructor_mismatch) with
   | Constructor_privacy ->
       pr "Private extension constructor(s) would be revealed."
@@ -385,8 +394,8 @@ let report_extension_constructor_mismatch first second decl env ppf err =
 
 
 let report_private_variant_mismatch first second decl env ppf err =
-  let pr fmt = Format.fprintf ppf fmt in
-  let pp_tag ppf x = Format.fprintf ppf "`%s" x in
+  let pr fmt = Fmt.fprintf ppf fmt in
+  let pp_tag ppf x = Fmt.fprintf ppf "`%s" x in
   match (err : private_variant_mismatch) with
   | Only_outer_closed ->
       (* It's only dangerous in one direction, so we don't have a position *)
@@ -403,14 +412,14 @@ let report_private_variant_mismatch first second decl env ppf err =
       report_type_inequality env ppf err
 
 let report_private_object_mismatch env ppf err =
-  let pr fmt = Format.fprintf ppf fmt in
+  let pr fmt = Fmt.fprintf ppf fmt in
   match (err : private_object_mismatch) with
   | Missing s ->
       pr "The implementation is missing the method %a" Style.inline_code s
   | Types err -> report_type_inequality env ppf err
 
 let report_kind_mismatch first second ppf (kind1, kind2) =
-  let pr fmt = Format.fprintf ppf fmt in
+  let pr fmt = Fmt.fprintf ppf fmt in
   let kind_to_string = function
   | Kind_abstract -> "abstract"
   | Kind_record -> "a record"
@@ -423,7 +432,7 @@ let report_kind_mismatch first second ppf (kind1, kind2) =
     (kind_to_string kind2)
 
 let report_type_mismatch first second decl env ppf err =
-  let pr fmt = Format.fprintf ppf fmt in
+  let pr fmt = Fmt.fprintf ppf fmt in
   pr "@ ";
   match err with
   | Arity ->
@@ -543,14 +552,37 @@ module Record_diffing = struct
       | None -> Ok ()
 
   let weight: Diff.change -> _ = function
-    | Insert _ -> 10
-    | Delete _ -> 10
+    | Insert _ | Delete _ ->
+     (* Insertion and deletion are symmetrical for definitions *)
+        100
     | Keep _ -> 0
-    | Change (_,_,Diffing_with_keys.Name t ) ->
-        if t.types_match then 10 else 15
-    | Change _ -> 10
-
-
+     (* [Keep] must have the smallest weight. *)
+    | Change (_,_,c) ->
+        (* Constraints:
+           - [ Change < Insert + Delete ], otherwise [Change] are never optimal
+
+           - [ Swap < Move ] => [ 2 Change < Insert + Delete ] =>
+             [ Change < Delete ], in order to favour consecutive [Swap]s
+             over [Move]s.
+
+           - For some D and a large enough R,
+                 [Delete^D Keep^R Insert^D < Change^(D+R)]
+              => [ Change > (2 D)/(D+R) Delete ].
+             Note that the case [D=1,R=1] is incompatible with the inequation
+             above. If we choose [R = D + 1] for [D<5], we can specialize the
+             inequation to [ Change > 10 / 11 Delete ]. *)
+      match c with
+        (* With [Type<Name with type<Name], we pick constructor with the right
+           name over the one with the right type. *)
+        | Diffing_with_keys.Name t ->
+            if t.types_match then 98 else 99
+        | Diffing_with_keys.Type _ -> 50
+         (* With the uniqueness constraint on keys, the only relevant constraint
+            is [Type-only change < Name change]. Indeed, names can only match at
+            one position. In other words, if a [ Type ] patch is admissible, the
+            only admissible patches at this position are of the form [Delete^D
+            Name_change]. And with the constranit [Type_change < Name_change],
+            we have [Type_change Delete^D < Delete^D Name_change]. *)
 
   let key (x: Defs.left) = Ident.name x.ld_id
   let diffing loc env params1 params2 cstrs_1 cstrs_2 =
@@ -662,13 +694,12 @@ module Variant_diffing = struct
   let update _ st = st
 
   let weight: D.change -> _ = function
-    | Insert _ -> 10
-    | Delete _ -> 10
+    | Insert _ | Delete _ -> 100
     | Keep _ -> 0
-    | Change (_,_,Diffing_with_keys.Name t) ->
-        if t.types_match then 10 else 15
-    | Change _ -> 10
-
+    | Change (_,_,Diffing_with_keys.Name c) ->
+        if c.types_match then 98 else 99
+    | Change (_,_,Diffing_with_keys.Type _) -> 50
+    (** See {!Variant_diffing.weight} for an explanation *)
 
   let test loc env (params1,params2)
       ({pos; data=cd1}: D.left)
@@ -890,6 +921,17 @@ let type_manifest env ty1 params1 ty2 params2 priv2 kind2 =
       | () -> None
     end
 
+(* A type declarations [td1] is consistent with the type declaration [td2] if
+   there is a context E such E |- td1 <: td2 for the ordinary subtyping. For
+   types, this is the case as soon as the two type declarations share the same
+   arity and the privacy of [td1] is less than the privacy of [td2] (consider a
+   context E where all type constructors are equal). *)
+let type_declarations_consistency env decl1 decl2 =
+  if decl1.type_arity <> decl2.type_arity then Some Arity
+  else match privacy_mismatch env decl1 decl2 with
+    | Some err -> Some (Privacy err)
+    | None -> None
+
 let type_declarations ?(equality = false) ~loc env ~mark name
       decl1 path decl2 =
   Builtin_attributes.check_alerts_inclusion
@@ -898,12 +940,7 @@ let type_declarations ?(equality = false) ~loc env ~mark name
     loc
     decl1.type_attributes decl2.type_attributes
     name;
-  if decl1.type_arity <> decl2.type_arity then Some Arity else
-  let err =
-    match privacy_mismatch env decl1 decl2 with
-    | Some err -> Some (Privacy err)
-    | None -> None
-  in
+  let err = type_declarations_consistency env decl1 decl2 in
   if err <> None then err else
   let err = match (decl1.type_manifest, decl2.type_manifest) with
       (_, None) ->

diff --git a/typing/includecore.mli b/typing/includecore.mli
index 50825976ceddd96df1ed471b565a785fc4fa032b..bed53fb03675da6a694472976ef5f68fcaa0e256 100644 (file)
--- a/typing/includecore.mli
+++ b/typing/includecore.mli
@@ -118,6 +118,21 @@ val extension_constructors:
   loc:Location.t -> Env.t -> mark:bool -> Ident.t ->
   extension_constructor -> extension_constructor ->
   extension_constructor_mismatch option
+
+(** The functions [value_descriptions_consistency] and
+    [type_declarations_consistency] check if two declaration are consistent.
+    Declarations are consistent when there exists an environment such that the
+    first declaration is a subtype of the second one.
+
+    Notably, if a type declaration [td1] is consistent with [td2] then a type
+    expression [te] which is well-formed with the [td2] declaration in scope
+    is still well-formed with the [td1] declaration: [E, td2 |- te] => [E, td1
+    |- te]. *)
+val value_descriptions_consistency:
+  Env.t -> value_description -> value_description -> module_coercion
+val type_declarations_consistency:
+  Env.t -> type_declaration -> type_declaration -> type_mismatch option
+
 (*
 val class_types:
         Env.t -> class_type -> class_type -> bool
@@ -126,14 +141,14 @@ val class_types:
 val report_value_mismatch :
   string -> string ->
   Env.t ->
-  Format.formatter -> value_mismatch -> unit
+  value_mismatch Format_doc.printer
 
 val report_type_mismatch :
   string -> string -> string ->
   Env.t ->
-  Format.formatter -> type_mismatch -> unit
+  type_mismatch Format_doc.printer
 
 val report_extension_constructor_mismatch :
   string -> string -> string ->
   Env.t ->
-  Format.formatter -> extension_constructor_mismatch -> unit
+  extension_constructor_mismatch Format_doc.printer

diff --git a/typing/includemod.ml b/typing/includemod.ml
index c806691483cf0d67c3fd3b8096294364f609d3f0..dda0464c3a207240551cecf5d506fed171aeedcc 100644 (file)
--- a/typing/includemod.ml
+++ b/typing/includemod.ml
@@ -134,78 +134,146 @@ module Error = struct
 
 end
 
-type mark =
+module Directionality = struct
+
+
+  type mark =
   | Mark_both
   | Mark_positive
-  | Mark_negative
   | Mark_neither
 
-let negate_mark = function
-  | Mark_both -> Mark_both
-  | Mark_positive -> Mark_negative
-  | Mark_negative -> Mark_positive
-  | Mark_neither -> Mark_neither
-
-let mark_positive = function
-  | Mark_both | Mark_positive -> true
-  | Mark_negative | Mark_neither -> false
-
-(* All functions "blah env x1 x2" check that x1 is included in x2,
-   i.e. that x1 is the type of an implementation that fulfills the
-   specification x2. If not, Error is raised with a backtrace of the error. *)
-
-(* Inclusion between value descriptions *)
-
-let value_descriptions ~loc env ~mark subst id vd1 vd2 =
-  Cmt_format.record_value_dependency vd1 vd2;
-  if mark_positive mark then
-    Env.mark_value_used vd1.val_uid;
-  let vd2 = Subst.value_description subst vd2 in
-  try
-    Ok (Includecore.value_descriptions ~loc env (Ident.name id) vd1 vd2)
-  with Includecore.Dont_match err ->
-    Error Error.(Core (Value_descriptions (diff vd1 vd2 err)))
-
-(* Inclusion between type declarations *)
-
-let type_declarations ~loc env ~mark ?old_env:_ subst id decl1 decl2 =
-  let mark = mark_positive mark in
-  if mark then
-    Env.mark_type_used decl1.type_uid;
-  let decl2 = Subst.type_declaration subst decl2 in
-  match
-    Includecore.type_declarations ~loc env ~mark
-      (Ident.name id) decl1 (Path.Pident id) decl2
-  with
-  | None -> Ok Tcoerce_none
-  | Some err ->
-      Error Error.(Core(Type_declarations (diff decl1 decl2 err)))
-
-(* Inclusion between extension constructors *)
-
-let extension_constructors ~loc env ~mark  subst id ext1 ext2 =
-  let mark = mark_positive mark in
-  let ext2 = Subst.extension_constructor subst ext2 in
-  match Includecore.extension_constructors ~loc env ~mark id ext1 ext2 with
-  | None -> Ok Tcoerce_none
-  | Some err ->
-      Error Error.(Core(Extension_constructors(diff ext1 ext2 err)))
-
-(* Inclusion between class declarations *)
-
-let class_type_declarations ~loc ~old_env:_ env  subst decl1 decl2 =
-  let decl2 = Subst.cltype_declaration subst decl2 in
-  match Includeclass.class_type_declarations ~loc env decl1 decl2 with
-    []     -> Ok Tcoerce_none
-  | reason ->
-      Error Error.(Core(Class_type_declarations(diff decl1 decl2 reason)))
-
-let class_declarations ~old_env:_ env  subst decl1 decl2 =
-  let decl2 = Subst.class_declaration subst decl2 in
-  match Includeclass.class_declarations env decl1 decl2 with
-    []     -> Ok Tcoerce_none
-  | reason ->
-     Error Error.(Core(Class_declarations(diff decl1 decl2 reason)))
+  type pos =
+    | Strictly_positive
+      (** Strictly positive positions are notable for tools since they are the
+          the case where we match a implementation definition with an interface
+          declaration. Oherwise in the positive case we are matching
+          declatations inside functor arguments at even level of nesting.*)
+    | Positive
+    | Negative
+
+
+(**
+   When checking inclusion, the [Directionality.t] type tracks the
+   subtyping direction at the syntactic level.
+
+   The [posivity] field is used in the [cmt_declaration_dependencies] to
+   distinguish between directed and undirected edges, and to avoid recording
+   matched declarations twice.
+
+   The [mark_as_used] field describes if we should record only positive use,
+   any use (because there is no clear implementation side), or none (because we
+   are inside an auxiliary check function.)
+
+   The [in_eq] field is [true] when we are checking both directions inside of
+   module types which allows optimizing module type equality checks. The module
+   subtyping relation [A <: B] checks that [A.T = B.T] when [A] and [B] define a
+   module type [T]. The relation [A.T = B.T] is equivalent to [(A.T <: B.T) and
+   (B.T <: A.T)], but checking both recursively would lead to an exponential
+   slowdown (see #10598 and #10616). To avoid this issue, when [in_eq] is
+   [true], we compute a coarser relation [A << B] which is the same as [A <: B]
+   except that module types [T] are checked only for [A.T << B.T] and not the
+   reverse. Thus, we can implement a cheap module type equality check [A.T =
+   B.T] by computing [(A.T << B.T) and (B.T << A.T)], avoiding the exponential
+   slowdown described above.
+*)
+  type t = {
+      in_eq:bool;
+      mark_as_used:mark;
+      pos:pos;
+    }
+
+  let strictly_positive ~mark =
+    let mark_as_used = if mark then Mark_positive else Mark_neither in
+    { in_eq=false; pos=Strictly_positive; mark_as_used }
+
+  let unknown ~mark =
+    let mark_as_used = if mark then Mark_both else Mark_neither in
+    { in_eq=false; pos=Positive; mark_as_used }
+
+  let negate_pos = function
+    | Positive | Strictly_positive -> Negative
+    | Negative -> Positive
+
+  let negate d = { d with pos = negate_pos d.pos }
+
+  let at_most_positive = function
+    | Strictly_positive -> Positive
+    | Positive | Negative as non_strict -> non_strict
+
+  let enter_eq d =
+    {
+      in_eq = true;
+      pos = at_most_positive d.pos;
+      mark_as_used = d.mark_as_used
+    }
+
+  let mark_as_used d = match d.mark_as_used with
+    | Mark_neither -> false
+    | Mark_both -> true
+    | Mark_positive ->
+       match d.pos with
+       | Positive | Strictly_positive -> true
+       | Negative -> false
+
+end
+
+module Core_inclusion = struct
+  (* All functions "blah env x1 x2" check that x1 is included in x2,
+     i.e. that x1 is the type of an implementation that fulfills the
+     specification x2. If not, Error is raised with a backtrace of the error. *)
+
+  (* Inclusion between value descriptions *)
+
+  let value_descriptions ~loc env ~direction subst id vd1 vd2 =
+    if Directionality.mark_as_used direction then
+      Env.mark_value_used vd1.val_uid;
+    let vd2 = Subst.value_description subst vd2 in
+    try
+      Ok (Includecore.value_descriptions ~loc env (Ident.name id) vd1 vd2)
+    with Includecore.Dont_match err ->
+      Error Error.(Core (Value_descriptions (diff vd1 vd2 err)))
+
+  (* Inclusion between type declarations *)
+
+  let type_declarations ~loc env ~direction subst id decl1 decl2 =
+    let mark = Directionality.mark_as_used direction in
+    if mark then
+      Env.mark_type_used decl1.type_uid;
+    let decl2 = Subst.type_declaration subst decl2 in
+    match
+      Includecore.type_declarations ~loc env ~mark
+        (Ident.name id) decl1 (Path.Pident id) decl2
+    with
+    | None -> Ok Tcoerce_none
+    | Some err ->
+        Error Error.(Core(Type_declarations (diff decl1 decl2 err)))
+
+  (* Inclusion between extension constructors *)
+
+  let extension_constructors ~loc env ~direction subst id ext1 ext2 =
+    let mark = Directionality.mark_as_used direction in
+    let ext2 = Subst.extension_constructor subst ext2 in
+    match Includecore.extension_constructors ~loc env ~mark id ext1 ext2 with
+    | None -> Ok Tcoerce_none
+    | Some err ->
+        Error Error.(Core(Extension_constructors(diff ext1 ext2 err)))
+
+  (* Inclusion between class declarations *)
+
+  let class_type_declarations ~loc env ~direction:_ subst _id decl1 decl2 =
+    let decl2 = Subst.cltype_declaration subst decl2 in
+    match Includeclass.class_type_declarations ~loc env decl1 decl2 with
+      []     -> Ok Tcoerce_none
+    | reason ->
+        Error Error.(Core(Class_type_declarations(diff decl1 decl2 reason)))
+
+  let class_declarations ~loc:_ env ~direction:_ subst _id decl1 decl2 =
+    let decl2 = Subst.class_declaration subst decl2 in
+    match Includeclass.class_declarations env decl1 decl2 with
+      []     -> Ok Tcoerce_none
+    | reason ->
+        Error Error.(Core(Class_declarations(diff decl1 decl2 reason)))
+end
 
 (* Expand a module type identifier when possible *)
 
@@ -308,7 +376,7 @@ let rec print_coercion ppf c =
         print_coercion out
   | Tcoerce_primitive {pc_desc; pc_env = _; pc_type}  ->
       pr "prim %s@ (%a)" pc_desc.Primitive.prim_name
-        Printtyp.raw_type_expr pc_type
+        Rawprinttyp.type_expr pc_type
   | Tcoerce_alias (_, p, c) ->
       pr "@[<2>alias %a@ (%a)@]"
         Printtyp.path p
@@ -406,30 +474,33 @@ module Sign_diff = struct
     }
 end
 
-(**
-   In the group of mutual functions below, the [~in_eq] argument is [true] when
-   we are in fact checking equality of module types.
-
-   The module subtyping relation [A <: B] checks that [A.T = B.T] when [A]
-   and [B] define a module type [T]. The relation [A.T = B.T] is equivalent
-   to [(A.T <: B.T) and (B.T <: A.T)], but checking both recursively would lead
-   to an exponential slowdown (see #10598 and #10616).
-   To avoid this issue, when [~in_eq] is [true], we compute a coarser relation
-   [A << B] which is the same as [A <: B] except that module types [T] are
-   checked only for [A.T << B.T] and not the reverse.
-   Thus, we can implement a cheap module type equality check [A.T = B.T] by
-   computing [(A.T << B.T) and (B.T << A.T)], avoiding the exponential slowdown
-   described above.
-*)
+(** Core type system subtyping-like relation that we want to lift at the module
+    level. We have two relations that we want to lift:
 
-let rec modtypes ~in_eq ~loc env ~mark subst mty1 mty2 shape =
-  match try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 shape with
+  - the normal subtyping relation [<:].
+  - the coarse-grain consistency relation [C], which is defined by
+   [d1 C d2] if there is an environment [E] such that [E |- d1 <: d2]. *)
+type 'a core_incl =
+  loc:Location.t -> Env.t -> direction:Directionality.t -> Subst.t -> Ident.t ->
+  'a -> 'a -> (module_coercion, Error.sigitem_symptom) result
+
+type core_relation = {
+  value_descriptions: Types.value_description core_incl;
+  type_declarations: Types.type_declaration core_incl;
+  extension_constructors: Types.extension_constructor core_incl;
+  class_declarations: Types.class_declaration core_incl;
+  class_type_declarations: Types.class_type_declaration core_incl;
+}
+
+
+let rec modtypes ~core ~direction ~loc env subst mty1 mty2 shape =
+  match try_modtypes ~core ~direction ~loc env subst mty1 mty2 shape with
   | Ok _ as ok -> ok
   | Error reason ->
     let mty2 = Subst.modtype Make_local subst mty2 in
     Error Error.(diff mty1 mty2 reason)
 
-and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
+and try_modtypes ~core ~direction ~loc env subst mty1 mty2 orig_shape =
   match mty1, mty2 with
   | (Mty_alias p1, Mty_alias p2) ->
       if Env.is_functor_arg p2 env then
@@ -447,8 +518,8 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
           begin match expand_module_alias ~strengthen:false env p1 with
           | Error e -> Error (Error.Mt_core e)
           | Ok mty1 ->
-              match strengthened_modtypes ~in_eq ~loc ~aliasable:true env ~mark
-                      subst mty1 p1 mty2 orig_shape
+              match strengthened_modtypes ~core ~direction ~loc ~aliasable:true
+                      env subst mty1 p1 mty2 orig_shape
               with
               | Ok _ as x -> x
               | Error reason -> Error (Error.After_alias_expansion reason)
@@ -461,20 +532,21 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
       else
         begin match expand_modtype_path env p1, expand_modtype_path env p2 with
         | Some mty1, Some mty2 ->
-            try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape
+            try_modtypes ~core ~direction ~loc env subst mty1 mty2 orig_shape
         | None, _  | _, None -> Error (Error.Mt_core Abstract_module_type)
         end
   | (Mty_ident p1, _) ->
       let p1 = Env.normalize_modtype_path env p1 in
       begin match expand_modtype_path env p1 with
       | Some p1 ->
-          try_modtypes ~in_eq ~loc env ~mark subst p1 mty2 orig_shape
+          try_modtypes ~core ~direction ~loc env subst p1 mty2 orig_shape
       | None -> Error (Error.Mt_core Abstract_module_type)
       end
   | (_, Mty_ident p2) ->
       let p2 = Env.normalize_modtype_path env (Subst.modtype_path subst p2) in
       begin match expand_modtype_path env p2 with
-      | Some p2 -> try_modtypes ~in_eq ~loc env ~mark subst mty1 p2 orig_shape
+      | Some p2 ->
+          try_modtypes ~core ~direction ~loc env subst mty1 p2 orig_shape
       | None ->
           begin match mty1 with
           | Mty_functor _ ->
@@ -486,14 +558,15 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
       end
   | (Mty_signature sig1, Mty_signature sig2) ->
       begin match
-        signatures ~in_eq ~loc env ~mark subst sig1 sig2 orig_shape
+        signatures ~core ~direction ~loc env subst sig1 sig2 orig_shape
       with
       | Ok _ as ok -> ok
       | Error e -> Error (Error.Signature e)
       end
   | Mty_functor (param1, res1), Mty_functor (param2, res2) ->
       let cc_arg, env, subst =
-        functor_param ~in_eq ~loc env ~mark:(negate_mark mark)
+        let direction = Directionality.negate direction in
+        functor_param ~core ~direction ~loc env
           subst param1 param2
       in
       let var, res_shape =
@@ -501,16 +574,18 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
         | Some (var, res_shape) -> var, res_shape
         | None ->
             (* Using a fresh variable with a placeholder uid here is fine: users
-               will never try to jump to the definition of that variable.
-               If they try to jump to the parameter from inside the functor,
-               they will use the variable shape that is stored in the local
-               environment.  *)
+               will never try to jump to the definition of that variable. If
+               they try to jump to the parameter from inside the functor, they
+               will use the variable shape that is stored in the local
+               environment. *)
             let var, shape_var =
               Shape.fresh_var Uid.internal_not_actually_unique
             in
             var, Shape.app orig_shape ~arg:shape_var
       in
-      let cc_res = modtypes ~in_eq ~loc env ~mark subst res1 res2 res_shape in
+      let cc_res =
+        modtypes ~core ~direction ~loc env subst res1 res2 res_shape
+      in
       begin match cc_arg, cc_res with
       | Ok Tcoerce_none, Ok (Tcoerce_none, final_res_shape) ->
           let final_shape =
@@ -552,7 +627,7 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
 
 (* Functor parameters *)
 
-and functor_param ~in_eq ~loc env ~mark subst param1 param2 =
+and functor_param ~core ~direction ~loc env subst param1 param2 =
   match param1, param2 with
   | Unit, Unit ->
       Ok Tcoerce_none, env, subst
@@ -560,7 +635,7 @@ and functor_param ~in_eq ~loc env ~mark subst param1 param2 =
       let arg2' = Subst.modtype Keep subst arg2 in
       let cc_arg =
         match
-          modtypes ~in_eq ~loc env ~mark Subst.identity arg2' arg1
+          modtypes ~core ~direction ~loc env Subst.identity arg2' arg1
                 Shape.dummy_mod
         with
         | Ok (cc, _) -> Ok cc
@@ -588,27 +663,27 @@ and equate_one_functor_param subst env arg2' name1 name2  =
   | None, None ->
       env, subst
 
-and strengthened_modtypes ~in_eq ~loc ~aliasable env ~mark
+and strengthened_modtypes ~core ~direction ~loc ~aliasable env
     subst mty1 path1 mty2 shape =
   match mty1, mty2 with
   | Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
       Ok (Tcoerce_none, shape)
   | _, _ ->
       let mty1 = Mtype.strengthen ~aliasable env mty1 path1 in
-      modtypes ~in_eq ~loc env ~mark subst mty1 mty2 shape
+      modtypes ~core ~direction ~loc env subst mty1 mty2 shape
 
-and strengthened_module_decl ~loc ~aliasable env ~mark
+and strengthened_module_decl ~core ~loc ~aliasable ~direction env
     subst md1 path1 md2 shape =
   match md1.md_type, md2.md_type with
   | Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
       Ok (Tcoerce_none, shape)
   | _, _ ->
       let md1 = Mtype.strengthen_decl ~aliasable env md1 path1 in
-      modtypes ~in_eq:false ~loc env ~mark subst md1.md_type md2.md_type shape
+      modtypes ~core ~direction ~loc env subst md1.md_type md2.md_type shape
 
 (* Inclusion between signatures *)
 
-and signatures  ~in_eq ~loc env ~mark subst sig1 sig2 mod_shape =
+and signatures ~core ~direction ~loc env subst sig1 sig2 mod_shape =
   (* Environment used to check inclusion of components *)
   let new_env =
     Env.add_signature sig1 (Env.in_signature true env) in
@@ -653,12 +728,12 @@ and signatures  ~in_eq ~loc env ~mark subst sig1 sig2 mod_shape =
      Return a coercion list indicating, for all run-time components
      of sig2, the position of the matching run-time components of sig1
      and the coercion to be applied to it. *)
-  let rec pair_components subst paired unpaired = function
+  let rec pair_components ~core subst paired unpaired = function
       [] ->
         let open Sign_diff in
         let d =
-          signature_components ~in_eq ~loc env ~mark new_env subst mod_shape
-            Shape.Map.empty
+          signature_components ~core ~direction ~loc env new_env subst
+            mod_shape Shape.Map.empty
             (List.rev paired)
         in
         begin match unpaired, d.errors, d.runtime_coercions, d.leftovers with
@@ -702,36 +777,37 @@ and signatures  ~in_eq ~loc env ~mark subst sig1 sig2 mod_shape =
             | Sig_module _ ->
                 Subst.add_module id2 (Path.Pident id1) subst
             | Sig_modtype _ ->
-                Subst.add_modtype id2 (Mty_ident (Path.Pident id1)) subst
+                Subst.add_modtype id2 (Path.Pident id1) subst
             | Sig_value _ | Sig_typext _
             | Sig_class _ | Sig_class_type _ ->
                 subst
           in
-          pair_components new_subst
+          pair_components ~core new_subst
             ((item1, item2, pos1) :: paired) unpaired rem
         | exception Not_found ->
           let unpaired =
             if report then
               item2 :: unpaired
             else unpaired in
-          pair_components subst paired unpaired rem
+          pair_components ~core subst paired unpaired rem
         end in
   (* Do the pairing and checking, and return the final coercion *)
-  pair_components subst [] [] sig2
+  pair_components ~core subst [] [] sig2
 
 (* Inclusion between signature components *)
 
-and signature_components  ~in_eq ~loc old_env ~mark env subst
+and signature_components ~core ~direction ~loc old_env env subst
     orig_shape shape_map paired =
   match paired with
   | [] -> Sign_diff.{ empty with shape_map }
   | (sigi1, sigi2, pos) :: rem ->
       let shape_modified = ref false in
-      let id, item, shape_map, present_at_runtime =
+      let id, item, paired_uids, shape_map, present_at_runtime =
         match sigi1, sigi2 with
         | Sig_value(id1, valdecl1, _) ,Sig_value(_id2, valdecl2, _) ->
             let item =
-              value_descriptions ~loc env ~mark subst id1 valdecl1 valdecl2
+              core.value_descriptions ~loc ~direction env subst id1
+                valdecl1 valdecl2
             in
             let item = mark_error_as_recoverable item in
             let present_at_runtime = match valdecl2.val_kind with
@@ -739,33 +815,35 @@ and signature_components  ~in_eq ~loc old_env ~mark env subst
               | _ -> true
             in
             let shape_map = Shape.Map.add_value_proj shape_map id1 orig_shape in
-            id1, item, shape_map, present_at_runtime
+            let paired_uids = (valdecl1.val_uid, valdecl2.val_uid) in
+            id1, item, paired_uids, shape_map, present_at_runtime
         | Sig_type(id1, tydec1, _, _), Sig_type(_id2, tydec2, _, _) ->
             let item =
-              type_declarations ~loc ~old_env env ~mark subst id1 tydec1 tydec2
+              core.type_declarations ~loc ~direction env subst id1 tydec1 tydec2
             in
             let item = mark_error_as_unrecoverable item in
             (* Right now we don't filter hidden constructors / labels from the
             shape. *)
             let shape_map = Shape.Map.add_type_proj shape_map id1 orig_shape in
-            id1, item, shape_map, false
+            id1, item, (tydec1.type_uid, tydec2.type_uid), shape_map, false
         | Sig_typext(id1, ext1, _, _), Sig_typext(_id2, ext2, _, _) ->
             let item =
-              extension_constructors ~loc env ~mark  subst id1 ext1 ext2
+              core.extension_constructors ~loc ~direction env subst id1
+                ext1 ext2
             in
             let item = mark_error_as_unrecoverable item in
             let shape_map =
               Shape.Map.add_extcons_proj shape_map id1 orig_shape
             in
-            id1, item, shape_map, true
+            id1, item, (ext1.ext_uid, ext2.ext_uid), shape_map, true
         | Sig_module(id1, pres1, mty1, _, _), Sig_module(_, pres2, mty2, _, _)
           -> begin
               let orig_shape =
                 Shape.(proj orig_shape (Item.module_ id1))
               in
               let item =
-                module_declarations ~in_eq ~loc env ~mark subst id1 mty1 mty2
-                  orig_shape
+                module_declarations ~core ~direction ~loc env subst id1
+                  mty1 mty2 orig_shape
               in
               let item, shape_map =
                 match item with
@@ -789,35 +867,37 @@ and signature_components  ~in_eq ~loc old_env ~mark env subst
                 | Mp_absent, Mp_present, _ -> assert false
               in
               let item = mark_error_as_unrecoverable item in
-              id1, item, shape_map, present_at_runtime
+              let paired_uids = (mty1.md_uid, mty2.md_uid) in
+              id1, item, paired_uids, shape_map, present_at_runtime
             end
         | Sig_modtype(id1, info1, _), Sig_modtype(_id2, info2, _) ->
             let item =
-              modtype_infos ~in_eq ~loc env ~mark  subst id1 info1 info2
+              modtype_infos ~core ~direction ~loc env  subst id1 info1 info2
             in
             let shape_map =
               Shape.Map.add_module_type_proj shape_map id1 orig_shape
             in
             let item = mark_error_as_unrecoverable item in
-            id1, item, shape_map, false
+            id1, item, (info1.mtd_uid, info2.mtd_uid), shape_map, false
         | Sig_class(id1, decl1, _, _), Sig_class(_id2, decl2, _, _) ->
             let item =
-              class_declarations ~old_env env subst decl1 decl2
+              core.class_declarations ~loc ~direction env subst id1 decl1 decl2
             in
             let shape_map =
               Shape.Map.add_class_proj shape_map id1 orig_shape
             in
             let item = mark_error_as_unrecoverable item in
-            id1, item, shape_map, true
+            id1, item, (decl1.cty_uid, decl2.cty_uid), shape_map, true
         | Sig_class_type(id1, info1, _, _), Sig_class_type(_id2, info2, _, _) ->
             let item =
-              class_type_declarations ~loc ~old_env env subst info1 info2
+              core.class_type_declarations ~loc ~direction env subst id1
+                info1 info2
             in
             let item = mark_error_as_unrecoverable item in
             let shape_map =
               Shape.Map.add_class_type_proj shape_map id1 orig_shape
             in
-            id1, item, shape_map, false
+            id1, item, (info1.clty_uid, info2.clty_uid), shape_map, false
         | _ ->
             assert false
       in
@@ -825,6 +905,25 @@ and signature_components  ~in_eq ~loc old_env ~mark env subst
       let first =
         match item with
         | Ok x ->
+            begin match direction with
+            | { Directionality.in_eq = true; pos = Negative }
+            | { Directionality.mark_as_used = Mark_neither; _ } ->
+              (* We do not store paired uids when checking for reverse
+                module-type inclusion as it would introduce duplicates. *)
+                ()
+            | { Directionality.pos; _} ->
+              let paired_uids =
+                let elt1, elt2 = paired_uids in
+                match pos with
+                | Negative ->
+                    (Cmt_format.Declaration_to_declaration, elt2, elt1)
+                | Positive ->
+                    (Cmt_format.Declaration_to_declaration, elt1, elt2)
+                | Strictly_positive ->
+                    (Cmt_format. Definition_to_declaration, elt1, elt2)
+              in
+              Cmt_format.record_declaration_dependency paired_uids
+            end;
             let runtime_coercions =
               if present_at_runtime then [pos,x] else []
             in
@@ -838,13 +937,13 @@ and signature_components  ~in_eq ~loc old_env ~mark env subst
       in
       let rest =
         if continue then
-          signature_components ~in_eq ~loc old_env ~mark env subst
+          signature_components ~core ~direction ~loc old_env env subst
             orig_shape shape_map rem
         else Sign_diff.{ empty with leftovers=rem }
        in
        Sign_diff.merge first rest
 
-and module_declarations  ~in_eq ~loc env ~mark  subst id1 md1 md2 orig_shape =
+and module_declarations ~direction ~loc env  subst id1 md1 md2 orig_shape =
   Builtin_attributes.check_alerts_inclusion
     ~def:md1.md_loc
     ~use:md2.md_loc
@@ -852,14 +951,14 @@ and module_declarations  ~in_eq ~loc env ~mark  subst id1 md1 md2 orig_shape =
     md1.md_attributes md2.md_attributes
     (Ident.name id1);
   let p1 = Path.Pident id1 in
-  if mark_positive mark then
+  if Directionality.mark_as_used direction then
     Env.mark_module_used md1.md_uid;
-  strengthened_modtypes  ~in_eq ~loc ~aliasable:true env ~mark subst
+  strengthened_modtypes ~direction ~loc ~aliasable:true env subst
     md1.md_type p1 md2.md_type orig_shape
 
 (* Inclusion between module type specifications *)
 
-and modtype_infos ~in_eq ~loc env ~mark subst id info1 info2 =
+and modtype_infos ~core ~direction ~loc env subst id info1 info2 =
   Builtin_attributes.check_alerts_inclusion
     ~def:info1.mtd_loc
     ~use:info2.mtd_loc
@@ -872,28 +971,30 @@ and modtype_infos ~in_eq ~loc env ~mark subst id info1 info2 =
       (None, None) -> Ok Tcoerce_none
     | (Some _, None) -> Ok Tcoerce_none
     | (Some mty1, Some mty2) ->
-        check_modtype_equiv ~in_eq ~loc env ~mark mty1 mty2
+        check_modtype_equiv ~core ~direction ~loc env mty1 mty2
     | (None, Some mty2) ->
         let mty1 = Mty_ident(Path.Pident id) in
-        check_modtype_equiv ~in_eq ~loc env ~mark mty1 mty2 in
+        check_modtype_equiv ~core ~direction ~loc env mty1 mty2 in
   match r with
   | Ok _ as ok -> ok
   | Error e -> Error Error.(Module_type_declaration (diff info1 info2 e))
 
-and check_modtype_equiv ~in_eq ~loc env ~mark mty1 mty2 =
+and check_modtype_equiv ~core ~direction ~loc env mty1 mty2 =
+  let nested_eq = direction.Directionality.in_eq in
+  let direction = Directionality.enter_eq direction in
   let c1 =
-    modtypes ~in_eq:true ~loc env ~mark Subst.identity mty1 mty2 Shape.dummy_mod
+    modtypes ~core ~direction ~loc env Subst.identity mty1 mty2 Shape.dummy_mod
   in
   let c2 =
     (* For nested module type paths, we check only one side of the equivalence:
        the outer module type is the one responsible for checking the other side
        of the equivalence.
      *)
-    if in_eq then None
+    if nested_eq then None
     else
-      let mark = negate_mark mark in
+      let direction = Directionality.negate direction in
       Some (
-        modtypes ~in_eq:true ~loc env ~mark Subst.identity
+        modtypes ~core ~direction ~loc env Subst.identity
           mty2 mty1 Shape.dummy_mod
       )
   in
@@ -919,7 +1020,34 @@ let can_alias env path =
   in
   no_apply path && not (Env.is_functor_arg path env)
 
-
+let core_inclusion = Core_inclusion.{
+  type_declarations;
+  value_descriptions;
+  extension_constructors;
+  class_type_declarations;
+  class_declarations;
+}
+
+let core_consistency =
+  let type_declarations ~loc:_ env ~direction:_ _ _ d1 d2 =
+    match Includecore.type_declarations_consistency env d1 d2 with
+    | None -> Ok Tcoerce_none
+    | Some err ->  Error Error.(Core(Type_declarations (diff d1 d2 err)))
+  in
+  let value_descriptions ~loc:_ env ~direction:_ _ _ vd1 vd2 =
+    match Includecore.value_descriptions_consistency env vd1 vd2 with
+    | x -> Ok x
+    | exception Includecore.Dont_match err ->
+        Error Error.(Core (Value_descriptions (diff vd1 vd2 err)))
+  in
+  let accept ~loc:_ _env ~direction:_ _subst _id _d1 _d2 = Ok Tcoerce_none in
+  {
+    type_declarations;
+    value_descriptions;
+    class_declarations=accept;
+    class_type_declarations=accept;
+    extension_constructors=accept;
+  }
 
 type explanation = Env.t * Error.all
 exception Error of explanation
@@ -938,7 +1066,8 @@ exception Apply_error of {
 
 let check_modtype_inclusion_raw ~loc env mty1 path1 mty2 =
   let aliasable = can_alias env path1 in
-  strengthened_modtypes ~in_eq:false ~loc ~aliasable env ~mark:Mark_both
+  let direction = Directionality.unknown ~mark:true in
+  strengthened_modtypes ~core:core_inclusion ~direction ~loc ~aliasable env
     Subst.identity mty1 path1 mty2 Shape.dummy_mod
   |> Result.map fst
 
@@ -974,9 +1103,11 @@ let () =
    interface. *)
 
 let compunit env ~mark impl_name impl_sig intf_name intf_sig unit_shape =
+  let loc = Location.in_file impl_name in
+  let direction = Directionality.strictly_positive ~mark in
   match
-    signatures ~in_eq:false ~loc:(Location.in_file impl_name) env ~mark
-      Subst.identity impl_sig intf_sig unit_shape
+    signatures ~core:core_inclusion ~direction ~loc env Subst.identity
+      impl_sig intf_sig unit_shape
   with Result.Error reasons ->
     let cdiff =
       Error.In_Compilation_unit(Error.diff impl_name intf_name reasons) in
@@ -1079,7 +1210,8 @@ module Functor_inclusion_diff = struct
         let test st mty1 mty2 =
           let loc = Location.none in
           let res, _, _ =
-            functor_param ~in_eq:false ~loc st.env ~mark:Mark_neither
+            let direction=Directionality.unknown ~mark:false in
+            functor_param ~core:core_inclusion ~direction ~loc st.env
               st.subst mty1 mty2
           in
           res
@@ -1173,9 +1305,12 @@ module Functor_app_diff = struct
             | Unit, Named _ | (Anonymous | Named _), Unit ->
                 Result.Error (Error.Incompatible_params(arg,param))
             | ( Anonymous | Named _ | Empty_struct ), Named (_, param) ->
+               let direction=Directionality.unknown ~mark:false in
                 match
-                  modtypes ~in_eq:false ~loc state.env ~mark:Mark_neither
-                    state.subst arg_mty param Shape.dummy_mod
+                  modtypes
+                    ~core:core_inclusion ~direction ~loc
+                    state.env state.subst arg_mty param
+                    Shape.dummy_mod
                 with
                 | Error mty -> Result.Error (Error.Mismatch mty)
                 | Ok (cc, _) -> Ok cc
@@ -1196,36 +1331,64 @@ end
 (* Hide the context and substitution parameters to the outside world *)
 
 let modtypes_with_shape ~shape ~loc env ~mark mty1 mty2 =
-  match modtypes ~in_eq:false ~loc env ~mark
-          Subst.identity mty1 mty2 shape
+  (* modtypes with shape is used when typing module expressions in [Typemod] *)
+  let direction = Directionality.strictly_positive ~mark in
+  match
+    modtypes ~core:core_inclusion ~direction ~loc env Subst.identity
+      mty1 mty2 shape
   with
   | Ok (cc, shape) -> cc, shape
   | Error reason -> raise (Error (env, Error.(In_Module_type reason)))
 
+let modtypes_consistency ~loc env mty1 mty2 =
+  let direction = Directionality.unknown ~mark:false in
+  match
+    modtypes ~core:core_consistency ~direction ~loc env Subst.identity
+      mty1 mty2 Shape.dummy_mod
+  with
+  | Ok _ -> ()
+  | Error reason -> raise (Error (env, Error.(In_Module_type reason)))
+
 let modtypes ~loc env ~mark mty1 mty2 =
-  match modtypes ~in_eq:false ~loc env ~mark
-          Subst.identity mty1 mty2 Shape.dummy_mod
+  let direction = Directionality.unknown ~mark in
+  match
+    modtypes ~core:core_inclusion ~direction ~loc env Subst.identity
+      mty1 mty2 Shape.dummy_mod
   with
   | Ok (cc, _) -> cc
   | Error reason -> raise (Error (env, Error.(In_Module_type reason)))
 
-let signatures env ~mark sig1 sig2 =
-  match signatures ~in_eq:false ~loc:Location.none env ~mark
-          Subst.identity sig1 sig2 Shape.dummy_mod
+let gen_signatures env ~direction sig1 sig2 =
+  match
+    signatures
+      ~core:core_inclusion ~direction ~loc:Location.none env
+      Subst.identity sig1 sig2 Shape.dummy_mod
   with
   | Ok (cc, _) -> cc
   | Error reason -> raise (Error(env,Error.(In_Signature reason)))
 
+let signatures env ~mark sig1 sig2 =
+  let direction = Directionality.unknown ~mark in
+  gen_signatures env ~direction sig1 sig2
+
+let check_implementation env impl intf =
+  let direction = Directionality.strictly_positive ~mark:true in
+  ignore (gen_signatures env ~direction impl intf)
+
 let type_declarations ~loc env ~mark id decl1 decl2 =
-  match type_declarations ~loc env ~mark Subst.identity id decl1 decl2 with
+  let direction = Directionality.unknown ~mark in
+  match Core_inclusion.type_declarations ~loc env ~direction
+          Subst.identity id decl1 decl2
+  with
   | Ok _ -> ()
   | Error (Error.Core reason) ->
       raise (Error(env,Error.(In_Type_declaration(id,reason))))
   | Error _ -> assert false
 
 let strengthened_module_decl ~loc ~aliasable env ~mark md1 path1 md2 =
-  match strengthened_module_decl ~loc ~aliasable env ~mark Subst.identity
-    md1 path1 md2 Shape.dummy_mod with
+  let direction = Directionality.unknown ~mark in
+  match strengthened_module_decl ~core:core_inclusion ~loc ~aliasable ~direction
+          env Subst.identity md1 path1 md2 Shape.dummy_mod with
   | Ok (x, _shape) -> x
   | Error mdiff ->
       raise (Error(env,Error.(In_Module_type mdiff)))
@@ -1237,7 +1400,10 @@ let expand_module_alias ~strengthen env path =
       raise (Error(env,In_Expansion(Error.Unbound_module_path path)))
 
 let check_modtype_equiv ~loc env id mty1 mty2 =
-  match check_modtype_equiv ~in_eq:false ~loc env ~mark:Mark_both mty1 mty2 with
+  let direction = Directionality.unknown ~mark:true in
+  match
+    check_modtype_equiv ~core:core_inclusion ~loc ~direction env mty1 mty2
+  with
   | Ok _ -> ()
   | Error e ->
       raise (Error(env,

diff --git a/typing/includemod.mli b/typing/includemod.mli
index a57d51b67cda2cc0265fbde3b287b26610ef5ee0..fa749601fff90c07e04354ad49567700a0520473 100644 (file)
--- a/typing/includemod.mli
+++ b/typing/includemod.mli
@@ -18,18 +18,6 @@
 open Typedtree
 open Types
 
-(** Type describing which arguments of an inclusion to consider as used
-    for the usage warnings. [Mark_both] is the default. *)
-type mark =
-  | Mark_both
-      (** Mark definitions used from both arguments *)
-  | Mark_positive
-      (** Mark definitions used from the positive (first) argument *)
-  | Mark_negative
-      (** Mark definitions used from the negative (second) argument *)
-  | Mark_neither
-      (** Do not mark definitions used from either argument *)
-
 module Error: sig
 
   type ('elt,'explanation) diff = {
@@ -152,15 +140,18 @@ val is_runtime_component: Types.signature_item -> bool
 (* Typechecking *)
 
 val modtypes:
-  loc:Location.t -> Env.t -> mark:mark ->
+  loc:Location.t -> Env.t -> mark:bool ->
   module_type -> module_type -> module_coercion
 
+val modtypes_consistency:
+  loc:Location.t -> Env.t -> module_type -> module_type -> unit
+
 val modtypes_with_shape:
-  shape:Shape.t -> loc:Location.t -> Env.t -> mark:mark ->
+  shape:Shape.t -> loc:Location.t -> Env.t -> mark:bool ->
   module_type -> module_type -> module_coercion * Shape.t
 
 val strengthened_module_decl:
-  loc:Location.t -> aliasable:bool -> Env.t -> mark:mark ->
+  loc:Location.t -> aliasable:bool -> Env.t -> mark:bool ->
   module_declaration -> Path.t -> module_declaration -> module_coercion
 
 val check_modtype_inclusion :
@@ -173,15 +164,17 @@ val check_modtype_inclusion :
 val check_modtype_equiv:
   loc:Location.t -> Env.t -> Ident.t -> module_type -> module_type -> unit
 
-val signatures: Env.t -> mark:mark ->
-  signature -> signature -> module_coercion
+val signatures: Env.t -> mark:bool -> signature -> signature -> module_coercion
+
+(** Check an implementation against an interface *)
+val check_implementation: Env.t -> signature -> signature -> unit
 
 val compunit:
-      Env.t -> mark:mark -> string -> signature ->
+      Env.t -> mark:bool -> string -> signature ->
       string -> signature -> Shape.t -> module_coercion * Shape.t
 
 val type_declarations:
-  loc:Location.t -> Env.t -> mark:mark ->
+  loc:Location.t -> Env.t -> mark:bool ->
   Ident.t -> type_declaration -> type_declaration -> unit
 
 val print_coercion: Format.formatter -> module_coercion -> unit

diff --git a/typing/includemod_errorprinter.ml b/typing/includemod_errorprinter.ml
index ab348c1e3b38259cd694c3dd93f6d7308dfa8892..fd74a073a227df7fb3efef001845d2f8bd30e2d6 100644 (file)
--- a/typing/includemod_errorprinter.ml
+++ b/typing/includemod_errorprinter.ml
@@ -14,6 +14,8 @@
 (**************************************************************************)
 
 module Style = Misc.Style
+module Fmt = Format_doc
+module Printtyp = Printtyp.Doc
 
 module Context = struct
   type pos =
@@ -34,28 +36,28 @@ module Context = struct
 
   let rec context ppf = function
       Module id :: rem ->
-        Format.fprintf ppf "@[<2>module %a%a@]" Printtyp.ident id args rem
+        Fmt.fprintf ppf "@[<2>module %a%a@]" Printtyp.ident id args rem
     | Modtype id :: rem ->
-        Format.fprintf ppf "@[<2>module type %a =@ %a@]"
+        Fmt.fprintf ppf "@[<2>module type %a =@ %a@]"
           Printtyp.ident id context_mty rem
     | Body x :: rem ->
-        Format.fprintf ppf "functor (%s) ->@ %a" (argname x) context_mty rem
+        Fmt.fprintf ppf "(%s) ->@ %a" (argname x) context_mty rem
     | Arg x :: rem ->
-        Format.fprintf ppf "functor (%s : %a) -> ..."
+        Fmt.fprintf ppf "(%s : %a) -> ..."
           (argname x) context_mty rem
     | [] ->
-        Format.fprintf ppf "<here>"
+        Fmt.fprintf ppf "<here>"
   and context_mty ppf = function
       (Module _ | Modtype _) :: _ as rem ->
-        Format.fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
+        Fmt.fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
     | cxt -> context ppf cxt
   and args ppf = function
       Body x :: rem ->
-        Format.fprintf ppf "(%s)%a" (argname x) args rem
+        Fmt.fprintf ppf "(%s)%a" (argname x) args rem
     | Arg x :: rem ->
-        Format.fprintf ppf "(%s :@ %a) : ..." (argname  x) context_mty rem
+        Fmt.fprintf ppf "(%s :@ %a) : ..." (argname  x) context_mty rem
     | cxt ->
-        Format.fprintf ppf " :@ %a" context_mty cxt
+        Fmt.fprintf ppf " :@ %a" context_mty cxt
   and argname = function
     | Types.Unit -> ""
     | Types.Named (None, _) -> "_"
@@ -64,25 +66,24 @@ module Context = struct
   let alt_pp ppf cxt =
     if cxt = [] then () else
     if List.for_all (function Module _ -> true | _ -> false) cxt then
-      Format.fprintf ppf "in module %a,"
+      Fmt.fprintf ppf ",@ in module %a"
         (Style.as_inline_code Printtyp.path) (path_of_context cxt)
     else
-      Format.fprintf ppf "@[<hv 2>at position@ %a,@]"
+      Fmt.fprintf ppf ",@ @[<hv 2>at position@ %a@]"
         (Style.as_inline_code context) cxt
 
   let pp ppf cxt =
     if cxt = [] then () else
     if List.for_all (function Module _ -> true | _ -> false) cxt then
-      Format.fprintf ppf "In module %a:@ "
+      Fmt.fprintf ppf "In module %a:@ "
         (Style.as_inline_code Printtyp.path) (path_of_context cxt)
     else
-      Format.fprintf ppf "@[<hv 2>At position@ %a@]@ "
+      Fmt.fprintf ppf "@[<hv 2>At position@ %a@]@ "
         (Style.as_inline_code context) cxt
 end
 
-module Illegal_permutation = struct
-  (** Extraction of information in case of illegal permutation
-      in a module type *)
+module Runtime_coercion = struct
+  (** Extraction of a small change from a non-identity runtime coercion *)
 
   (** When examining coercions, we only have runtime component indices,
       we use thus a limited version of {!pos}. *)
@@ -95,43 +96,50 @@ module Illegal_permutation = struct
     | None -> g y
     | Some _ as v -> v
 
-  (** We extract a lone transposition from a full tree of permutations. *)
-  let rec transposition_under path (coerc:Typedtree.module_coercion) =
+  type change =
+    | Transposition of int * int
+    | Primitive_coercion of string
+    | Alias_coercion of Path.t
+
+  (** We extract a small change from a full coercion. *)
+  let rec first_change_under path (coerc:Typedtree.module_coercion) =
     match coerc with
     | Tcoerce_structure(c,_) ->
         either
-          (not_fixpoint path 0) c
+          (first_item_transposition path 0) c
           (first_non_id path 0) c
     | Tcoerce_functor(arg,res) ->
         either
-          (transposition_under (InArg::path)) arg
-          (transposition_under (InBody::path)) res
+          (first_change_under (InArg::path)) arg
+          (first_change_under (InBody::path)) res
     | Tcoerce_none -> None
-    | Tcoerce_alias _ | Tcoerce_primitive _ ->
-        (* these coercions are not inversible, and raise an error earlier when
-           checking for module type equivalence *)
-        assert false
+    | Tcoerce_alias _ | Tcoerce_primitive _ -> None
+
   (* we search the first point which is not invariant at the current level *)
-  and not_fixpoint path pos = function
+  and first_item_transposition path pos = function
     | [] -> None
     | (n, _) :: q ->
-        if n = pos then
-          not_fixpoint path (pos+1) q
+        if n < 0 || n = pos then
+          (* when n < 0, this is not a transposition but a kind coercion,
+            which will be covered in the first_non_id case *)
+          first_item_transposition path (pos+1) q
         else
-          Some(List.rev path, pos, n)
+          Some(List.rev path, Transposition (pos, n))
   (* we search the first item with a non-identity inner coercion *)
   and first_non_id path pos = function
     | [] -> None
     | (_, Typedtree.Tcoerce_none) :: q -> first_non_id path (pos + 1) q
+    | (_, Typedtree.Tcoerce_alias (_,p,_)) :: _ ->
+        Some (List.rev path, Alias_coercion p)
+    | (_, Typedtree.Tcoerce_primitive p) :: _ ->
+        let name = Primitive.byte_name p.pc_desc in
+        Some (List.rev path, Primitive_coercion name)
     | (_,c) :: q ->
         either
-          (transposition_under (Item pos :: path)) c
+          (first_change_under (Item pos :: path)) c
           (first_non_id path (pos + 1)) q
 
-  let transposition c =
-    match transposition_under [] c with
-    | None -> raise Not_found
-    | Some x -> x
+  let first_change c = first_change_under [] c
 
   let rec runtime_item k = function
     | [] -> raise Not_found
@@ -168,23 +176,64 @@ module Illegal_permutation = struct
   let item mt k = Includemod.item_ident_name (runtime_item k mt)
 
   let pp_item ppf (id,_,kind) =
-    Format.fprintf ppf "%s %a"
+    Fmt.fprintf ppf "%s %a"
       (Includemod.kind_of_field_desc kind)
       Style.inline_code (Ident.name id)
 
-  let pp ctx_printer env ppf (mty,c) =
+  let illegal_permutation ctx_printer env ppf (mty,c) =
+    match first_change c with
+    | None | Some (_, (Primitive_coercion _ | Alias_coercion _)) ->
+        (* those kind coercions are not inversible, and raise an error earlier
+           when checking for module type equivalence *)
+        assert false
+    | Some (path, Transposition (k,l)) ->
     try
-      let p, k, l = transposition c in
-      let ctx, mt = find env p mty in
-      Format.fprintf ppf
+      let ctx, mt = find env path mty in
+      Fmt.fprintf ppf
         "@[<hv 2>Illegal permutation of runtime components in a module type.@ \
-         @[For example,@ %a@]@ @[the %a@ and the %a are not in the same order@ \
+         @[For example%a,@]@ @[the %a@ and the %a are not in the same order@ \
          in the expected and actual module types.@]@]"
         ctx_printer ctx pp_item (item mt k) pp_item (item mt l)
     with Not_found -> (* this should not happen *)
-      Format.fprintf ppf
+      Fmt.fprintf ppf
         "Illegal permutation of runtime components in a module type."
 
+  let in_package_subtype ctx_printer env mty c ppf =
+    match first_change c with
+    | None ->
+        (* The coercion looks like the identity but was not simplified to
+           [Tcoerce_none], this only happens when the two first-class module
+           types differ by runtime size *)
+        Fmt.fprintf ppf
+          "The two first-class module types differ by their runtime size."
+    | Some (path, c) ->
+  try
+    let ctx, mt = find env path mty in
+    match c with
+    | Primitive_coercion prim_name ->
+        Fmt.fprintf ppf
+          "@[The two first-class module types differ by a coercion of@ \
+           the primitive %a@ to a value%a.@]"
+          Style.inline_code prim_name
+          ctx_printer ctx
+    | Alias_coercion path ->
+        Fmt.fprintf ppf
+          "@[The two first-class module types differ by a coercion of@ \
+           a module alias %a@ to a module%a.@]"
+          (Style.as_inline_code Printtyp.path) path
+          ctx_printer ctx
+    | Transposition (k,l) ->
+        Fmt.fprintf ppf
+          "@[@[The two first-class module types do not share@ \
+           the same positions for runtime components.@]@ \
+           @[For example,%a@ the %a@ occurs at the expected position of@ \
+           the %a.@]@]"
+          ctx_printer ctx pp_item (item mt k) pp_item (item mt l)
+  with Not_found ->
+    Fmt.fprintf ppf
+      "@[The two packages types do not share@ \
+       the@ same@ positions@ for@ runtime@ components.@]"
+
 end
 
 
@@ -204,7 +253,7 @@ let is_big obj =
 let show_loc msg ppf loc =
   let pos = loc.Location.loc_start in
   if List.mem pos.Lexing.pos_fname [""; "_none_"; "//toplevel//"] then ()
-  else Format.fprintf ppf "@\n@[<2>%a:@ %s@]" Location.print_loc loc msg
+  else Fmt.fprintf ppf "@\n@[<2>%a:@ %s@]" Location.Doc.loc loc msg
 
 let show_locs ppf (loc1, loc2) =
   show_loc "Expected declaration" ppf loc2;
@@ -212,10 +261,10 @@ let show_locs ppf (loc1, loc2) =
 
 
 let dmodtype mty =
-  let tmty = Printtyp.tree_of_modtype mty in
-  Format.dprintf "%a" !Oprint.out_module_type tmty
+  let tmty = Out_type.tree_of_modtype mty in
+  Fmt.dprintf "%a" !Oprint.out_module_type tmty
 
-let space ppf () = Format.fprintf ppf "@ "
+let space ppf () = Fmt.fprintf ppf "@ "
 
 (**
    In order to display a list of functor arguments in a compact format,
@@ -264,8 +313,8 @@ module With_shorthand = struct
 
   let make side pos =
     match side with
-    | Got -> Format.sprintf "$S%d" pos
-    | Expected -> Format.sprintf "$T%d" pos
+    | Got -> Fmt.asprintf "$S%d" pos
+    | Expected -> Fmt.asprintf "$T%d" pos
     | Unneeded -> "..."
 
   (** Add shorthands to a patch *)
@@ -310,43 +359,43 @@ module With_shorthand = struct
   (** Printing of arguments with shorthands *)
   let pp ppx = function
     | Original x -> ppx x
-    | Synthetic s -> Format.dprintf "%s" s.name
+    | Synthetic s -> Fmt.dprintf "%s" s.name
 
   let pp_orig ppx = function
     | Original x | Synthetic { item=x; _ } -> ppx x
 
   let definition x = match functor_param x with
-    | Unit -> Format.dprintf "()"
+    | Unit -> Fmt.dprintf "()"
     | Named(_,short_mty) ->
         match short_mty with
         | Original mty -> dmodtype mty
         | Synthetic {name; item = mty} ->
-            Format.dprintf
+            Fmt.dprintf
               "%s@ =@ %t" name (dmodtype mty)
 
   let param x = match functor_param x with
-    | Unit -> Format.dprintf "()"
+    | Unit -> Fmt.dprintf "()"
     | Named (_, short_mty) ->
         pp dmodtype short_mty
 
   let qualified_param x = match functor_param x with
-    | Unit -> Format.dprintf "()"
+    | Unit -> Fmt.dprintf "()"
     | Named (None, Original (Mty_signature []) ) ->
-        Format.dprintf "(sig end)"
+        Fmt.dprintf "(sig end)"
     | Named (None, short_mty) ->
         pp dmodtype short_mty
     | Named (Some p, short_mty) ->
-        Format.dprintf "(%s : %t)"
+        Fmt.dprintf "(%s : %t)"
           (Ident.name p) (pp dmodtype short_mty)
 
   let definition_of_argument ua =
     let arg, mty = ua.item in
     match (arg: Err.functor_arg_descr) with
-    | Unit -> Format.dprintf "()"
-    | Empty_struct -> Format.dprintf "(struct end)"
+    | Unit -> Fmt.dprintf "()"
+    | Empty_struct -> Fmt.dprintf "(struct end)"
     | Named p ->
         let mty = modtype { ua with item = mty } in
-        Format.dprintf
+        Fmt.dprintf
           "%a@ :@ %t"
           Printtyp.path p
           (pp_orig dmodtype mty)
@@ -355,14 +404,14 @@ module With_shorthand = struct
         begin match short_mty with
         | Original mty -> dmodtype mty
         | Synthetic {name; item=mty} ->
-            Format.dprintf "%s@ :@ %t" name (dmodtype mty)
+            Fmt.dprintf "%s@ :@ %t" name (dmodtype mty)
         end
 
   let arg ua =
     let arg, mty = ua.item in
     match (arg: Err.functor_arg_descr) with
-    | Unit -> Format.dprintf "()"
-    | Empty_struct -> Format.dprintf "(struct end)"
+    | Unit -> Fmt.dprintf "()"
+    | Empty_struct -> Fmt.dprintf "(struct end)"
     | Named p -> fun ppf -> Printtyp.path ppf p
     | Anonymous ->
         let short_mty = modtype { ua with item=mty } in
@@ -378,17 +427,38 @@ module Functor_suberror = struct
     | Types.Named (Some _ as x,_) -> x
     | Types.(Unit | Named(None,_)) -> None
 
-  (** Print the list of params with style *)
+
+(** Print a list of functor parameters with style while adjusting the printing
+    environment for each functor argument.
+
+    Currently, we are disabling disambiguation for functor argument name to
+    avoid the need to track the moving association between identifiers and
+    syntactic names in situation like:
+
+    got: (X: sig module type T end) (Y:X.T) (X:sig module type T end) (Z:X.T)
+    expect: (_: sig end) (Y:X.T) (_:sig end) (Z:X.T)
+*)
   let pretty_params sep proj printer patch =
-    let elt (x,param) =
+    let pp_param (x,param) =
       let sty = Diffing.(style @@ classify x) in
-      Format.dprintf "%a%t%a"
-        Format.pp_open_stag (Style.Style sty)
+      Fmt.dprintf "%a%t%a"
+        Fmt.pp_open_stag (Style.Style sty)
         (printer param)
-        Format.pp_close_stag ()
+        Fmt.pp_close_stag ()
+    in
+    let rec pp_params = function
+      | [] -> ignore
+      | [_,param] -> pp_param param
+      | (id,param) :: q ->
+          Fmt.dprintf "%t%a%t"
+            (pp_param param) sep () (hide_id id q)
+    and hide_id id q =
+      match id with
+      | None -> pp_params q
+      | Some id -> Out_type.Ident_names.with_fuzzy id (fun () -> pp_params q)
     in
     let params = List.filter_map proj @@ List.map snd patch in
-    Printtyp.functor_parameters ~sep elt params
+    pp_params params
 
   let expected d =
     let extract: _ Diffing.change -> _ = function
@@ -424,17 +494,17 @@ module Functor_suberror = struct
       pretty_params space extract With_shorthand.qualified_param d
 
     let insert mty =
-      Format.dprintf
+      Fmt.dprintf
         "An argument appears to be missing with module type@;<1 2>@[%t@]"
         (With_shorthand.definition mty)
 
     let delete mty =
-      Format.dprintf
+      Fmt.dprintf
         "An extra argument is provided of module type@;<1 2>@[%t@]"
         (With_shorthand.definition mty)
 
       let ok x y =
-        Format.dprintf
+        Fmt.dprintf
           "Module types %t and %t match"
           (With_shorthand.param x)
           (With_shorthand.param y)
@@ -442,17 +512,17 @@ module Functor_suberror = struct
       let diff g e more =
         let g = With_shorthand.definition g in
         let e = With_shorthand.definition e in
-        Format.dprintf
+        Fmt.dprintf
           "Module types do not match:@ @[%t@]@;<1 -2>does not include@ \
            @[%t@]%t"
           g e (more ())
 
       let incompatible = function
         | Types.Unit ->
-            Format.dprintf
+            Fmt.dprintf
               "The functor was expected to be applicative at this position"
         | Types.Named _ ->
-            Format.dprintf
+            Fmt.dprintf
               "The functor was expected to be generative at this position"
 
       let patch env got expected =
@@ -478,7 +548,7 @@ module Functor_suberror = struct
       pretty_params space extract With_shorthand.arg d
 
     let delete mty =
-      Format.dprintf
+      Fmt.dprintf
         "The following extra argument is provided@;<1 2>@[%t@]"
         (With_shorthand.definition_of_argument mty)
 
@@ -487,10 +557,10 @@ module Functor_suberror = struct
     let ok x y =
       let pp_orig_name = match With_shorthand.functor_param y with
         | With_shorthand.Named (_, Original mty) ->
-            Format.dprintf " %t" (dmodtype mty)
+            Fmt.dprintf " %t" (dmodtype mty)
         | _ -> ignore
       in
-      Format.dprintf
+      Fmt.dprintf
         "Module %t matches the expected module type%t"
         (With_shorthand.arg x)
         pp_orig_name
@@ -498,7 +568,7 @@ module Functor_suberror = struct
     let diff g e more =
       let g = With_shorthand.definition_of_argument g in
       let e = With_shorthand.definition e in
-      Format.dprintf
+      Fmt.dprintf
         "Modules do not match:@ @[%t@]@;<1 -2>\
          is not included in@ @[%t@]%t"
         g e (more ())
@@ -509,10 +579,10 @@ module Functor_suberror = struct
     let single_diff g e more =
       let _arg, mty = g.With_shorthand.item in
       let e = match e.With_shorthand.item with
-        | Types.Unit -> Format.dprintf "()"
+        | Types.Unit -> Fmt.dprintf "()"
         | Types.Named(_, mty) -> dmodtype mty
       in
-      Format.dprintf
+      Fmt.dprintf
         "Modules do not match:@ @[%t@]@;<1 -2>\
          is not included in@ @[%t@]%t"
         (dmodtype mty) e (more ())
@@ -520,10 +590,10 @@ module Functor_suberror = struct
 
     let incompatible = function
       | Unit ->
-          Format.dprintf
+          Fmt.dprintf
             "The functor was expected to be applicative at this position"
       | Named _ | Anonymous ->
-          Format.dprintf
+          Fmt.dprintf
             "The functor was expected to be generative at this position"
       | Empty_struct ->
           (* an empty structure can be used in both applicative and generative
@@ -533,18 +603,18 @@ module Functor_suberror = struct
 
   let subcase sub ~expansion_token env (pos, diff) =
     Location.msg "%a%a%a%a@[<hv 2>%t@]%a"
-      Format.pp_print_tab ()
-      Format.pp_open_tbox ()
+      Fmt.pp_print_tab ()
+      Fmt.pp_open_tbox ()
       Diffing.prefix (pos, Diffing.classify diff)
-      Format.pp_set_tab ()
+      Fmt.pp_set_tab ()
       (Printtyp.wrap_printing_env env ~error:true
          (fun () -> sub ~expansion_token env diff)
       )
-     Format.pp_close_tbox ()
+     Fmt.pp_close_tbox ()
 
   let onlycase sub ~expansion_token env (_, diff) =
     Location.msg "%a@[<hv 2>%t@]"
-      Format.pp_print_tab ()
+      Fmt.pp_print_tab ()
       (Printtyp.wrap_printing_env env ~error:true
          (fun () -> sub ~expansion_token env diff)
       )
@@ -591,122 +661,113 @@ let coalesce msgs =
   | [] -> ignore
   | before ->
       let ctx ppf =
-        Format.pp_print_list ~pp_sep:space
-          (fun ppf x -> x.Location.txt ppf)
+        Fmt.pp_print_list ~pp_sep:space
+          (fun ppf x -> Fmt.pp_doc ppf x.Location.txt)
           ppf before in
       ctx
 
 let subcase_list l ppf = match l with
   | [] -> ()
   | _ :: _ ->
-      Format.fprintf ppf "@;<1 -2>@[%a@]"
-        (Format.pp_print_list ~pp_sep:space
-           (fun ppf f -> f.Location.txt ppf)
-        )
+      let pp_msg ppf lmsg = Fmt.pp_doc ppf lmsg.Location.txt in
+      Fmt.fprintf ppf "@;<1 -2>@[%a@]"
+        (Fmt.pp_print_list ~pp_sep:space pp_msg)
         (List.rev l)
 
 (* Printers for leaves *)
 let core env id x =
   match x with
   | Err.Value_descriptions diff ->
-      Format.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a%t@]"
+      Fmt.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
         "Values do not match"
         !Oprint.out_sig_item
-        (Printtyp.tree_of_value_description id diff.got)
+        (Out_type.tree_of_value_description id diff.got)
         "is not included in"
         !Oprint.out_sig_item
-        (Printtyp.tree_of_value_description id diff.expected)
+        (Out_type.tree_of_value_description id diff.expected)
         (Includecore.report_value_mismatch
            "the first" "the second" env) diff.symptom
         show_locs (diff.got.val_loc, diff.expected.val_loc)
-        Printtyp.Conflicts.print_explanations
   | Err.Type_declarations diff ->
-      Format.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a%t@]"
+      Fmt.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
         "Type declarations do not match"
         !Oprint.out_sig_item
-        (Printtyp.tree_of_type_declaration id diff.got Trec_first)
+        (Out_type.tree_of_type_declaration id diff.got Trec_first)
         "is not included in"
         !Oprint.out_sig_item
-        (Printtyp.tree_of_type_declaration id diff.expected Trec_first)
+        (Out_type.tree_of_type_declaration id diff.expected Trec_first)
         (Includecore.report_type_mismatch
            "the first" "the second" "declaration" env) diff.symptom
         show_locs (diff.got.type_loc, diff.expected.type_loc)
-        Printtyp.Conflicts.print_explanations
   | Err.Extension_constructors diff ->
-      Format.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]@ %a%a%t@]"
+      Fmt.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]@ %a%a@]"
         "Extension declarations do not match"
         !Oprint.out_sig_item
-        (Printtyp.tree_of_extension_constructor id diff.got Text_first)
+        (Out_type.tree_of_extension_constructor id diff.got Text_first)
         "is not included in"
         !Oprint.out_sig_item
-        (Printtyp.tree_of_extension_constructor id diff.expected Text_first)
+        (Out_type.tree_of_extension_constructor id diff.expected Text_first)
         (Includecore.report_extension_constructor_mismatch
            "the first" "the second" "declaration" env) diff.symptom
         show_locs (diff.got.ext_loc, diff.expected.ext_loc)
-        Printtyp.Conflicts.print_explanations
   | Err.Class_type_declarations diff ->
-      Format.dprintf
+      Fmt.dprintf
         "@[<hv 2>Class type declarations do not match:@ \
-         %a@;<1 -2>does not match@ %a@]@ %a%t"
+         %a@;<1 -2>does not match@ %a@]@ %a"
         !Oprint.out_sig_item
-        (Printtyp.tree_of_cltype_declaration id diff.got Trec_first)
+        (Out_type.tree_of_cltype_declaration id diff.got Trec_first)
         !Oprint.out_sig_item
-        (Printtyp.tree_of_cltype_declaration id diff.expected Trec_first)
-        (Includeclass.report_error Type_scheme) diff.symptom
-        Printtyp.Conflicts.print_explanations
+        (Out_type.tree_of_cltype_declaration id diff.expected Trec_first)
+        (Includeclass.report_error_doc Type_scheme) diff.symptom
   | Err.Class_declarations {got;expected;symptom} ->
-      let t1 = Printtyp.tree_of_class_declaration id got Trec_first in
-      let t2 = Printtyp.tree_of_class_declaration id expected Trec_first in
-      Format.dprintf
+      let t1 = Out_type.tree_of_class_declaration id got Trec_first in
+      let t2 = Out_type.tree_of_class_declaration id expected Trec_first in
+      Fmt.dprintf
         "@[<hv 2>Class declarations do not match:@ \
-         %a@;<1 -2>does not match@ %a@]@ %a%t"
+         %a@;<1 -2>does not match@ %a@]@ %a"
         !Oprint.out_sig_item t1
         !Oprint.out_sig_item t2
-        (Includeclass.report_error Type_scheme) symptom
-        Printtyp.Conflicts.print_explanations
+        (Includeclass.report_error_doc Type_scheme) symptom
 
 let missing_field ppf item =
   let id, loc, kind =  Includemod.item_ident_name item in
-  Format.fprintf ppf "The %s %a is required but not provided%a"
+  Fmt.fprintf ppf "The %s %a is required but not provided%a"
     (Includemod.kind_of_field_desc kind)
     (Style.as_inline_code Printtyp.ident) id
     (show_loc "Expected declaration") loc
 
 let module_types {Err.got=mty1; expected=mty2} =
-  Format.dprintf
+  Fmt.dprintf
     "@[<hv 2>Modules do not match:@ \
      %a@;<1 -2>is not included in@ %a@]"
-    !Oprint.out_module_type (Printtyp.tree_of_modtype mty1)
-    !Oprint.out_module_type (Printtyp.tree_of_modtype mty2)
+    !Oprint.out_module_type (Out_type.tree_of_modtype mty1)
+    !Oprint.out_module_type (Out_type.tree_of_modtype mty2)
 
 let eq_module_types {Err.got=mty1; expected=mty2} =
-  Format.dprintf
+  Fmt.dprintf
     "@[<hv 2>Module types do not match:@ \
      %a@;<1 -2>is not equal to@ %a@]"
-    !Oprint.out_module_type (Printtyp.tree_of_modtype mty1)
-    !Oprint.out_module_type (Printtyp.tree_of_modtype mty2)
+    !Oprint.out_module_type (Out_type.tree_of_modtype mty1)
+    !Oprint.out_module_type (Out_type.tree_of_modtype mty2)
 
 let module_type_declarations id {Err.got=d1 ; expected=d2} =
-  Format.dprintf
+  Fmt.dprintf
     "@[<hv 2>Module type declarations do not match:@ \
      %a@;<1 -2>does not match@ %a@]"
-    !Oprint.out_sig_item (Printtyp.tree_of_modtype_declaration id d1)
-    !Oprint.out_sig_item (Printtyp.tree_of_modtype_declaration id d2)
+    !Oprint.out_sig_item (Out_type.tree_of_modtype_declaration id d1)
+    !Oprint.out_sig_item (Out_type.tree_of_modtype_declaration id d2)
 
 let interface_mismatch ppf (diff: _ Err.diff) =
-  Format.fprintf ppf
+  Fmt.fprintf ppf
     "The implementation %a@ does not match the interface %a:@ "
     Style.inline_code diff.got Style.inline_code diff.expected
 
 let core_module_type_symptom (x:Err.core_module_type_symptom)  =
   match x with
   | Not_an_alias | Not_an_identifier | Abstract_module_type
-  | Incompatible_aliases ->
-      if Printtyp.Conflicts.exists () then
-        Some Printtyp.Conflicts.print_explanations
-      else None
+  | Incompatible_aliases -> None
   | Unbound_module_path path ->
-      Some(Format.dprintf "Unbound module %a"
+      Some(Fmt.dprintf "Unbound module %a"
              (Style.as_inline_code Printtyp.path) path
           )
 
@@ -748,7 +809,7 @@ and module_type_symptom ~eqmode ~expansion_token ~env ~before ~ctx = function
       module_type ~eqmode ~expansion_token ~env ~before ~ctx diff
   | Invalid_module_alias path ->
       let printer =
-        Format.dprintf "Module %a cannot be aliased"
+        Fmt.dprintf "Module %a cannot be aliased"
           (Style.as_inline_code Printtyp.path) path
       in
       dwith_context ctx printer :: before
@@ -758,10 +819,10 @@ and functor_params ~expansion_token ~env ~before ~ctx {got;expected;_} =
   let actual = Functor_suberror.Inclusion.got d in
   let expected = Functor_suberror.expected d in
   let main =
-    Format.dprintf
+    Fmt.dprintf
       "@[<hv 2>Modules do not match:@ \
-       @[functor@ %t@ -> ...@]@;<1 -2>is not included in@ \
-       @[functor@ %t@ -> ...@]@]"
+       @[%t@ -> ...@]@;<1 -2>is not included in@ \
+       @[%t@ -> ...@]@]"
       actual expected
   in
   let msgs = dwith_context ctx main :: before in
@@ -784,8 +845,8 @@ and signature ~expansion_token ~env:_ ~before ~ctx sgs =
           if expansion_token then
             let init_missings, last_missing = Misc.split_last missings in
             List.map (Location.msg "%a" missing_field) init_missings
-            @ [ with_context ctx missing_field last_missing ]
-            @ before
+            @ with_context ctx missing_field last_missing
+            :: before
           else
             before
       | [], a :: _ -> sigitem ~expansion_token ~env:sgs.env ~before ~ctx a
@@ -825,7 +886,7 @@ and module_type_decl ~expansion_token ~env ~before ~ctx id diff =
       | None -> assert false
       | Some mty ->
           with_context (Modtype id::ctx)
-            (Illegal_permutation.pp Context.alt_pp env) (mty,c)
+            (Runtime_coercion.illegal_permutation Context.alt_pp env) (mty,c)
           :: before
       end
 
@@ -874,7 +935,7 @@ let module_type_subst ~env id diff =
       let mty = diff.got in
       let main =
         with_context [Modtype id]
-          (Illegal_permutation.pp Context.alt_pp env) (mty,c) in
+          (Runtime_coercion.illegal_permutation Context.alt_pp env) (mty,c) in
       [main]
 
 let all env = function
@@ -897,29 +958,32 @@ let all env = function
 
 (* General error reporting *)
 
-let err_msgs (env, err) =
-  Printtyp.Conflicts.reset();
+let err_msgs ppf (env, err) =
   Printtyp.wrap_printing_env ~error:true env
-    (fun () -> coalesce @@ all env err)
+    (fun () -> (coalesce @@ all env err)  ppf)
 
-let report_error err =
-  let main = err_msgs err in
-  Location.errorf ~loc:Location.(in_file !input_name) "%t" main
+let report_error_doc err =
+  Location.errorf
+    ~loc:Location.(in_file !input_name)
+    ~footnote:Out_type.Ident_conflicts.err_msg
+   "%a" err_msgs err
 
-let report_apply_error ~loc env (app_name, mty_f, args) =
+let report_apply_error_doc ~loc env (app_name, mty_f, args) =
+  let footnote = Out_type.Ident_conflicts.err_msg in
   let d = Functor_suberror.App.patch env ~f:mty_f ~args in
   match d with
   (* We specialize the one change and one argument case to remove the
      presentation of the functor arguments *)
   | [ _,  Change (_, _, Err.Incompatible_params (i,_)) ] ->
-      Location.errorf ~loc "%t" (Functor_suberror.App.incompatible i)
+      Location.errorf ~loc ~footnote "%t" (Functor_suberror.App.incompatible i)
   | [ _, Change (g, e,  Err.Mismatch mty_diff) ] ->
       let more () =
         subcase_list @@
         module_type_symptom ~eqmode:false ~expansion_token:true ~env ~before:[]
           ~ctx:[] mty_diff.symptom
       in
-      Location.errorf ~loc "%t" (Functor_suberror.App.single_diff g e more)
+      Location.errorf ~loc ~footnote "%t"
+        (Functor_suberror.App.single_diff g e more)
   | _ ->
       let not_functor =
         List.for_all (function _, Diffing.Delete _ -> true | _ -> false) d
@@ -943,12 +1007,12 @@ let report_apply_error ~loc env (app_name, mty_f, args) =
         let intro ppf =
           match app_name with
           | Includemod.Anonymous_functor ->
-              Format.fprintf ppf "This functor application is ill-typed."
+              Fmt.fprintf ppf "This functor application is ill-typed."
           | Includemod.Full_application_path lid ->
-              Format.fprintf ppf "The functor application %a is ill-typed."
+              Fmt.fprintf ppf "The functor application %a is ill-typed."
                 (Style.as_inline_code Printtyp.longident) lid
           |  Includemod.Named_leftmost_functor lid ->
-              Format.fprintf ppf
+              Fmt.fprintf ppf
                 "This application of the functor %a is ill-typed."
                  (Style.as_inline_code Printtyp.longident) lid
         in
@@ -958,20 +1022,24 @@ let report_apply_error ~loc env (app_name, mty_f, args) =
           List.rev @@
           Functor_suberror.params functor_app_diff env ~expansion_token:true d
         in
-        Location.errorf ~loc ~sub
+        Location.errorf ~loc ~sub ~footnote
           "@[<hv>%t@ \
            These arguments:@;<1 2>@[%t@]@ \
-           do not match these parameters:@;<1 2>@[functor@ %t@ -> ...@]@]"
+           do not match these parameters:@;<1 2>@[%t@ -> ...@]@]"
           intro
           actual expected
 
+let coercion_in_package_subtype env mty c =
+  Format_doc.doc_printf "%t" @@
+  Runtime_coercion.in_package_subtype Context.alt_pp env mty c
+
 let register () =
   Location.register_error_of_exn
     (function
-      | Includemod.Error err -> Some (report_error err)
+      | Includemod.Error err -> Some (report_error_doc err)
       | Includemod.Apply_error {loc; env; app_name; mty_f; args} ->
           Some (Printtyp.wrap_printing_env env ~error:true (fun () ->
-              report_apply_error ~loc env (app_name, mty_f, args))
+              report_apply_error_doc ~loc env (app_name, mty_f, args))
             )
       | _ -> None
     )

diff --git a/typing/includemod_errorprinter.mli b/typing/includemod_errorprinter.mli
index 12ea2169b0ad4da87f54ea3cb5481e7fda5f3ef3..0c7dda4e56b6567fd47471203f7432020cfc87aa 100644 (file)
--- a/typing/includemod_errorprinter.mli
+++ b/typing/includemod_errorprinter.mli
@@ -13,5 +13,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-val err_msgs: Includemod.explanation -> Format.formatter -> unit
+val err_msgs: Includemod.explanation Format_doc.printer
+val coercion_in_package_subtype:
+  Env.t -> Types.module_type -> Typedtree.module_coercion -> Format_doc.doc
 val register: unit -> unit

diff --git a/typing/mtype.ml b/typing/mtype.ml
index 43fced07abe29bdb6bba4cdb93f116a905b81d64..499d85ca11956216ae2dd88c4de2e975d5127806 100644 (file)
--- a/typing/mtype.ml
+++ b/typing/mtype.ml
@@ -456,9 +456,11 @@ let collect_arg_paths mty =
   and bindings = ref Ident.empty in
   (* let rt = Ident.create "Root" in
      and prefix = ref (Path.Pident rt) in *)
+  with_type_mark begin fun mark ->
+  let super = type_iterators mark in
   let it_path p = paths := Path.Set.union (get_arg_paths p) !paths
   and it_signature_item it si =
-    type_iterators.it_signature_item it si;
+    super.it_signature_item it si;
     match si with
     | Sig_module (id, _, {md_type=Mty_alias p}, _, _) ->
         bindings := Ident.add id p !bindings
@@ -471,11 +473,11 @@ let collect_arg_paths mty =
           sg
     | _ -> ()
   in
-  let it = {type_iterators with it_path; it_signature_item} in
+  let it = {super with it_path; it_signature_item} in
   it.it_module_type it mty;
-  it.it_module_type unmark_iterators mty;
   Path.Set.fold (fun p -> Ident.Set.union (collect_ids !subst !bindings p))
     !paths Ident.Set.empty
+  end
 
 type remove_alias_args =
     { mutable modified: bool;
@@ -552,14 +554,16 @@ let scrape_for_type_of ~remove_aliases env mty =
 
 let lower_nongen nglev mty =
   let open Btype in
-  let it_type_expr it ty =
+  with_type_mark begin fun mark ->
+  let super = type_iterators mark in
+  let it_do_type_expr it ty =
     match get_desc ty with
       Tvar _ ->
         let level = get_level ty in
         if level < generic_level && level > nglev then set_level ty nglev
     | _ ->
-        type_iterators.it_type_expr it ty
+        super.it_do_type_expr it ty
   in
-  let it = {type_iterators with it_type_expr} in
-  it.it_module_type it mty;
-  it.it_module_type unmark_iterators mty
+  let it = {super with it_do_type_expr} in
+  it.it_module_type it mty
+  end

diff --git a/typing/oprint.ml b/typing/oprint.ml
index 70d5a0dc997f841e1e963084cd384946e816b5b5..b915fefa50d488d23f054b03de38631eeed1c830 100644 (file)
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -13,7 +13,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Format
+open Format_doc
 open Outcometree
 
 exception Ellipsis
@@ -37,28 +37,9 @@ let rec print_ident ppf =
 
 let out_ident = ref print_ident
 
-(* Check a character matches the [identchar_latin1] class from the lexer *)
-let is_ident_char c =
-  match c with
-  | 'A'..'Z' | 'a'..'z' | '_' | '\192'..'\214' | '\216'..'\246'
-  | '\248'..'\255' | '\'' | '0'..'9' -> true
-  | _ -> false
-
-let all_ident_chars s =
-  let rec loop s len i =
-    if i < len then begin
-      if is_ident_char s.[i] then loop s len (i+1)
-      else false
-    end else begin
-      true
-    end
-  in
-  let len = String.length s in
-  loop s len 0
-
 let parenthesized_ident name =
   (List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"])
-  || not (all_ident_chars name)
+  || not (Misc.Utf8_lexeme.is_valid_identifier name)
 
 let value_ident ppf name =
   if parenthesized_ident name then
@@ -162,6 +143,9 @@ let print_constr ppf name =
     (* despite being keywords, these are constructor names
        and should not be escaped *)
     fprintf ppf "%s" c
+  | Oide_dot (id, ("true"|"false" as s)) ->
+      (* Similarly, M.true is invalid *)
+      fprintf ppf "%a.(%s)" print_ident id s
   | _ -> print_ident ppf name
 
 let print_out_value ppf tree =
@@ -249,7 +233,7 @@ let print_out_value ppf tree =
   in
   cautious print_tree_1 ppf tree
 
-let out_value = ref print_out_value
+let out_value = ref (compat print_out_value)
 
 (* Types *)
 
@@ -267,7 +251,7 @@ let rec print_list pr sep ppf =
 let pr_present =
   print_list (fun ppf s -> fprintf ppf "`%s" s) (fun ppf -> fprintf ppf "@ ")
 
-let pr_var = Pprintast.tyvar
+let pr_var = Pprintast.Doc.tyvar
 let ty_var ~non_gen ppf s =
   pr_var ppf (if non_gen then "_" ^ s else s)
 
@@ -404,10 +388,13 @@ and print_typargs ppf =
       pp_print_char ppf ')';
       pp_close_box ppf ();
       pp_print_space ppf ()
-and print_out_label ppf (name, mut, arg) =
-  fprintf ppf "@[<2>%s%a :@ %a@];" (if mut then "mutable " else "")
-    print_lident name
-    print_out_type arg
+and print_out_label ppf {olab_name; olab_mut; olab_type} =
+  fprintf ppf "@[<2>%s%a :@ %a@];"
+    (match olab_mut with
+     | Mutable -> "mutable "
+     | Immutable -> "")
+    print_lident olab_name
+    print_out_type olab_type
 
 let out_label = ref print_out_label
 
@@ -555,7 +542,7 @@ and print_out_functor_parameters ppf l =
           print_args l
     | _ :: _ as non_anonymous_functor ->
         let args, anons = split_anon_functor_arguments non_anonymous_functor in
-        fprintf ppf "@[<2>functor@ %a@]@ ->@ %a"
+        fprintf ppf "@[%a@]@ ->@ %a"
           (pp_print_list ~pp_sep:pp_print_space print_nonanon_arg) args
           print_args anons
   in
@@ -813,6 +800,8 @@ let _ = out_functor_parameters := print_out_functor_parameters
 
 (* Phrases *)
 
+open Format
+
 let print_out_exception ppf exn outv =
   match exn with
     Sys.Break -> fprintf ppf "Interrupted.@."
@@ -847,23 +836,26 @@ let rec print_items ppf =
           otyext_constructors = exts;
           otyext_private = ext.oext_private }
       in
-        fprintf ppf "@[%a@]" !out_type_extension te;
+        fprintf ppf "@[%a@]" (Format_doc.compat !out_type_extension) te;
         if items <> [] then fprintf ppf "@ %a" print_items items
   | (tree, valopt) :: items ->
       begin match valopt with
         Some v ->
-          fprintf ppf "@[<2>%a =@ %a@]" !out_sig_item tree
+          fprintf ppf "@[<2>%a =@ %a@]" (Format_doc.compat !out_sig_item) tree
             !out_value v
-      | None -> fprintf ppf "@[%a@]" !out_sig_item tree
+      | None -> fprintf ppf "@[%a@]" (Format_doc.compat !out_sig_item) tree
       end;
       if items <> [] then fprintf ppf "@ %a" print_items items
 
 let print_out_phrase ppf =
   function
     Ophr_eval (outv, ty) ->
-      fprintf ppf "@[- : %a@ =@ %a@]@." !out_type ty !out_value outv
+      fprintf ppf "@[- : %a@ =@ %a@]@." (compat !out_type) ty !out_value outv
   | Ophr_signature [] -> ()
   | Ophr_signature items -> fprintf ppf "@[<v>%a@]@." print_items items
   | Ophr_exception (exn, outv) -> print_out_exception ppf exn outv
 
 let out_phrase = ref print_out_phrase
+
+type 'a printer = 'a Format_doc.printer ref
+type 'a toplevel_printer = (Format.formatter -> 'a -> unit) ref

diff --git a/typing/oprint.mli b/typing/oprint.mli
index 31dad9a9068762feb33fa85d5ad7e63a512374e9..8ce44f37eec09f728749c12d7fee7a1b2ef59d44 100644 (file)
--- a/typing/oprint.mli
+++ b/typing/oprint.mli
@@ -13,24 +13,24 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Format
 open Outcometree
 
-val out_ident : (formatter -> out_ident -> unit) ref
-val out_value : (formatter -> out_value -> unit) ref
-val out_label : (formatter -> string * bool * out_type -> unit) ref
-val out_type : (formatter -> out_type -> unit) ref
-val out_type_args : (formatter -> out_type list -> unit) ref
-val out_constr : (formatter -> out_constructor -> unit) ref
-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
+type 'a printer = 'a Format_doc.printer ref
+type 'a toplevel_printer = (Format.formatter -> 'a -> unit) ref
+
+val out_ident: out_ident printer
+val out_value : out_value toplevel_printer
+val out_label : out_label printer
+val out_type : out_type printer
+val out_type_args : out_type list printer
+val out_constr : out_constructor printer
+val out_class_type : out_class_type printer
+val out_module_type : out_module_type printer
+val out_sig_item : out_sig_item printer
+val out_signature :out_sig_item list printer
 val out_functor_parameters :
-  (formatter ->
-   (string option * Outcometree.out_module_type) option list -> unit)
-    ref
-val out_type_extension : (formatter -> out_type_extension -> unit) ref
-val out_phrase : (formatter -> out_phrase -> unit) ref
+  (string option * Outcometree.out_module_type) option list printer
+val out_type_extension : out_type_extension printer
+val out_phrase : out_phrase toplevel_printer
 
 val parenthesized_ident : string -> bool

diff --git a/typing/out_type.ml b/typing/out_type.ml
new file mode 100644 (file)
index 0000000..b3f3731
--- /dev/null
+++ b/typing/out_type.ml
@@ -0,0 +1,1969 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*  Xavier Leroy and Jerome Vouillon, 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 Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Compute a spanning tree representation of types *)
+
+open Misc
+open Ctype
+open Longident
+open Path
+open Asttypes
+open Types
+open Btype
+open Outcometree
+
+module String = Misc.Stdlib.String
+module Sig_component_kind = Shape.Sig_component_kind
+module Style = Misc.Style
+
+(* Print a long identifier *)
+
+module Fmt = Format_doc
+open Format_doc
+
+(* Print an identifier avoiding name collisions *)
+
+module Out_name = struct
+  let create x = { printed_name = x }
+  let print x = x.printed_name
+end
+
+(** Some identifiers may require hiding when printing *)
+type bound_ident = { hide:bool; ident:Ident.t }
+
+(* printing environment for path shortening and naming *)
+let printing_env = ref Env.empty
+
+(* When printing, it is important to only observe the
+   current printing environment, without reading any new
+   cmi present on the file system *)
+let in_printing_env f = Env.without_cmis f !printing_env
+
+ type namespace = Sig_component_kind.t =
+    | Value
+    | Type
+    | Constructor
+    | Label
+    | Module
+    | Module_type
+    | Extension_constructor
+    | Class
+    | Class_type
+
+
+module Namespace = struct
+
+  let id = function
+    | Type -> 0
+    | Module -> 1
+    | Module_type -> 2
+    | Class -> 3
+    | Class_type -> 4
+    | Extension_constructor | Value | Constructor | Label -> 5
+     (* we do not handle those component *)
+
+  let size = 1 + id Value
+
+
+  let pp ppf x =
+    Fmt.pp_print_string ppf (Shape.Sig_component_kind.to_string x)
+
+  (** The two functions below should never access the filesystem,
+      and thus use {!in_printing_env} rather than directly
+      accessing the printing environment *)
+  let lookup =
+    let to_lookup f lid = fst @@ in_printing_env (f (Lident lid)) in
+    function
+    | Some Type -> to_lookup Env.find_type_by_name
+    | Some Module -> to_lookup Env.find_module_by_name
+    | Some Module_type -> to_lookup Env.find_modtype_by_name
+    | Some Class -> to_lookup Env.find_class_by_name
+    | Some Class_type -> to_lookup Env.find_cltype_by_name
+    | None | Some(Value|Extension_constructor|Constructor|Label) ->
+         fun _ -> raise Not_found
+
+  let location namespace id =
+    let path = Path.Pident id in
+    try Some (
+        match namespace with
+        | Some Type -> (in_printing_env @@ Env.find_type path).type_loc
+        | Some Module -> (in_printing_env @@ Env.find_module path).md_loc
+        | Some Module_type -> (in_printing_env @@ Env.find_modtype path).mtd_loc
+        | Some Class -> (in_printing_env @@ Env.find_class path).cty_loc
+        | Some Class_type -> (in_printing_env @@ Env.find_cltype path).clty_loc
+        | Some (Extension_constructor|Value|Constructor|Label) | None ->
+            Location.none
+      ) with Not_found -> None
+
+  let best_class_namespace = function
+    | Papply _ | Pdot _ -> Some Module
+    | Pextra_ty _ -> assert false (* Only in type path *)
+    | Pident c ->
+        match location (Some Class) c with
+        | Some _ -> Some Class
+        | None -> Some Class_type
+
+end
+
+(** {2 Ident conflicts printing}
+
+  Ident conflicts arise when multiple {!Ident.t}s are attributed the same name.
+  The following module stores the global conflict references and provides the
+  printing functions for explaining the source of the conflicts.
+*)
+module Ident_conflicts = struct
+  module M = String.Map
+  type explanation =
+    { kind: namespace; name:string; root_name:string; location:Location.t}
+  let explanations = ref M.empty
+
+  let add namespace name id =
+    match Namespace.location (Some namespace) id with
+    | None -> ()
+    | Some location ->
+        let explanation =
+          { kind = namespace; location; name; root_name=Ident.name id}
+        in
+        explanations := M.add name explanation !explanations
+
+  let collect_explanation namespace id ~name =
+    let root_name = Ident.name id in
+    (* if [name] is of the form "root_name/%d", we register both
+      [id] and the identifier in scope for [root_name].
+     *)
+    if root_name <> name && not (M.mem name !explanations) then
+      begin
+        add namespace name id;
+        if not (M.mem root_name !explanations) then
+          (* lookup the identifier in scope with name [root_name] and
+             add it too
+           *)
+          match Namespace.lookup (Some namespace) root_name with
+          | Pident root_id -> add namespace root_name root_id
+          | exception Not_found | _ -> ()
+      end
+
+  let pp_explanation ppf r=
+    Fmt.fprintf ppf "@[<v 2>%a:@,Definition of %s %a@]"
+      Location.Doc.loc r.location (Sig_component_kind.to_string r.kind)
+      Style.inline_code r.name
+
+  let print_located_explanations ppf l =
+    Fmt.fprintf ppf "@[<v>%a@]"
+      (Fmt.pp_print_list pp_explanation) l
+
+  let reset () = explanations := M.empty
+  let list_explanations () =
+    let c = !explanations in
+    reset ();
+    c |> M.bindings |> List.map snd |> List.sort Stdlib.compare
+
+
+  let print_toplevel_hint ppf l =
+    let conj ppf () = Fmt.fprintf ppf " and@ " in
+    let pp_namespace_plural ppf n = Fmt.fprintf ppf "%as" Namespace.pp n in
+    let root_names = List.map (fun r -> r.kind, r.root_name) l in
+    let unique_root_names = List.sort_uniq Stdlib.compare root_names in
+    let submsgs = Array.make Namespace.size [] in
+    let () = List.iter (fun (n,_ as x) ->
+        submsgs.(Namespace.id n) <- x :: submsgs.(Namespace.id n)
+      )  unique_root_names in
+    let pp_submsg ppf names =
+      match names with
+      | [] -> ()
+      | [namespace, a] ->
+          Fmt.fprintf ppf
+        "@,\
+         @[<2>@{<hint>Hint@}: The %a %a has been defined multiple times@ \
+         in@ this@ toplevel@ session.@ \
+         Some toplevel values still refer to@ old@ versions@ of@ this@ %a.\
+         @ Did you try to redefine them?@]"
+        Namespace.pp namespace
+        Style.inline_code a Namespace.pp namespace
+      | (namespace, _) :: _ :: _ ->
+        Fmt.fprintf ppf
+        "@,\
+         @[<2>@{<hint>Hint@}: The %a %a have been defined multiple times@ \
+         in@ this@ toplevel@ session.@ \
+         Some toplevel values still refer to@ old@ versions@ of@ those@ %a.\
+         @ Did you try to redefine them?@]"
+        pp_namespace_plural namespace
+        Fmt.(pp_print_list ~pp_sep:conj Style.inline_code)
+        (List.map snd names)
+        pp_namespace_plural namespace in
+    Array.iter (pp_submsg ppf) submsgs
+
+  let err_msg () =
+    let ltop, l =
+      (* isolate toplevel locations, since they are too imprecise *)
+      let from_toplevel a =
+        a.location.Location.loc_start.Lexing.pos_fname = "//toplevel//" in
+      List.partition from_toplevel (list_explanations ())
+    in
+    match l, ltop with
+    | [], [] -> None
+    | _  ->
+        Some
+          (Fmt.doc_printf "%a%a"
+             print_located_explanations l
+             print_toplevel_hint ltop
+          )
+  let err_print ppf = Option.iter Fmt.(fprintf ppf "@,%a" pp_doc) (err_msg ())
+
+  let exists () = M.cardinal !explanations >0
+end
+
+module Ident_names = struct
+
+module M = String.Map
+module S = String.Set
+
+let enabled = ref true
+let enable b = enabled := b
+
+(* Names bound in recursive definitions should be considered as bound
+   in the environment when printing identifiers but not when trying
+   to find shortest path.
+   For instance, if we define
+   [{
+   module Avoid__me = struct
+     type t = A
+   end
+   type t = X
+   type u = [` A of t * t ]
+   module M = struct
+     type t = A of [ u | `B ]
+     type r = Avoid__me.t
+   end
+  }]
+  It is is important that in the definition of [t] that the outer type [t] is
+  printed as [t/2] reserving the name [t] to the type being defined in the
+  current recursive definition.
+     Contrarily, in the definition of [r], one should not shorten the
+  path [Avoid__me.t] to [r] until the end of the definition of [r].
+  The [bound_in_recursion] bridges the gap between those two slightly different
+  notions of printing environment.
+*)
+let bound_in_recursion = ref M.empty
+
+(* When dealing with functor arguments, identity becomes fuzzy because the same
+   syntactic argument may be represented by different identifiers during the
+   error processing, we are thus disabling disambiguation on the argument name
+*)
+let fuzzy = ref S.empty
+let with_fuzzy id f =
+  protect_refs [ R(fuzzy, S.add (Ident.name id) !fuzzy) ] f
+let fuzzy_id namespace id = namespace = Module && S.mem (Ident.name id) !fuzzy
+
+let with_hidden ids f =
+  let update m id = M.add (Ident.name id.ident) id.ident m in
+  let updated = List.fold_left update !bound_in_recursion ids in
+  protect_refs [ R(bound_in_recursion, updated )] f
+
+let human_id id index =
+  (* The identifier with index [k] is the (k+1)-th most recent identifier in
+     the printing environment. We print them as [name/(k+1)] except for [k=0]
+     which is printed as [name] rather than [name/1].
+  *)
+  if index = 0 then
+    Ident.name id
+  else
+    let ordinal = index + 1 in
+    String.concat "/" [Ident.name id; string_of_int ordinal]
+
+let indexed_name namespace id =
+  let find namespace id env = match namespace with
+    | Type -> Env.find_type_index id env
+    | Module -> Env.find_module_index id env
+    | Module_type -> Env.find_modtype_index id env
+    | Class -> Env.find_class_index id env
+    | Class_type-> Env.find_cltype_index id env
+    | Value | Extension_constructor | Constructor | Label -> None
+  in
+  let index =
+    match M.find_opt (Ident.name id) !bound_in_recursion with
+    | Some rec_bound_id ->
+        (* the identifier name appears in the current group of recursive
+           definition *)
+        if Ident.same rec_bound_id id then
+          Some 0
+        else
+          (* the current recursive definition shadows one more time the
+            previously existing identifier with the same name *)
+          Option.map succ (in_printing_env (find namespace id))
+    | None ->
+        in_printing_env (find namespace id)
+  in
+  let index =
+    (* If [index] is [None] at this point, it might indicate that
+       the identifier id is not defined in the environment, while there
+       are other identifiers in scope that share the same name.
+       Currently, this kind of partially incoherent environment happens
+       within functor error messages where the left and right hand side
+       have a different views of the environment at the source level.
+       Printing the source-level by using a default index of `0`
+       seems like a reasonable compromise in this situation however.*)
+    Option.value index ~default:0
+  in
+  human_id id index
+
+let ident_name namespace id =
+  match namespace, !enabled with
+  | None, _ | _, false -> Out_name.create (Ident.name id)
+  | Some namespace, true ->
+      if fuzzy_id namespace id then Out_name.create (Ident.name id)
+      else
+        let name = indexed_name namespace id in
+        Ident_conflicts.collect_explanation namespace id ~name;
+        Out_name.create name
+end
+let ident_name = Ident_names.ident_name
+
+(* Print a path *)
+
+let ident_stdlib = Ident.create_persistent "Stdlib"
+
+let non_shadowed_stdlib namespace = function
+  | Pdot(Pident id, s) as path ->
+      Ident.same id ident_stdlib &&
+      (match Namespace.lookup namespace s with
+       | path' -> Path.same path path'
+       | exception Not_found -> true)
+  | _ -> false
+
+let find_double_underscore s =
+  let len = String.length s in
+  let rec loop i =
+    if i + 1 >= len then
+      None
+    else if s.[i] = '_' && s.[i + 1] = '_' then
+      Some i
+    else
+      loop (i + 1)
+  in
+  loop 0
+
+let rec module_path_is_an_alias_of env path ~alias_of =
+  match Env.find_module path env with
+  | { md_type = Mty_alias path'; _ } ->
+    Path.same path' alias_of ||
+    module_path_is_an_alias_of env path' ~alias_of
+  | _ -> false
+  | exception Not_found -> false
+
+(* Simple heuristic to print Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
+   for Foo__bar. This pattern is used by the stdlib. *)
+let rec rewrite_double_underscore_paths env p =
+  match p with
+  | Pdot (p, s) ->
+    Pdot (rewrite_double_underscore_paths env p, s)
+  | Papply (a, b) ->
+    Papply (rewrite_double_underscore_paths env a,
+            rewrite_double_underscore_paths env b)
+  | Pextra_ty (p, extra) ->
+    Pextra_ty (rewrite_double_underscore_paths env p, extra)
+  | Pident id ->
+    let name = Ident.name id in
+    match find_double_underscore name with
+    | None -> p
+    | Some i ->
+      let better_lid =
+        Ldot
+          (Lident (String.sub name 0 i),
+           Unit_info.modulize
+             (String.sub name (i + 2) (String.length name - i - 2)))
+      in
+      match Env.find_module_by_name better_lid env with
+      | exception Not_found -> p
+      | p', _ ->
+          if module_path_is_an_alias_of env p' ~alias_of:p then
+            p'
+          else
+          p
+
+let rewrite_double_underscore_paths env p =
+  if env == Env.empty then
+    p
+  else
+    rewrite_double_underscore_paths env p
+
+let rec tree_of_path ?(disambiguation=true) namespace p =
+  let tree_of_path namespace p = tree_of_path ~disambiguation namespace p in
+  let namespace = if disambiguation then namespace else None in
+  match p with
+  | Pident id ->
+      Oide_ident (ident_name namespace id)
+  | Pdot(_, s) as path when non_shadowed_stdlib namespace path ->
+      Oide_ident (Out_name.create s)
+  | Pdot(p, s) ->
+      Oide_dot (tree_of_path (Some Module) p, s)
+  | Papply(p1, p2) ->
+      let t1 = tree_of_path (Some Module) p1 in
+      let t2 = tree_of_path (Some Module) p2 in
+      Oide_apply (t1, t2)
+  | Pextra_ty (p, extra) -> begin
+      (* inline record types are syntactically prevented from escaping their
+         binding scope, and are never shown to users. *)
+      match extra with
+        Pcstr_ty s ->
+          Oide_dot (tree_of_path (Some Type) p, s)
+      | Pext_ty ->
+          tree_of_path None p
+    end
+
+let tree_of_path ?disambiguation namespace p =
+  tree_of_path ?disambiguation namespace
+    (rewrite_double_underscore_paths !printing_env p)
+
+
+(* Print a recursive annotation *)
+
+let tree_of_rec = function
+  | Trec_not -> Orec_not
+  | Trec_first -> Orec_first
+  | Trec_next -> Orec_next
+
+(* Normalize paths *)
+
+type param_subst = Id | Nth of int | Map of int list
+
+let is_nth = function
+    Nth _ -> true
+  | _ -> false
+
+let compose l1 = function
+  | Id -> Map l1
+  | Map l2 -> Map (List.map (List.nth l1) l2)
+  | Nth n  -> Nth (List.nth l1 n)
+
+let apply_subst s1 tyl =
+  if tyl = [] then []
+  (* cf. PR#7543: Typemod.type_package doesn't respect type constructor arity *)
+  else
+    match s1 with
+      Nth n1 -> [List.nth tyl n1]
+    | Map l1 -> List.map (List.nth tyl) l1
+    | Id -> tyl
+
+type best_path = Paths of Path.t list | Best of Path.t
+
+(** Short-paths cache: the five mutable variables below implement a one-slot
+    cache for short-paths
+ *)
+let printing_old = ref Env.empty
+let printing_pers = ref String.Set.empty
+(** {!printing_old} and  {!printing_pers} are the keys of the one-slot cache *)
+
+let printing_depth = ref 0
+let printing_cont = ref ([] : Env.iter_cont list)
+let printing_map = ref Path.Map.empty
+(**
+   - {!printing_map} is the main value stored in the cache.
+   Note that it is evaluated lazily and its value is updated during printing.
+   - {!printing_dep} is the current exploration depth of the environment,
+   it is used to determine whenever the {!printing_map} should be evaluated
+   further before completing a request.
+   - {!printing_cont} is the list of continuations needed to evaluate
+   the {!printing_map} one level further (see also {!Env.run_iter_cont})
+*)
+
+let rec index l x =
+  match l with
+    [] -> raise Not_found
+  | a :: l -> if eq_type x a then 0 else 1 + index l x
+
+let rec uniq = function
+    [] -> true
+  | a :: l -> not (List.memq (a : int) l) && uniq l
+
+let rec normalize_type_path ?(cache=false) env p =
+  try
+    let (params, ty, _) = Env.find_type_expansion p env in
+    match get_desc ty with
+      Tconstr (p1, tyl, _) ->
+        if List.length params = List.length tyl
+        && List.for_all2 eq_type params tyl
+        then normalize_type_path ~cache env p1
+        else if cache || List.length params <= List.length tyl
+             || not (uniq (List.map get_id tyl)) then (p, Id)
+        else
+          let l1 = List.map (index params) tyl in
+          let (p2, s2) = normalize_type_path ~cache env p1 in
+          (p2, compose l1 s2)
+    | _ ->
+        (p, Nth (index params ty))
+  with
+    Not_found ->
+      (Env.normalize_type_path None env p, Id)
+
+let penalty s =
+  if s <> "" && s.[0] = '_' then
+    10
+  else
+    match find_double_underscore s with
+    | None -> 1
+    | Some _ -> 10
+
+let rec path_size = function
+    Pident id ->
+      penalty (Ident.name id), -Ident.scope id
+  | Pdot (p, _) | Pextra_ty (p, Pcstr_ty _) ->
+      let (l, b) = path_size p in (1+l, b)
+  | Papply (p1, p2) ->
+      let (l, b) = path_size p1 in
+      (l + fst (path_size p2), b)
+  | Pextra_ty (p, _) -> path_size p
+
+let same_printing_env env =
+  let used_pers = Env.used_persistent () in
+  Env.same_types !printing_old env && String.Set.equal !printing_pers used_pers
+
+let set_printing_env env =
+  printing_env := env;
+  if !Clflags.real_paths ||
+     !printing_env == Env.empty ||
+     same_printing_env env then
+    ()
+  else begin
+    (* printf "Reset printing_map@."; *)
+    printing_old := env;
+    printing_pers := Env.used_persistent ();
+    printing_map := Path.Map.empty;
+    printing_depth := 0;
+    (* printf "Recompute printing_map.@."; *)
+    let cont =
+      Env.iter_types
+        (fun p (p', _decl) ->
+          let (p1, s1) = normalize_type_path env p' ~cache:true in
+          (* Format.eprintf "%a -> %a = %a@." path p path p' path p1 *)
+          if s1 = Id then
+          try
+            let r = Path.Map.find p1 !printing_map in
+            match !r with
+              Paths l -> r := Paths (p :: l)
+            | Best p' -> r := Paths [p; p'] (* assert false *)
+          with Not_found ->
+            printing_map := Path.Map.add p1 (ref (Paths [p])) !printing_map)
+        env in
+    printing_cont := [cont];
+  end
+
+let wrap_printing_env env f =
+  set_printing_env env;
+  try_finally f ~always:(fun () -> set_printing_env Env.empty)
+
+let wrap_printing_env ~error env f =
+  if error then Env.without_cmis (wrap_printing_env env) f
+  else wrap_printing_env env f
+
+let rec lid_of_path = function
+    Path.Pident id ->
+      Longident.Lident (Ident.name id)
+  | Path.Pdot (p1, s) | Path.Pextra_ty (p1, Pcstr_ty s)  ->
+      Longident.Ldot (lid_of_path p1, s)
+  | Path.Papply (p1, p2) ->
+      Longident.Lapply (lid_of_path p1, lid_of_path p2)
+  | Path.Pextra_ty (p, Pext_ty) -> lid_of_path p
+
+let is_unambiguous path env =
+  let l = Env.find_shadowed_types path env in
+  List.exists (Path.same path) l || (* concrete paths are ok *)
+  match l with
+    [] -> true
+  | p :: rem ->
+      (* allow also coherent paths:  *)
+      let normalize p = fst (normalize_type_path ~cache:true env p) in
+      let p' = normalize p in
+      List.for_all (fun p -> Path.same (normalize p) p') rem ||
+      (* also allow repeatedly defining and opening (for toplevel) *)
+      let id = lid_of_path p in
+      List.for_all (fun p -> lid_of_path p = id) rem &&
+      Path.same p (fst (Env.find_type_by_name id env))
+
+let rec get_best_path r =
+  match !r with
+    Best p' -> p'
+  | Paths [] -> raise Not_found
+  | Paths l ->
+      r := Paths [];
+      List.iter
+        (fun p ->
+          (* Format.eprintf "evaluating %a@." path p; *)
+          match !r with
+            Best p' when path_size p >= path_size p' -> ()
+          | _ -> if is_unambiguous p !printing_env then r := Best p)
+              (* else Format.eprintf "%a ignored as ambiguous@." path p *)
+        l;
+      get_best_path r
+
+let best_type_path p =
+  if !printing_env == Env.empty
+  then (p, Id)
+  else if !Clflags.real_paths
+  then (p, Id)
+  else
+    let (p', s) = normalize_type_path !printing_env p in
+    let get_path () = get_best_path (Path.Map.find  p' !printing_map) in
+    while !printing_cont <> [] &&
+      try fst (path_size (get_path ())) > !printing_depth with Not_found -> true
+    do
+      printing_cont := List.map snd (Env.run_iter_cont !printing_cont);
+      incr printing_depth;
+    done;
+    let p'' = try get_path () with Not_found -> p' in
+    (* Format.eprintf "%a = %a -> %a@." path p path p' path p''; *)
+    (p'', s)
+
+(* When building a tree for a best type path, we should not disambiguate
+   identifiers whenever the short-path algorithm detected a better path than
+   the original one.*)
+let tree_of_best_type_path p p' =
+  if Path.same p p' then tree_of_path (Some Type) p'
+  else tree_of_path ~disambiguation:false None p'
+
+(* Print a type expression *)
+
+let proxy ty = Transient_expr.repr (proxy ty)
+
+(* When printing a type scheme, we print weak names.  When printing a plain
+   type, we do not.  This type controls that behavior *)
+type type_or_scheme = Type | Type_scheme
+
+let is_non_gen mode ty =
+  match mode with
+  | Type_scheme -> is_Tvar ty && get_level ty <> generic_level
+  | Type        -> false
+
+let nameable_row row =
+  row_name row <> None &&
+  List.for_all
+    (fun (_, f) ->
+       match row_field_repr f with
+       | Reither(c, l, _) ->
+           row_closed row && if c then l = [] else List.length l = 1
+       | _ -> true)
+    (row_fields row)
+
+(* This specialized version of [Btype.iter_type_expr] normalizes and
+   short-circuits the traversal of the [type_expr], so that it covers only the
+   subterms that would be printed by the type printer. *)
+let printer_iter_type_expr f ty =
+  match get_desc ty with
+  | Tconstr(p, tyl, _) ->
+      let (_p', s) = best_type_path p in
+      List.iter f (apply_subst s tyl)
+  | Tvariant row -> begin
+      match row_name row with
+      | Some(_p, tyl) when nameable_row row ->
+          List.iter f tyl
+      | _ ->
+          iter_row f row
+    end
+  | Tobject (fi, nm) -> begin
+      match !nm with
+      | None ->
+          let fields, _ = flatten_fields fi in
+          List.iter
+            (fun (_, kind, ty) ->
+               if field_kind_repr kind = Fpublic then
+                 f ty)
+            fields
+      | Some (_, l) ->
+          List.iter f (List.tl l)
+    end
+  | Tfield(_, kind, ty1, ty2) ->
+      if field_kind_repr kind = Fpublic then
+        f ty1;
+      f ty2
+  | _ ->
+      Btype.iter_type_expr f ty
+
+let quoted_ident ppf x =
+  Style.as_inline_code !Oprint.out_ident ppf x
+
+module Internal_names : sig
+
+  val reset : unit -> unit
+
+  val add : Path.t -> unit
+
+  val print_explanations : Env.t -> Fmt.formatter -> unit
+
+end = struct
+
+  let names = ref Ident.Set.empty
+
+  let reset () =
+    names := Ident.Set.empty
+
+  let add p =
+    match p with
+    | Pident id ->
+        let name = Ident.name id in
+        if String.length name > 0 && name.[0] = '$' then begin
+          names := Ident.Set.add id !names
+        end
+    | Pdot _ | Papply _ | Pextra_ty _ -> ()
+
+  let print_explanations env ppf =
+    let constrs =
+      Ident.Set.fold
+        (fun id acc ->
+          let p = Pident id in
+          match Env.find_type p env with
+          | exception Not_found -> acc
+          | decl ->
+              match type_origin decl with
+              | Existential constr ->
+                  let prev = String.Map.find_opt constr acc in
+                  let prev = Option.value ~default:[] prev in
+                  String.Map.add constr (tree_of_path None p :: prev) acc
+              | Definition | Rec_check_regularity -> acc)
+        !names String.Map.empty
+    in
+    String.Map.iter
+      (fun constr out_idents ->
+        match out_idents with
+        | [] -> ()
+        | [out_ident] ->
+            fprintf ppf
+              "@ @[<2>@{<hint>Hint@}:@ %a@ is an existential type@ \
+               bound by the constructor@ %a.@]"
+              quoted_ident out_ident
+              Style.inline_code constr
+        | out_ident :: out_idents ->
+            fprintf ppf
+              "@ @[<2>@{<hint>Hint@}:@ %a@ and %a@ are existential types@ \
+               bound by the constructor@ %a.@]"
+              (Fmt.pp_print_list
+                 ~pp_sep:(fun ppf () -> fprintf ppf ",@ ")
+                 quoted_ident)
+              (List.rev out_idents)
+              quoted_ident out_ident
+              Style.inline_code constr)
+      constrs
+
+end
+
+module Variable_names : sig
+  val reset_names : unit -> unit
+
+  val add_subst : (type_expr * type_expr) list -> unit
+
+  val new_name : unit -> string
+  val new_var_name : non_gen:bool -> type_expr -> unit -> string
+
+  val name_of_type : (unit -> string) -> transient_expr -> string
+  val check_name_of_type : non_gen:bool -> transient_expr -> unit
+
+
+  val reserve: type_expr -> unit
+
+  val remove_names : transient_expr list -> unit
+
+  val with_local_names : (unit -> 'a) -> 'a
+
+  (* Refresh the weak variable map in the toplevel; for [print_items], which is
+     itself for the toplevel *)
+  val refresh_weak : unit -> unit
+end = struct
+  (* We map from types to names, but not directly; we also store a substitution,
+     which maps from types to types.  The lookup process is
+     "type -> apply substitution -> find name".  The substitution is presumed to
+     be one-shot. *)
+  let names = ref ([] : (transient_expr * string) list)
+  let name_subst = ref ([] : (transient_expr * transient_expr) list)
+  let name_counter = ref 0
+  let named_vars = ref ([] : string list)
+  let visited_for_named_vars = ref ([] : transient_expr list)
+
+  let weak_counter = ref 1
+  let weak_var_map = ref TypeMap.empty
+  let named_weak_vars = ref String.Set.empty
+
+  let reset_names () =
+    names := [];
+    name_subst := [];
+    name_counter := 0;
+    named_vars := [];
+    visited_for_named_vars := []
+
+  let add_named_var tty =
+    match tty.desc with
+      Tvar (Some name) | Tunivar (Some name) ->
+        if List.mem name !named_vars then () else
+        named_vars := name :: !named_vars
+    | _ -> ()
+
+  let rec add_named_vars ty =
+    let tty = Transient_expr.repr ty in
+    let px = proxy ty in
+    if not (List.memq px !visited_for_named_vars) then begin
+      visited_for_named_vars := px :: !visited_for_named_vars;
+      match tty.desc with
+      | Tvar _ | Tunivar _ ->
+          add_named_var tty
+      | _ ->
+          printer_iter_type_expr add_named_vars ty
+    end
+
+  let substitute ty =
+    match List.assq ty !name_subst with
+    | ty' -> ty'
+    | exception Not_found -> ty
+
+  let add_subst subst =
+    name_subst :=
+      List.map (fun (t1,t2) -> Transient_expr.repr t1, Transient_expr.repr t2)
+        subst
+      @ !name_subst
+
+  let name_is_already_used name =
+    List.mem name !named_vars
+    || List.exists (fun (_, name') -> name = name') !names
+    || String.Set.mem name !named_weak_vars
+
+  let rec new_name () =
+    let name = Misc.letter_of_int !name_counter in
+    incr name_counter;
+    if name_is_already_used name then new_name () else name
+
+  let rec new_weak_name ty () =
+    let name = "weak" ^ Int.to_string !weak_counter in
+    incr weak_counter;
+    if name_is_already_used name then new_weak_name ty ()
+    else begin
+        named_weak_vars := String.Set.add name !named_weak_vars;
+        weak_var_map := TypeMap.add ty name !weak_var_map;
+        name
+      end
+
+  let new_var_name ~non_gen ty () =
+    if non_gen then new_weak_name ty ()
+    else new_name ()
+
+  let name_of_type name_generator t =
+    (* We've already been through repr at this stage, so t is our representative
+       of the union-find class. *)
+    let t = substitute t in
+    try List.assq t !names with Not_found ->
+      try TransientTypeMap.find t !weak_var_map with Not_found ->
+      let name =
+        match t.desc with
+          Tvar (Some name) | Tunivar (Some name) ->
+            (* Some part of the type we've already printed has assigned another
+             * unification variable to that name. We want to keep the name, so
+             * try adding a number until we find a name that's not taken. *)
+            let available name =
+              List.for_all
+                (fun (_, name') -> name <> name')
+                !names
+            in
+            if available name then name
+            else
+              let suffixed i = name ^ Int.to_string i in
+              let i = Misc.find_first_mono (fun i -> available (suffixed i)) in
+              suffixed i
+        | _ ->
+            (* No name available, create a new one *)
+            name_generator ()
+      in
+      (* Exception for type declarations *)
+      if name <> "_" then names := (t, name) :: !names;
+      name
+
+  let check_name_of_type ~non_gen px =
+    let name_gen = new_var_name ~non_gen (Transient_expr.type_expr px) in
+    ignore(name_of_type name_gen px)
+
+  let remove_names tyl =
+    let tyl = List.map substitute tyl in
+    names := List.filter (fun (ty,_) -> not (List.memq ty tyl)) !names
+
+  let with_local_names f =
+    let old_names = !names in
+    let old_subst = !name_subst in
+    names      := [];
+    name_subst := [];
+    try_finally
+      ~always:(fun () ->
+        names      := old_names;
+        name_subst := old_subst)
+      f
+
+  let refresh_weak () =
+    let refresh t name (m,s) =
+      if is_non_gen Type_scheme t then
+        begin
+          TypeMap.add t name m,
+          String.Set.add name s
+        end
+      else m, s in
+    let m, s =
+      TypeMap.fold refresh !weak_var_map (TypeMap.empty ,String.Set.empty) in
+    named_weak_vars := s;
+    weak_var_map := m
+
+  let reserve ty =
+    normalize_type ty;
+    add_named_vars ty
+end
+
+module Aliases = struct
+  let visited_objects = ref ([] : transient_expr list)
+  let aliased = ref ([] : transient_expr list)
+  let delayed = ref ([] : transient_expr list)
+  let printed_aliases = ref ([] : transient_expr list)
+
+(* [printed_aliases] is a subset of [aliased] that records only those aliased
+   types that have actually been printed; this allows us to avoid naming loops
+   that the user will never see. *)
+
+  let is_delayed t = List.memq t !delayed
+
+  let remove_delay t =
+    if is_delayed t then
+      delayed := List.filter ((!=) t) !delayed
+
+  let add_delayed t =
+    if not (is_delayed t) then delayed := t :: !delayed
+
+  let is_aliased_proxy px = List.memq px !aliased
+  let is_printed_proxy px = List.memq px !printed_aliases
+
+  let add_proxy px =
+    if not (is_aliased_proxy px) then
+      aliased := px :: !aliased
+
+  let add ty = add_proxy (proxy ty)
+
+  let add_printed_proxy ~non_gen px =
+    Variable_names.check_name_of_type ~non_gen px;
+    printed_aliases := px :: !printed_aliases
+
+  let mark_as_printed px =
+     if is_aliased_proxy px then (add_printed_proxy ~non_gen:false) px
+
+  let add_printed ty = add_printed_proxy (proxy ty)
+
+  let aliasable ty =
+    match get_desc ty with
+      Tvar _ | Tunivar _ | Tpoly _ -> false
+    | Tconstr (p, _, _) ->
+        not (is_nth (snd (best_type_path p)))
+    | _ -> true
+
+  let should_visit_object ty =
+    match get_desc ty with
+    | Tvariant row -> not (static_row row)
+    | Tobject _ -> opened_object ty
+    | _ -> false
+
+  let rec mark_loops_rec visited ty =
+    let px = proxy ty in
+    if List.memq px visited && aliasable ty then add_proxy px else
+      let tty = Transient_expr.repr ty in
+      let visited = px :: visited in
+      match tty.desc with
+      | Tvariant _ | Tobject _ ->
+          if List.memq px !visited_objects then add_proxy px else begin
+            if should_visit_object ty then
+              visited_objects := px :: !visited_objects;
+            printer_iter_type_expr (mark_loops_rec visited) ty
+          end
+      | Tpoly(ty, tyl) ->
+          List.iter add tyl;
+          mark_loops_rec visited ty
+      | _ ->
+          printer_iter_type_expr (mark_loops_rec visited) ty
+
+  let mark_loops ty =
+    mark_loops_rec [] ty
+
+  let reset () =
+    visited_objects := []; aliased := []; delayed := []; printed_aliases := []
+
+end
+
+let prepare_type ty =
+  Variable_names.reserve ty;
+  Aliases.mark_loops ty
+
+
+let reset_except_conflicts () =
+  Variable_names.reset_names (); Aliases.reset (); Internal_names.reset ()
+
+let reset () =
+  Ident_conflicts.reset ();
+  reset_except_conflicts ()
+
+let prepare_for_printing tyl =
+  reset_except_conflicts ();
+  List.iter prepare_type tyl
+
+let add_type_to_preparation = prepare_type
+
+(* Disabled in classic mode when printing an unification error *)
+let print_labels = ref true
+let with_labels b f = Misc.protect_refs [R (print_labels,b)] f
+
+let alias_nongen_row mode px ty =
+    match get_desc ty with
+    | Tvariant _ | Tobject _ ->
+        if is_non_gen mode (Transient_expr.type_expr px) then
+          Aliases.add_proxy px
+    | _ -> ()
+
+let rec tree_of_typexp mode ty =
+  let px = proxy ty in
+  if Aliases.is_printed_proxy px && not (Aliases.is_delayed px) then
+   let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
+   let name = Variable_names.(name_of_type (new_var_name ~non_gen ty)) px in
+   Otyp_var (non_gen, name) else
+
+  let pr_typ () =
+    let tty = Transient_expr.repr ty in
+    match tty.desc with
+    | Tvar _ ->
+        let non_gen = is_non_gen mode ty in
+        let name_gen = Variable_names.new_var_name ~non_gen ty in
+        Otyp_var (non_gen, Variable_names.name_of_type name_gen tty)
+    | Tarrow(l, ty1, ty2, _) ->
+        let lab =
+          if !print_labels || is_optional l then l else Nolabel
+        in
+        let t1 =
+          if is_optional l then
+            match get_desc ty1 with
+            | Tconstr(path, [ty], _)
+              when Path.same path Predef.path_option ->
+                tree_of_typexp mode ty
+            | _ -> Otyp_stuff "<hidden>"
+          else tree_of_typexp mode ty1 in
+        Otyp_arrow (lab, t1, tree_of_typexp mode ty2)
+    | Ttuple tyl ->
+        Otyp_tuple (tree_of_typlist mode tyl)
+    | Tconstr(p, tyl, _abbrev) ->
+        let p', s = best_type_path p in
+        let tyl' = apply_subst s tyl in
+        if is_nth s && not (tyl'=[])
+        then tree_of_typexp mode (List.hd tyl')
+        else begin
+          Internal_names.add p';
+          Otyp_constr (tree_of_best_type_path p p', tree_of_typlist mode tyl')
+        end
+    | Tvariant row ->
+        let Row {fields; name; closed; _} = row_repr row in
+        let fields =
+          if closed then
+            List.filter (fun (_, f) -> row_field_repr f <> Rabsent)
+              fields
+          else fields in
+        let present =
+          List.filter
+            (fun (_, f) ->
+               match row_field_repr f with
+               | Rpresent _ -> true
+               | _ -> false)
+            fields in
+        let all_present = List.length present = List.length fields in
+        begin match name with
+        | Some(p, tyl) when nameable_row row ->
+            let (p', s) = best_type_path p in
+            let id = tree_of_best_type_path p p' in
+            let args = tree_of_typlist mode (apply_subst s tyl) in
+            let out_variant =
+              if is_nth s then List.hd args else Otyp_constr (id, args) in
+            if closed && all_present then
+              out_variant
+            else
+              let tags =
+                if all_present then None else Some (List.map fst present) in
+              Otyp_variant (Ovar_typ out_variant, closed, tags)
+        | _ ->
+            let fields = List.map (tree_of_row_field mode) fields in
+            let tags =
+              if all_present then None else Some (List.map fst present) in
+            Otyp_variant (Ovar_fields fields, closed, tags)
+        end
+    | Tobject (fi, nm) ->
+        tree_of_typobject mode fi !nm
+    | Tnil | Tfield _ ->
+        tree_of_typobject mode ty None
+    | Tsubst _ ->
+        (* This case should only happen when debugging the compiler *)
+        Otyp_stuff "<Tsubst>"
+    | Tlink _ ->
+        fatal_error "Out_type.tree_of_typexp"
+    | Tpoly (ty, []) ->
+        tree_of_typexp mode ty
+    | Tpoly (ty, tyl) ->
+        (*let print_names () =
+          List.iter (fun (_, name) -> prerr_string (name ^ " ")) !names;
+          prerr_string "; " in *)
+        if tyl = [] then tree_of_typexp mode ty else begin
+          let tyl = List.map Transient_expr.repr tyl in
+          let old_delayed = !Aliases.delayed in
+          (* Make the names delayed, so that the real type is
+             printed once when used as proxy *)
+          List.iter Aliases.add_delayed tyl;
+          let tl = List.map Variable_names.(name_of_type new_name) tyl in
+          let tr = Otyp_poly (tl, tree_of_typexp mode ty) in
+          (* Forget names when we leave scope *)
+          Variable_names.remove_names tyl;
+          Aliases.delayed := old_delayed; tr
+        end
+    | Tunivar _ ->
+        Otyp_var (false, Variable_names.(name_of_type new_name) tty)
+    | Tpackage (p, fl) ->
+        let fl =
+          List.map
+            (fun (li, ty) -> (
+              String.concat "." (Longident.flatten li),
+              tree_of_typexp mode ty
+            )) fl in
+        Otyp_module (tree_of_path (Some Module_type) p, fl)
+  in
+  Aliases.remove_delay px;
+  alias_nongen_row mode px ty;
+  if Aliases.(is_aliased_proxy px && aliasable ty) then begin
+    let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
+    Aliases.add_printed_proxy ~non_gen px;
+    (* add_printed_alias chose a name, thus the name generator
+       doesn't matter.*)
+    let alias = Variable_names.(name_of_type (new_var_name ~non_gen ty)) px in
+    Otyp_alias {non_gen;  aliased = pr_typ (); alias } end
+  else pr_typ ()
+
+and tree_of_row_field mode (l, f) =
+  match row_field_repr f with
+  | Rpresent None | Reither(true, [], _) -> (l, false, [])
+  | Rpresent(Some ty) -> (l, false, [tree_of_typexp mode ty])
+  | Reither(c, tyl, _) ->
+      if c (* contradiction: constant constructor with an argument *)
+      then (l, true, tree_of_typlist mode tyl)
+      else (l, false, tree_of_typlist mode tyl)
+  | Rabsent -> (l, false, [] (* actually, an error *))
+
+and tree_of_typlist mode tyl =
+  List.map (tree_of_typexp mode) tyl
+
+and tree_of_typobject mode fi nm =
+  begin match nm with
+  | None ->
+      let pr_fields fi =
+        let (fields, rest) = flatten_fields fi in
+        let present_fields =
+          List.fold_right
+            (fun (n, k, t) l ->
+               match field_kind_repr k with
+               | Fpublic -> (n, t) :: l
+               | _ -> l)
+            fields [] in
+        let sorted_fields =
+          List.sort
+            (fun (n, _) (n', _) -> String.compare n n') present_fields in
+        tree_of_typfields mode rest sorted_fields in
+      let (fields, open_row) = pr_fields fi in
+      Otyp_object {fields; open_row}
+  | Some (p, _ty :: tyl) ->
+      let args = tree_of_typlist mode tyl in
+      let (p', s) = best_type_path p in
+      assert (s = Id);
+      Otyp_class (tree_of_best_type_path p p', args)
+  | _ ->
+      fatal_error "Out_type.tree_of_typobject"
+  end
+
+and tree_of_typfields mode rest = function
+  | [] ->
+      let open_row =
+        match get_desc rest with
+        | Tvar _ | Tunivar _ | Tconstr _-> true
+        | Tnil -> false
+        | _ -> fatal_error "typfields (1)"
+      in
+      ([], open_row)
+  | (s, t) :: l ->
+      let field = (s, tree_of_typexp mode t) in
+      let (fields, rest) = tree_of_typfields mode rest l in
+      (field :: fields, rest)
+
+let typexp mode ppf ty =
+  !Oprint.out_type ppf (tree_of_typexp mode ty)
+
+let prepared_type_expr ppf ty = typexp Type ppf ty
+
+(* "Half-prepared" type expression: [ty] should have had its names reserved, but
+   should not have had its loops marked. *)
+let type_expr_with_reserved_names ppf ty =
+  Aliases.reset ();
+  Aliases.mark_loops ty;
+  prepared_type_expr ppf ty
+
+
+let prepared_type_scheme ppf ty = typexp Type_scheme ppf ty
+
+(* Print one type declaration *)
+
+let tree_of_constraints params =
+  List.fold_right
+    (fun ty list ->
+       let ty' = unalias ty in
+       if proxy ty != proxy ty' then
+         let tr = tree_of_typexp Type_scheme ty in
+         (tr, tree_of_typexp Type_scheme ty') :: list
+       else list)
+    params []
+
+let filter_params tyl =
+  let params =
+    List.fold_left
+      (fun tyl ty ->
+        if List.exists (eq_type ty) tyl
+        then newty2 ~level:generic_level (Ttuple [ty]) :: tyl
+        else ty :: tyl)
+      (* Two parameters might be identical due to a constraint but we need to
+         print them differently in order to make the output syntactically valid.
+         We use [Ttuple [ty]] because it is printed as [ty]. *)
+      (* Replacing fold_left by fold_right does not work! *)
+      [] tyl
+  in List.rev params
+
+let prepare_type_constructor_arguments = function
+  | Cstr_tuple l -> List.iter prepare_type l
+  | Cstr_record l -> List.iter (fun l -> prepare_type l.ld_type) l
+
+let tree_of_label l =
+  {
+    olab_name = Ident.name l.ld_id;
+    olab_mut = l.ld_mutable;
+    olab_type = tree_of_typexp Type l.ld_type;
+  }
+
+let tree_of_constructor_arguments = function
+  | Cstr_tuple l -> tree_of_typlist Type l
+  | Cstr_record l -> [ Otyp_record (List.map tree_of_label l) ]
+
+let tree_of_single_constructor cd =
+  let name = Ident.name cd.cd_id in
+  let ret = Option.map (tree_of_typexp Type) cd.cd_res in
+  let args = tree_of_constructor_arguments cd.cd_args in
+  {
+      ocstr_name = name;
+      ocstr_args = args;
+      ocstr_return_type = ret;
+  }
+
+(* When printing GADT constructor, we need to forget the naming decision we took
+  for the type parameters and constraints. Indeed, in
+  {[
+  type 'a t = X: 'a -> 'b t
+   ]}
+  It is fine to print both the type parameter ['a] and the existentially
+  quantified ['a] in the definition of the constructor X as ['a]
+ *)
+let tree_of_constructor_in_decl cd =
+  match cd.cd_res with
+  | None -> tree_of_single_constructor cd
+  | Some _ ->
+      Variable_names.with_local_names (fun () -> tree_of_single_constructor cd)
+
+let prepare_decl id decl =
+  let params = filter_params decl.type_params in
+  begin match decl.type_manifest with
+  | Some ty ->
+      let vars = free_variables ty in
+      List.iter
+        (fun ty ->
+          if get_desc ty = Tvar (Some "_") && List.exists (eq_type ty) vars
+          then set_type_desc ty (Tvar None))
+        params
+  | None -> ()
+  end;
+  List.iter Aliases.add params;
+  List.iter prepare_type params;
+  List.iter (Aliases.add_printed ~non_gen:false) params;
+  let ty_manifest =
+    match decl.type_manifest with
+    | None -> None
+    | Some ty ->
+        let ty =
+          (* Special hack to hide variant name *)
+          match get_desc ty with
+            Tvariant row ->
+              begin match row_name row with
+                Some (Pident id', _) when Ident.same id id' ->
+                  newgenty (Tvariant (set_row_name row None))
+              | _ -> ty
+              end
+          | _ -> ty
+        in
+        prepare_type ty;
+        Some ty
+  in
+  begin match decl.type_kind with
+  | Type_abstract _ -> ()
+  | Type_variant (cstrs, _rep) ->
+      List.iter
+        (fun c ->
+           prepare_type_constructor_arguments c.cd_args;
+           Option.iter prepare_type c.cd_res)
+        cstrs
+  | Type_record(l, _rep) ->
+      List.iter (fun l -> prepare_type l.ld_type) l
+  | Type_open -> ()
+  end;
+  ty_manifest, params
+
+let tree_of_type_decl id decl =
+  let ty_manifest, params = prepare_decl id decl in
+  let type_param ot_variance =
+    function
+    | Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
+    | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
+  in
+  let type_defined decl =
+    let abstr =
+      match decl.type_kind with
+        Type_abstract _ ->
+          decl.type_manifest = None || decl.type_private = Private
+      | Type_record _ ->
+          decl.type_private = Private
+      | Type_variant (tll, _rep) ->
+          decl.type_private = Private ||
+          List.exists (fun cd -> cd.cd_res <> None) tll
+      | Type_open ->
+          decl.type_manifest = None
+    in
+    let vari =
+      List.map2
+        (fun ty v ->
+          let is_var = is_Tvar ty in
+          if abstr || not is_var then
+            let inj =
+              type_kind_is_abstract decl && Variance.mem Inj v &&
+              match decl.type_manifest with
+              | None -> true
+              | Some ty -> (* only abstract or private row types *)
+                  decl.type_private = Private &&
+                  Btype.is_constr_row ~allow_ident:true (Btype.row_of_type ty)
+            and (co, cn) = Variance.get_upper v in
+            (if not cn then Covariant else
+             if not co then Contravariant else NoVariance),
+            (if inj then Injective else NoInjectivity)
+          else (NoVariance, NoInjectivity))
+        decl.type_params decl.type_variance
+    in
+    (Ident.name id,
+     List.map2 (fun ty cocn -> type_param cocn (tree_of_typexp Type ty))
+       params vari)
+  in
+  let tree_of_manifest ty1 =
+    match ty_manifest with
+    | None -> ty1
+    | Some ty -> Otyp_manifest (tree_of_typexp Type ty, ty1)
+  in
+  let (name, args) = type_defined decl in
+  let constraints = tree_of_constraints params in
+  let ty, priv, unboxed =
+    match decl.type_kind with
+    | Type_abstract _ ->
+        begin match ty_manifest with
+        | None -> (Otyp_abstract, Public, false)
+        | Some ty ->
+            tree_of_typexp Type ty, decl.type_private, false
+        end
+    | Type_variant (cstrs, rep) ->
+        tree_of_manifest
+          (Otyp_sum (List.map tree_of_constructor_in_decl cstrs)),
+        decl.type_private,
+        (rep = Variant_unboxed)
+    | Type_record(lbls, rep) ->
+        tree_of_manifest (Otyp_record (List.map tree_of_label lbls)),
+        decl.type_private,
+        (match rep with Record_unboxed _ -> true | _ -> false)
+    | Type_open ->
+        tree_of_manifest Otyp_open,
+        decl.type_private,
+        false
+  in
+    { otype_name = name;
+      otype_params = args;
+      otype_type = ty;
+      otype_private = priv;
+      otype_immediate = Type_immediacy.of_attributes decl.type_attributes;
+      otype_unboxed = unboxed;
+      otype_cstrs = constraints }
+
+let add_type_decl_to_preparation id decl =
+   ignore @@ prepare_decl id decl
+
+let tree_of_prepared_type_decl id decl =
+  tree_of_type_decl id decl
+
+let tree_of_type_decl id decl =
+  reset_except_conflicts();
+  tree_of_type_decl id decl
+
+let add_constructor_to_preparation c =
+  prepare_type_constructor_arguments c.cd_args;
+  Option.iter prepare_type c.cd_res
+
+let prepared_constructor ppf c =
+  !Oprint.out_constr ppf (tree_of_single_constructor c)
+
+
+let tree_of_type_declaration id decl rs =
+  Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
+
+let tree_of_prepared_type_declaration id decl rs =
+  Osig_type (tree_of_prepared_type_decl id decl, tree_of_rec rs)
+
+let add_type_declaration_to_preparation id decl =
+  add_type_decl_to_preparation id decl
+
+let prepared_type_declaration id ppf decl =
+  !Oprint.out_sig_item ppf
+    (tree_of_prepared_type_declaration id decl Trec_first)
+
+
+(* When printing extension constructor, it is important to ensure that
+after printing the constructor, we are still in the scope of the constructor.
+For GADT constructor, this can be done by printing the type parameters inside
+their own isolated scope. This ensures that in
+{[
+   type 'b t += A: 'b -> 'b any t
+]}
+the type parameter `'b` is not bound when printing the type variable `'b` from
+the constructor definition from the type parameter.
+
+Contrarily, for non-gadt constructor, we must keep the same scope for
+the type parameters and the constructor because a type constraint may
+have changed the name of the type parameter:
+{[
+type -'a t = .. constraint <x:'a. 'a t -> 'a> = 'a
+(* the universal 'a is here to steal the name 'a from the type parameter *)
+type 'a t = X of 'a
+]} *)
+let add_extension_constructor_to_preparation ext =
+  let ty_params = filter_params ext.ext_type_params in
+  List.iter Aliases.add ty_params;
+  List.iter prepare_type ty_params;
+  prepare_type_constructor_arguments ext.ext_args;
+  Option.iter prepare_type ext.ext_ret_type
+
+let extension_constructor_args_and_ret_type_subtree ext_args ext_ret_type =
+  let ret = Option.map (tree_of_typexp Type) ext_ret_type in
+  let args = tree_of_constructor_arguments ext_args in
+  (args, ret)
+
+let prepared_tree_of_extension_constructor
+   id ext es
+  =
+  let ty_name = Path.name ext.ext_type_path in
+  let ty_params = filter_params ext.ext_type_params in
+  let type_param =
+    function
+    | Otyp_var (_, id) -> id
+    | _ -> "?"
+  in
+  let param_scope f =
+    match ext.ext_ret_type with
+    | None ->
+        (* normal constructor: same scope for parameters and the constructor *)
+        f ()
+    | Some _ ->
+        (* gadt constructor: isolated scope for the type parameters *)
+        Variable_names.with_local_names f
+  in
+  let ty_params =
+    param_scope
+      (fun () ->
+         List.iter (Aliases.add_printed ~non_gen:false) ty_params;
+         List.map (fun ty -> type_param (tree_of_typexp Type ty)) ty_params
+      )
+  in
+  let name = Ident.name id in
+  let args, ret =
+    extension_constructor_args_and_ret_type_subtree
+      ext.ext_args
+      ext.ext_ret_type
+  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 tree_of_extension_constructor id ext es =
+  reset_except_conflicts ();
+  add_extension_constructor_to_preparation ext;
+  prepared_tree_of_extension_constructor id ext es
+
+let prepared_extension_constructor id ppf ext =
+  !Oprint.out_sig_item ppf
+    (prepared_tree_of_extension_constructor id ext Text_first)
+
+(* Print a value declaration *)
+
+let tree_of_value_description id decl =
+  (* Format.eprintf "@[%a@]@." raw_type_expr decl.val_type; *)
+  let id = Ident.name id in
+  let () = prepare_for_printing [decl.val_type] in
+  let ty = tree_of_typexp Type_scheme decl.val_type in
+  let vd =
+    { oval_name = id;
+      oval_type = ty;
+      oval_prims = [];
+      oval_attributes = [] }
+  in
+  let vd =
+    match decl.val_kind with
+    | Val_prim p -> Primitive.print p vd
+    | _ -> vd
+  in
+  Osig_value vd
+
+(* Print a class type *)
+
+let method_type priv ty =
+  match priv, get_desc ty with
+  | Mpublic, Tpoly(ty, tyl) -> (ty, tyl)
+  | _ , _ -> (ty, [])
+
+let prepare_method _lab (priv, _virt, ty) =
+  let ty, _ = method_type priv ty in
+  prepare_type ty
+
+let tree_of_method mode (lab, priv, virt, ty) =
+  let (ty, tyl) = method_type priv ty in
+  let tty = tree_of_typexp mode ty in
+  Variable_names.remove_names (List.map Transient_expr.repr tyl);
+  let priv = priv <> Mpublic in
+  let virt = virt = Virtual in
+  Ocsg_method (lab, priv, virt, tty)
+
+let rec prepare_class_type params = function
+  | Cty_constr (_p, tyl, cty) ->
+      let row = Btype.self_type_row cty in
+      if List.memq (proxy row) !Aliases.visited_objects
+      || not (List.for_all is_Tvar params)
+      || List.exists (deep_occur row) tyl
+      then prepare_class_type params cty
+      else List.iter prepare_type tyl
+  | Cty_signature sign ->
+      (* Self may have a name *)
+      let px = proxy sign.csig_self_row in
+      if List.memq px !Aliases.visited_objects then Aliases.add_proxy px
+      else Aliases.(visited_objects := px :: !visited_objects);
+      Vars.iter (fun _ (_, _, ty) -> prepare_type ty) sign.csig_vars;
+      Meths.iter prepare_method sign.csig_meths
+  | Cty_arrow (_, ty, cty) ->
+      prepare_type ty;
+      prepare_class_type params cty
+
+let rec tree_of_class_type mode params =
+  function
+  | Cty_constr (p', tyl, cty) ->
+      let row = Btype.self_type_row cty in
+      if List.memq (proxy row) !Aliases.visited_objects
+      || not (List.for_all is_Tvar params)
+      then
+        tree_of_class_type mode params cty
+      else
+        let namespace = Namespace.best_class_namespace p' in
+        Octy_constr (tree_of_path namespace p', tree_of_typlist Type_scheme tyl)
+  | Cty_signature sign ->
+      let px = proxy sign.csig_self_row in
+      let self_ty =
+        if Aliases.is_aliased_proxy px then
+          Some
+            (Otyp_var (false, Variable_names.(name_of_type new_name) px))
+        else None
+      in
+      let csil = [] in
+      let csil =
+        List.fold_left
+          (fun csil (ty1, ty2) -> Ocsg_constraint (ty1, ty2) :: csil)
+          csil (tree_of_constraints params)
+      in
+      let all_vars =
+        Vars.fold (fun l (m, v, t) all -> (l, m, v, t) :: all) sign.csig_vars []
+      in
+      (* Consequence of PR#3607: order of Map.fold has changed! *)
+      let all_vars = List.rev all_vars in
+      let csil =
+        List.fold_left
+          (fun csil (l, m, v, t) ->
+            Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp mode t)
+            :: csil)
+          csil all_vars
+      in
+      let all_meths =
+        Meths.fold
+          (fun l (p, v, t) all -> (l, p, v, t) :: all)
+          sign.csig_meths []
+      in
+      let all_meths = List.rev all_meths in
+      let csil =
+        List.fold_left
+          (fun csil meth -> tree_of_method mode meth :: csil)
+          csil all_meths
+      in
+      Octy_signature (self_ty, List.rev csil)
+  | Cty_arrow (l, ty, cty) ->
+      let lab =
+        if !print_labels || is_optional l then l else Nolabel
+      in
+      let tr =
+       if is_optional l then
+         match get_desc ty with
+         | Tconstr(path, [ty], _) when Path.same path Predef.path_option ->
+             tree_of_typexp mode ty
+         | _ -> Otyp_stuff "<hidden>"
+       else tree_of_typexp mode ty in
+      Octy_arrow (lab, tr, tree_of_class_type mode params cty)
+
+
+let tree_of_class_param param variance =
+  let ot_variance =
+    if is_Tvar param then Asttypes.(NoVariance, NoInjectivity) else variance in
+  match tree_of_typexp Type_scheme param with
+    Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
+  | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
+
+let class_variance =
+  let open Variance in let open Asttypes in
+  List.map (fun v ->
+    (if not (mem May_pos v) then Contravariant else
+     if not (mem May_neg v) then Covariant else NoVariance),
+    NoInjectivity)
+
+let tree_of_class_declaration id cl rs =
+  let params = filter_params cl.cty_params in
+
+  reset_except_conflicts ();
+  List.iter Aliases.add params;
+  prepare_class_type params cl.cty_type;
+  let px = proxy (Btype.self_type_row cl.cty_type) in
+  List.iter prepare_type params;
+
+  List.iter (Aliases.add_printed ~non_gen:false) params;
+  if Aliases.is_aliased_proxy px then
+    Aliases.add_printed_proxy ~non_gen:false px;
+
+  let vir_flag = cl.cty_new = None in
+  Osig_class
+    (vir_flag, Ident.name id,
+     List.map2 tree_of_class_param params (class_variance cl.cty_variance),
+     tree_of_class_type Type_scheme params cl.cty_type,
+     tree_of_rec rs)
+
+let tree_of_cltype_declaration id cl rs =
+  let params = cl.clty_params in
+
+  reset_except_conflicts ();
+  List.iter Aliases.add params;
+  prepare_class_type params cl.clty_type;
+  let px = proxy (Btype.self_type_row cl.clty_type) in
+  List.iter prepare_type params;
+
+  List.iter (Aliases.add_printed ~non_gen:false) params;
+  Aliases.mark_as_printed px;
+
+  let sign = Btype.signature_of_class_type cl.clty_type in
+  let has_virtual_vars =
+    Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
+      sign.csig_vars false
+  in
+  let has_virtual_meths =
+    Meths.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
+      sign.csig_meths false
+  in
+  Osig_class_type
+    (has_virtual_vars || has_virtual_meths, Ident.name id,
+     List.map2 tree_of_class_param params (class_variance cl.clty_variance),
+     tree_of_class_type Type_scheme params cl.clty_type,
+     tree_of_rec rs)
+
+(* Print a module type *)
+
+let wrap_env fenv ftree arg =
+  (* We save the current value of the short-path cache *)
+  (* From keys *)
+  let env = !printing_env in
+  let old_pers = !printing_pers in
+  (* to data *)
+  let old_map = !printing_map in
+  let old_depth = !printing_depth in
+  let old_cont = !printing_cont in
+  set_printing_env (fenv env);
+  let tree = ftree arg in
+  if !Clflags.real_paths
+     || same_printing_env env then ()
+   (* our cached key is still live in the cache, and we want to keep all
+      progress made on the computation of the [printing_map] *)
+  else begin
+    (* we restore the snapshotted cache before calling set_printing_env *)
+    printing_old := env;
+    printing_pers := old_pers;
+    printing_depth := old_depth;
+    printing_cont := old_cont;
+    printing_map := old_map
+  end;
+  set_printing_env env;
+  tree
+
+let dummy =
+  {
+    type_params = [];
+    type_arity = 0;
+    type_kind = Type_abstract Definition;
+    type_private = Public;
+    type_manifest = None;
+    type_variance = [];
+    type_separability = [];
+    type_is_newtype = false;
+    type_expansion_scope = Btype.lowest_level;
+    type_loc = Location.none;
+    type_attributes = [];
+    type_immediate = Unknown;
+    type_unboxed_default = false;
+    type_uid = Uid.internal_not_actually_unique;
+  }
+
+(** we hide items being defined from short-path to avoid shortening
+    [type t = Path.To.t] into [type t = t].
+*)
+
+let ident_sigitem = function
+  | Types.Sig_type(ident,_,_,_) ->  {hide=true;ident}
+  | Types.Sig_class(ident,_,_,_)
+  | Types.Sig_class_type (ident,_,_,_)
+  | Types.Sig_module(ident,_, _,_,_)
+  | Types.Sig_value (ident,_,_)
+  | Types.Sig_modtype (ident,_,_)
+  | Types.Sig_typext (ident,_,_,_)   ->  {hide=false; ident }
+
+let hide ids env =
+  let hide_id id env =
+    (* Global idents cannot be renamed *)
+    if id.hide && not (Ident.global id.ident) then
+      Env.add_type ~check:false (Ident.rename id.ident) dummy env
+    else env
+  in
+  List.fold_right hide_id ids env
+
+let with_hidden_items ids f =
+  let with_hidden_in_printing_env ids f =
+    wrap_env (hide ids) (Ident_names.with_hidden ids) f
+  in
+  if not !Clflags.real_paths then
+    with_hidden_in_printing_env ids f
+  else
+    Ident_names.with_hidden ids f
+
+
+let add_sigitem env x =
+  Env.add_signature (Signature_group.flatten x) env
+
+let rec tree_of_modtype ?(ellipsis=false) = function
+  | Mty_ident p ->
+      Omty_ident (tree_of_path (Some Module_type) p)
+  | Mty_signature sg ->
+      Omty_signature (if ellipsis then [Osig_ellipsis]
+                      else tree_of_signature sg)
+  | Mty_functor(param, ty_res) ->
+      let param, env =
+        tree_of_functor_parameter param
+      in
+      let res = wrap_env env (tree_of_modtype ~ellipsis) ty_res in
+      Omty_functor (param, res)
+  | Mty_alias p ->
+      Omty_alias (tree_of_path (Some Module) p)
+
+and tree_of_functor_parameter = function
+  | Unit ->
+      None, fun k -> k
+  | Named (param, ty_arg) ->
+      let name, env =
+        match param with
+        | None -> None, fun env -> env
+        | Some id ->
+            Some (Ident.name id),
+            Env.add_module ~arg:true id Mp_present ty_arg
+      in
+      Some (name, tree_of_modtype ~ellipsis:false ty_arg), env
+
+and tree_of_signature sg =
+  wrap_env (fun env -> env)(fun sg ->
+      let tree_groups = tree_of_signature_rec !printing_env sg in
+      List.concat_map (fun (_env,l) -> List.map snd l) tree_groups
+    ) sg
+
+and tree_of_signature_rec env' sg =
+  let structured = List.of_seq (Signature_group.seq sg) in
+  let collect_trees_of_rec_group group =
+    let env = !printing_env in
+    let env', group_trees =
+       trees_of_recursive_sigitem_group env group
+    in
+    set_printing_env env';
+    (env, group_trees) in
+  set_printing_env env';
+  List.map collect_trees_of_rec_group structured
+
+and trees_of_recursive_sigitem_group env
+    (syntactic_group: Signature_group.rec_group) =
+  let display (x:Signature_group.sig_item) = x.src, tree_of_sigitem x.src in
+  let env = Env.add_signature syntactic_group.pre_ghosts env in
+  match syntactic_group.group with
+  | Not_rec x -> add_sigitem env x, [display x]
+  | Rec_group items ->
+      let ids = List.map (fun x -> ident_sigitem x.Signature_group.src) items in
+      List.fold_left add_sigitem env items,
+      with_hidden_items ids (fun () -> List.map display items)
+
+and tree_of_sigitem = function
+  | Sig_value(id, decl, _) ->
+      tree_of_value_description id decl
+  | Sig_type(id, decl, rs, _) ->
+      tree_of_type_declaration id decl rs
+  | Sig_typext(id, ext, es, _) ->
+      tree_of_extension_constructor id ext es
+  | Sig_module(id, _, md, rs, _) ->
+      let ellipsis =
+        List.exists (function
+          | Parsetree.{attr_name = {txt="..."}; attr_payload = PStr []} -> true
+          | _ -> false)
+          md.md_attributes in
+      tree_of_module id md.md_type rs ~ellipsis
+  | Sig_modtype(id, decl, _) ->
+      tree_of_modtype_declaration id decl
+  | Sig_class(id, decl, rs, _) ->
+      tree_of_class_declaration id decl rs
+  | Sig_class_type(id, decl, rs, _) ->
+      tree_of_cltype_declaration id decl rs
+
+and tree_of_modtype_declaration id decl =
+  let mty =
+    match decl.mtd_type with
+    | None -> Omty_abstract
+    | Some mty -> tree_of_modtype mty
+  in
+  Osig_modtype (Ident.name id, mty)
+
+and tree_of_module id ?ellipsis mty rs =
+  Osig_module (Ident.name id, tree_of_modtype ?ellipsis mty, tree_of_rec rs)
+
+(* For the toplevel: merge with tree_of_signature? *)
+let print_items showval env x =
+  Variable_names.refresh_weak();
+  Ident_conflicts.reset ();
+  let extend_val env (sigitem,outcome) = outcome, showval env sigitem in
+  let post_process (env,l) = List.map (extend_val env) l in
+  List.concat_map post_process @@ tree_of_signature_rec env x
+
+let same_path t t' =
+  let open Types in
+  eq_type t t' ||
+  match get_desc t, get_desc t' with
+    Tconstr(p,tl,_), Tconstr(p',tl',_) ->
+      let (p1, s1) = best_type_path p and (p2, s2)  = best_type_path p' in
+      begin match s1, s2 with
+        Nth n1, Nth n2 when n1 = n2 -> true
+      | (Id | Map _), (Id | Map _) when Path.same p1 p2 ->
+          let tl = apply_subst s1 tl and tl' = apply_subst s2 tl' in
+          List.length tl = List.length tl' &&
+          List.for_all2 eq_type tl tl'
+      | _ -> false
+      end
+  | _ ->
+      false
+
+type 'a diff = Same of 'a | Diff of 'a * 'a
+
+let trees_of_type_expansion mode Errortrace.{ty = t; expanded = t'} =
+  Aliases.reset ();
+  Aliases.mark_loops t;
+  if same_path t t'
+  then begin Aliases.add_delayed (proxy t); Same (tree_of_typexp mode t) end
+  else begin
+    Aliases.mark_loops t';
+    let t' = if proxy t == proxy t' then unalias t' else t' in
+    (* beware order matter due to side effect,
+       e.g. when printing object types *)
+    let first = tree_of_typexp mode t in
+    let second = tree_of_typexp mode t' in
+    if first = second then Same first
+    else Diff(first,second)
+  end
+
+let pp_type ppf t =
+  Style.as_inline_code !Oprint.out_type ppf t
+
+let pp_type_expansion ppf = function
+  | Same t -> pp_type ppf t
+  | Diff(t,t') ->
+      fprintf ppf "@[<2>%a@ =@ %a@]"
+        pp_type t
+        pp_type t'
+
+(* Hide variant name and var, to force printing the expanded type *)
+let hide_variant_name t =
+  let open Types in
+  match get_desc t with
+  | Tvariant row ->
+      let Row {fields; more; name; fixed; closed} = row_repr row in
+      if name = None then t else
+      Btype.newty2 ~level:(get_level t)
+        (Tvariant
+           (create_row ~fields ~fixed ~closed ~name:None
+              ~more:(Ctype.newvar2 (get_level more))))
+  | _ -> t
+
+let prepare_expansion Errortrace.{ty; expanded} =
+  let expanded = hide_variant_name expanded in
+  Variable_names.reserve ty;
+  if not (same_path ty expanded) then Variable_names.reserve expanded;
+  Errortrace.{ty; expanded}
+
+
+(* Adapt functions to exposed interface *)
+let namespaced_tree_of_path n = tree_of_path (Some n)
+let tree_of_path ?disambiguation p = tree_of_path ?disambiguation None p
+let tree_of_modtype = tree_of_modtype ~ellipsis:false
+let tree_of_type_declaration ident td rs =
+  with_hidden_items [{hide=true; ident}]
+    (fun () -> tree_of_type_declaration ident td rs)
+
+let tree_of_class_type kind cty = tree_of_class_type kind [] cty
+let prepare_class_type cty = prepare_class_type [] cty
+
+let tree_of_type_path p =
+  let (p', s) = best_type_path p in
+  let p'' = if (s = Id) then p' else p in
+  tree_of_best_type_path p p''

diff --git a/typing/out_type.mli b/typing/out_type.mli
new file mode 100644 (file)
index 0000000..b134fa1
--- /dev/null
+++ b/typing/out_type.mli
@@ -0,0 +1,259 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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 Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Functions for representing type expressions and module types as outcometree
+    (with [as 'a] aliases for cycles) and printing them. All functions below
+    depends on global contexts that keep track of
+
+- If labels are disabled
+- Current printing environment
+- Shortest equivalent paths
+
+- Conflicts for identifier names
+- Names chosen for type variables
+- Aliases used for representing cycles or row variables
+- Uses of internal names
+
+Whenever possible, it is advised to use the simpler functions available in
+{!Printtyp} which take care of setting up this naming context. The functions
+below are needed when one needs to share a common naming context (or part of it)
+between different calls to printing functions (or in order to implement
+{!Printtyp}).
+*)
+
+open Format_doc
+open Types
+open Outcometree
+
+(** {1 Wrapping functions}*)
+
+val wrap_printing_env: error:bool -> Env.t -> (unit -> 'a) -> 'a
+(** Call the function using the environment for type path shortening
+    This affects all the printing and tree cration functions functions below
+    Also, if [~error:true], then disable the loading of cmis *)
+
+
+(** [with_labels false] disable labels in function types *)
+val with_labels: bool -> (unit -> 'a) -> 'a
+
+(** {1 Printing idents and paths } *)
+
+val ident_name: Shape.Sig_component_kind.t option -> Ident.t -> out_name
+val tree_of_path: ?disambiguation:bool -> Path.t -> out_ident
+val namespaced_tree_of_path: Shape.Sig_component_kind.t -> Path.t -> out_ident
+val tree_of_type_path: Path.t -> out_ident
+(** Specialized functions for printing types with [short-paths] *)
+
+(** [same_path ty ty2] is true when there is an equation [ty]=[ty2] in the
+    short-path scope*)
+val same_path: type_expr -> type_expr -> bool
+
+(** Simple heuristic to rewrite Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
+   for Foo__bar. This pattern is used by the stdlib. *)
+val rewrite_double_underscore_paths: Env.t -> Path.t -> Path.t
+
+(** {1 Printing type expressions} *)
+
+(** Printing type expressions requires to translate the internal graph based
+    representation into to an {!Outcometree} closer to the source syntax. In
+    order to do so, the printing is generally split in three phase:
+     - A preparation phase which in particular
+         - marks cycles
+         - chooses user-facing names for type variables
+     - An outcometree generation phase, where we emit an outcometree as a
+     ready-for-printing representation of trees (represented by the various
+     [tree_of_*] functions)
+   - Printing proper
+*)
+
+(** [prepare_for_printing] resets the global naming environment, a la
+    {!reset_except_conflicts}, and prepares the types for printing by reserving
+    variable names and marking cycles. Any type variables that are shared
+    between multiple types in the input list will be given the same name when
+    printed with {!prepared_type_expr}. *)
+val prepare_for_printing: type_expr list -> unit
+
+(** [add_type_to_preparation ty] extend a previous type expression preparation
+    to the type expression [ty]
+*)
+val add_type_to_preparation: type_expr -> unit
+
+(** In [Type_scheme] mode, non-generic types variables are printed as weakly
+    polymorphic type variables. *)
+type type_or_scheme = Type | Type_scheme
+val tree_of_typexp: type_or_scheme -> type_expr -> out_type
+(** [tree_of_typexp] generate the [outcometree] for a prepared type
+    expression.*)
+
+val prepared_type_scheme: type_expr printer
+val prepared_type_expr: type_expr printer
+(** The printers [prepared_type_expr] and [prepared_type_scheme] should only be
+    used on prepared types. Types can be prepared by initially calling
+    {!prepare_for_printing} or adding them later to the preparation with
+    {!add_type_to_preparation}.
+
+    Calling this function on non-prepared types may cause a stack overflow (see
+    #8860) due to cycles in the printed types.
+
+    See {!Printtyp.type_expr} for a safer but less flexible printer. *)
+
+(** [type_expr_with_reserved_names] can print "half-prepared" type expression. A
+    "half-prepared" type expression should have had its names reserved (with
+    {!Variable_names.reserve}), but should not have had its cycles marked. *)
+val type_expr_with_reserved_names: type_expr printer
+
+type 'a diff = Same of 'a | Diff of 'a * 'a
+val trees_of_type_expansion:
+  type_or_scheme -> Errortrace.expanded_type -> out_type diff
+val prepare_expansion: Errortrace.expanded_type -> Errortrace.expanded_type
+val pp_type_expansion: out_type diff printer
+val hide_variant_name: Types.type_expr -> Types.type_expr
+
+
+(** {1: Label and constructors }*)
+val prepare_type_constructor_arguments: constructor_arguments -> unit
+val tree_of_constructor_arguments: constructor_arguments -> out_type list
+
+val tree_of_label: label_declaration -> out_label
+
+val add_constructor_to_preparation : constructor_declaration -> unit
+val prepared_constructor : constructor_declaration printer
+
+val tree_of_extension_constructor:
+    Ident.t -> extension_constructor -> ext_status -> out_sig_item
+val extension_constructor_args_and_ret_type_subtree:
+  constructor_arguments -> type_expr option -> out_type list * out_type option
+val add_extension_constructor_to_preparation :
+    extension_constructor -> unit
+val prepared_extension_constructor:
+    Ident.t -> extension_constructor printer
+
+
+(** {1 Declarations }*)
+
+val tree_of_type_declaration:
+    Ident.t -> type_declaration -> rec_status -> out_sig_item
+val add_type_declaration_to_preparation :
+  Ident.t -> type_declaration -> unit
+val prepared_type_declaration: Ident.t -> type_declaration printer
+
+val tree_of_value_description: Ident.t -> value_description -> out_sig_item
+val tree_of_modtype_declaration:
+    Ident.t -> modtype_declaration -> out_sig_item
+val tree_of_class_declaration:
+    Ident.t -> class_declaration -> rec_status -> out_sig_item
+val tree_of_cltype_declaration:
+    Ident.t -> class_type_declaration -> rec_status -> out_sig_item
+
+(** {1 Module types }*)
+
+val tree_of_module:
+    Ident.t -> ?ellipsis:bool -> module_type -> rec_status -> out_sig_item
+val tree_of_modtype: module_type -> out_module_type
+val tree_of_signature: Types.signature -> out_sig_item list
+
+val tree_of_class_type: type_or_scheme -> class_type -> out_class_type
+val prepare_class_type: class_type -> unit
+
+(** {1 Toplevel printing}  *)
+val print_items: (Env.t -> signature_item -> 'a option) ->
+  Env.t -> signature_item list -> (out_sig_item * 'a option) list
+
+(** {1 Naming contexts }*)
+
+(** Path name, which were mutable at some point *)
+module Out_name: sig
+  val create: string -> out_name
+  val print: out_name -> string
+end
+
+(** Disambiguation for identifiers, e.g. the two type constructors named [t]
+in the type of [f] in
+{[
+  type t = A
+  module M = struct
+    type t = B
+   let f A = B
+  end
+]}
+should be disambiguated to [t/2->t] *)
+module Ident_names: sig
+  val enable: bool -> unit
+  (** When contextual names are enabled, the mapping between identifiers
+      and names is ensured to be one-to-one. *)
+
+  (** [with_fuzzy id f] locally disable ident disambiguation for [id] within
+      [f] *)
+  val with_fuzzy: Ident.t -> (unit -> 'a) -> 'a
+end
+
+(** The [Ident_conflicts] module keeps track of conflicts arising when
+    attributing names to identifiers and provides functions that can print
+    explanations for these conflict in error messages *)
+module Ident_conflicts: sig
+  val exists: unit -> bool
+  (** [exists()] returns true if the current naming context renamed
+        an identifier to avoid a name collision *)
+
+  type explanation =
+    { kind: Shape.Sig_component_kind.t;
+      name:string;
+      root_name:string;
+      location:Location.t
+    }
+
+  val list_explanations: unit -> explanation list
+(** [list_explanations()] return the list of conflict explanations
+    collected up to this point, and reset the list of collected
+    explanations *)
+
+  val print_located_explanations: explanation list printer
+
+  val err_print: formatter -> unit
+  val err_msg: unit -> doc option
+  (** [err_msg ()] return an error message if there are pending conflict
+      explanations at this point. It is often important to check for conflicts
+      after all printing is done, thus the delayed nature of [err_msg]*)
+
+  val reset: unit -> unit
+end
+
+(** Naming choice for type variable names (['a], ['b], ...), for instance the
+    two classes of distinct type variables in
+    {[let repeat x y = x, y, y, x]}
+    should be printed printed as ['a -> 'b -> 'a * 'b * 'b * 'a].
+*)
+module Variable_names: sig
+
+  (** Add external type equalities*)
+  val add_subst: (type_expr * type_expr) list -> unit
+
+  (** [reserve ty] registers the variable names appearing in [ty] *)
+  val reserve: type_expr -> unit
+end
+
+(** Register internal typechecker names ([$0],[$a]) appearing in the
+    [outcometree] *)
+module Internal_names: sig
+  val add: Path.t -> unit
+  val reset: unit -> unit
+  val print_explanations: Env.t -> formatter -> unit
+end
+
+(** Reset all contexts *)
+val reset: unit -> unit
+
+(** Reset all contexts except for conflicts *)
+val reset_except_conflicts: unit -> unit

diff --git a/typing/outcometree.mli b/typing/outcometree.mli
index 93449f9ec60d87373752893161b3301f8e83d185..f4b89630b0c8a8591c07f158a0e36fa68088c155 100644 (file)
--- a/typing/outcometree.mli
+++ b/typing/outcometree.mli
@@ -49,7 +49,7 @@ type out_value =
   | Oval_int64 of int64
   | Oval_nativeint of nativeint
   | Oval_list of out_value list
-  | Oval_printer of (Format.formatter -> unit)
+  | Oval_printer of (Format_doc.formatter -> unit)
   | Oval_record of (out_ident * out_value) list
   | Oval_string of string * int * out_string (* string, size-to-print, kind *)
   | Oval_stuff of string
@@ -72,7 +72,7 @@ type out_type =
   | Otyp_constr of out_ident * out_type list
   | Otyp_manifest of out_type * out_type
   | Otyp_object of { fields: (string * out_type) list; open_row:bool}
-  | Otyp_record of (string * bool * out_type) list
+  | Otyp_record of out_label list
   | Otyp_stuff of string
   | Otyp_sum of out_constructor list
   | Otyp_tuple of out_type list
@@ -82,6 +82,12 @@ type out_type =
   | Otyp_module of out_ident * (string * out_type) list
   | Otyp_attribute of out_type * out_attribute
 
+and out_label = {
+  olab_name: string;
+  olab_mut: Asttypes.mutable_flag;
+  olab_type: out_type;
+}
+
 and out_constructor = {
   ocstr_name: string;
   ocstr_args: out_type list;

diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index f6337d467cf0c54f876c38c65dcd2e75f9891329..c1cc84e3a6ec9a6d498e220f14b3756d138e8e11 100644 (file)
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -504,26 +504,15 @@ let rec read_args xs r = match xs,r with
 | _,_ ->
     fatal_error "Parmatch.read_args"
 
-let do_set_args ~erase_mutable q r = match q with
+let set_args q r = match q with
 | {pat_desc = Tpat_tuple omegas} ->
     let args,rest = read_args omegas r in
     make_pat (Tpat_tuple args) q.pat_type q.pat_env::rest
 | {pat_desc = Tpat_record (omegas,closed)} ->
     let args,rest = read_args omegas r in
-    make_pat
-      (Tpat_record
-         (List.map2 (fun (lid, lbl,_) arg ->
-           if
-             erase_mutable &&
-             (match lbl.lbl_mut with
-             | Mutable -> true | Immutable -> false)
-           then
-             lid, lbl, omega
-           else
-             lid, lbl, arg)
-            omegas args, closed))
-      q.pat_type q.pat_env::
-    rest
+    let args =
+      List.map2 (fun (lid, lbl, _) arg -> (lid, lbl, arg)) omegas args in
+    make_pat (Tpat_record (args, closed)) q.pat_type q.pat_env :: rest
 | {pat_desc = Tpat_construct (lid, c, omegas, _)} ->
     let args,rest = read_args omegas r in
     make_pat
@@ -548,7 +537,6 @@ let do_set_args ~erase_mutable q r = match q with
     end
 | {pat_desc = Tpat_array omegas} ->
     let args,rest = read_args omegas r in
-    let args = if erase_mutable then omegas else args in
     make_pat
       (Tpat_array args) q.pat_type q.pat_env::
     rest
@@ -557,9 +545,6 @@ let do_set_args ~erase_mutable q r = match q with
 | {pat_desc = (Tpat_var _ | Tpat_alias _ | Tpat_or _); _} ->
     fatal_error "Parmatch.set_args"
 
-let set_args q r = do_set_args ~erase_mutable:false q r
-and set_args_erase_mutable q r = do_set_args ~erase_mutable:true q r
-
 (* Given a matrix of non-empty rows
    p1 :: r1...
    p2 :: r2...
@@ -1899,22 +1884,20 @@ let do_check_partial ~pred loc casel pss = match pss with
     | Seq.Cons (v, _rest) ->
       if Warnings.is_active (Warnings.Partial_match "") then begin
         let errmsg =
-          try
-            let buf = Buffer.create 16 in
-            let fmt = Format.formatter_of_buffer buf in
-            Format.fprintf fmt "%a@?" Printpat.pretty_pat v;
-            if do_match (initial_only_guarded casel) [v] then
-              Buffer.add_string buf
-                "\n(However, some guarded clause may match this value.)";
-            if contains_extension v then
-              Buffer.add_string buf
-                "\nMatching over values of extensible variant types \
-                   (the *extension* above)\n\
-              must include a wild card pattern in order to be exhaustive."
-            ;
-            Buffer.contents buf
-          with _ ->
-            ""
+          let doc = ref Format_doc.Doc.empty in
+          let fmt = Format_doc.formatter doc in
+          Format_doc.fprintf fmt "@[<v>%a" Printpat.top_pretty v;
+          if do_match (initial_only_guarded casel) [v] then
+            Format_doc.fprintf fmt
+              "@,(However, some guarded clause may match this value.)";
+          if contains_extension v then
+            Format_doc.fprintf fmt
+              "@,@[Matching over values of extensible variant types \
+               (the *extension* above)@,\
+               must include a wild card pattern@ in order to be exhaustive.@]"
+          ;
+          Format_doc.fprintf fmt "@]";
+          Format_doc.(asprintf "%a" pp_doc) !doc
         in
         Location.prerr_warning loc (Warnings.Partial_match errmsg)
       end;

diff --git a/typing/parmatch.mli b/typing/parmatch.mli
index 6f09ad5e37780db6f999fa7c9a8e4ef2326a1ed5..7e40dd29cd03b8fd5d263876a36a1a0889d70c21 100644 (file)
--- a/typing/parmatch.mli
+++ b/typing/parmatch.mli
@@ -75,13 +75,11 @@ val lubs : pattern list -> pattern list -> pattern list
 
 val get_mins : ('a -> 'a -> bool) -> 'a list -> 'a list
 
-(** Those two functions recombine one pattern and its arguments:
+(** This function recombines one pattern and its arguments:
     For instance:
       (_,_)::p1::p2::rem -> (p1, p2)::rem
-    The second one will replace mutable arguments by '_'
 *)
 val set_args : pattern -> pattern list -> pattern list
-val set_args_erase_mutable : pattern -> pattern list -> pattern list
 
 val pat_of_constr : pattern -> constructor_description -> pattern
 val complete_constrs :

diff --git a/typing/path.ml b/typing/path.ml
index 4b44b0b2f059133b61ebb3b2124bfac170ebe5f3..038ae48f88ff2f1d1e8ec6dda26f3e16bb306419 100644 (file)
--- a/typing/path.ml
+++ b/typing/path.ml
@@ -104,8 +104,8 @@ let rec name ?(paren=kfalse) = function
 let rec print ppf = function
   | Pident id -> Ident.print_with_scope ppf id
   | Pdot(p, s) | Pextra_ty (p, Pcstr_ty s) ->
-      Format.fprintf ppf "%a.%s" print p s
-  | Papply(p1, p2) -> Format.fprintf ppf "%a(%a)" print p1 print p2
+      Format_doc.fprintf ppf "%a.%s" print p s
+  | Papply(p1, p2) -> Format_doc.fprintf ppf "%a(%a)" print p1 print p2
   | Pextra_ty (p, Pext_ty) -> print ppf p
 
 let rec head = function

diff --git a/typing/path.mli b/typing/path.mli
index 39e76a372722549ab0c66964e3b3a23209a83868..034be0042e9ac530b75ffaeba1cb54c225f147f2 100644 (file)
--- a/typing/path.mli
+++ b/typing/path.mli
@@ -68,7 +68,7 @@ val name: ?paren:(string -> bool) -> t -> string
     (* [paren] tells whether a path suffix needs parentheses *)
 val head: t -> Ident.t
 
-val print: Format.formatter -> t -> unit
+val print: t Format_doc.printer
 
 val heads: t -> Ident.t list
 

diff --git a/typing/persistent_env.ml b/typing/persistent_env.ml
index 5e59b995d5eb632b7178c2d261a19b25ddf0b11b..bb705257340d7a983084679b5077335206181815 100644 (file)
--- a/typing/persistent_env.ml
+++ b/typing/persistent_env.ml
@@ -243,25 +243,27 @@ let check_pers_struct ~allow_hidden penv f ~loc name =
       let warn = Warnings.No_cmi_file(name, None) in
         Location.prerr_warning loc warn
   | Cmi_format.Error err ->
-      let msg = Format.asprintf "%a" Cmi_format.report_error err in
+      let msg = Format.asprintf "%a"
+          Cmi_format.report_error err in
       let warn = Warnings.No_cmi_file(name, Some msg) in
         Location.prerr_warning loc warn
   | Error err ->
       let msg =
         match err with
         | Illegal_renaming(name, ps_name, filename) ->
-            Format.asprintf
+            Format_doc.doc_printf
               " %a@ contains the compiled interface for @ \
                %a when %a was expected"
-              (Style.as_inline_code Location.print_filename) filename
+              Location.Doc.quoted_filename filename
               Style.inline_code ps_name
               Style.inline_code name
         | Inconsistent_import _ -> assert false
         | Need_recursive_types name ->
-            Format.asprintf
+            Format_doc.doc_printf
               "%a uses recursive types"
               Style.inline_code name
       in
+      let msg = Format_doc.(asprintf "%a" pp_doc) msg in
       let warn = Warnings.No_cmi_file(name, Some msg) in
         Location.prerr_warning loc warn
 
@@ -349,20 +351,20 @@ let save_cmi penv psig pm =
     )
     ~exceptionally:(fun () -> remove_file filename)
 
-let report_error ppf =
-  let open Format in
+let report_error_doc ppf =
+  let open Format_doc in
   function
   | Illegal_renaming(modname, ps_name, filename) -> fprintf ppf
       "Wrong file naming: %a@ contains the compiled interface for@ \
        %a when %a was expected"
-      (Style.as_inline_code Location.print_filename) filename
+      Location.Doc.quoted_filename filename
       Style.inline_code ps_name
       Style.inline_code modname
   | Inconsistent_import(name, source1, source2) -> fprintf ppf
       "@[<hov>The files %a@ and %a@ \
               make inconsistent assumptions@ over interface %a@]"
-      (Style.as_inline_code Location.print_filename) source1
-      (Style.as_inline_code Location.print_filename) source2
+      Location.Doc.quoted_filename source1
+      Location.Doc.quoted_filename source2
       Style.inline_code name
   | Need_recursive_types(import) ->
       fprintf ppf
@@ -375,6 +377,8 @@ let () =
   Location.register_error_of_exn
     (function
       | Error err ->
-          Some (Location.error_of_printer_file report_error err)
+          Some (Location.error_of_printer_file report_error_doc err)
       | _ -> None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/typing/persistent_env.mli b/typing/persistent_env.mli
index 136da7f8810b5c0ad643a3dcb5f27ae192a66b00..6cbdfc81c7865db0815bb0e4dfd9d1507118e859 100644 (file)
--- a/typing/persistent_env.mli
+++ b/typing/persistent_env.mli
@@ -27,7 +27,8 @@ type error =
 
 exception Error of error
 
-val report_error: Format.formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer
 
 module Persistent_signature : sig
   type t =

diff --git a/typing/predef.ml b/typing/predef.ml
index 7344be15fc221bb7fa425344868b64dc0488edf0..e7b24bd8fe474f103b255b4659356e358e8e92f7 100644 (file)
--- a/typing/predef.ml
+++ b/typing/predef.ml
@@ -35,6 +35,8 @@ and ident_float = ident_create "float"
 and ident_bool = ident_create "bool"
 and ident_unit = ident_create "unit"
 and ident_exn = ident_create "exn"
+and ident_eff = ident_create "eff"
+and ident_continuation = ident_create "continuation"
 and ident_array = ident_create "array"
 and ident_list = ident_create "list"
 and ident_option = ident_create "option"
@@ -53,6 +55,8 @@ and path_float = Pident ident_float
 and path_bool = Pident ident_bool
 and path_unit = Pident ident_unit
 and path_exn = Pident ident_exn
+and path_eff = Pident ident_eff
+and path_continuation = Pident ident_continuation
 and path_array = Pident ident_array
 and path_list = Pident ident_list
 and path_option = Pident ident_option
@@ -71,6 +75,9 @@ and type_float = newgenty (Tconstr(path_float, [], ref Mnil))
 and type_bool = newgenty (Tconstr(path_bool, [], ref Mnil))
 and type_unit = newgenty (Tconstr(path_unit, [], ref Mnil))
 and type_exn = newgenty (Tconstr(path_exn, [], ref Mnil))
+and type_eff t = newgenty (Tconstr(path_eff, [t], ref Mnil))
+and type_continuation t1 t2 =
+  newgenty (Tconstr(path_continuation, [t1; t2], ref Mnil))
 and type_array t = newgenty (Tconstr(path_array, [t], ref Mnil))
 and type_list t = newgenty (Tconstr(path_list, [t], ref Mnil))
 and type_option t = newgenty (Tconstr(path_option, [t], ref Mnil))
@@ -96,6 +103,8 @@ and ident_sys_blocked_io = ident_create "Sys_blocked_io"
 and ident_assert_failure = ident_create "Assert_failure"
 and ident_undefined_recursive_module =
         ident_create "Undefined_recursive_module"
+and ident_continuation_already_taken = ident_create "Continuation_already_taken"
+
 
 let all_predef_exns = [
   ident_match_failure;
@@ -110,6 +119,7 @@ let all_predef_exns = [
   ident_sys_blocked_io;
   ident_assert_failure;
   ident_undefined_recursive_module;
+  ident_continuation_already_taken;
 ]
 
 let path_match_failure = Pident ident_match_failure
@@ -178,6 +188,28 @@ let build_initial_env add_type add_extension empty_env =
       }
     in
     add_type type_ident decl env
+  and add_continuation type_ident env =
+    let tvar1 = newgenvar() in
+    let tvar2 = newgenvar() in
+    let arity = 2 in
+    let decl =
+      {type_params = [tvar1; tvar2];
+       type_arity = arity;
+       type_kind = Type_abstract Definition;
+       type_loc = Location.none;
+       type_private = Asttypes.Public;
+       type_manifest = None;
+       type_variance = [Variance.contravariant; Variance.covariant];
+       type_separability = Types.Separability.default_signature ~arity;
+       type_is_newtype = false;
+       type_expansion_scope = lowest_level;
+       type_attributes = [];
+       type_immediate = Unknown;
+       type_unboxed_default = false;
+       type_uid = Uid.of_predef_id type_ident;
+      }
+    in
+    add_type type_ident decl env
   in
   let add_extension id l =
     add_extension id
@@ -204,6 +236,11 @@ let build_initial_env add_type add_extension empty_env =
        ~kind:(variant [cstr ident_false []; cstr ident_true []])
   |> add_type ident_char ~immediate:Always
   |> add_type ident_exn ~kind:Type_open
+  |> add_type1 ident_eff
+       ~variance:Variance.full
+       ~separability:Separability.Ind
+       ~kind:(fun _ -> Type_open)
+  |> add_continuation ident_continuation
   |> add_type ident_extension_constructor
   |> add_type ident_float
   |> add_type ident_floatarray
@@ -245,6 +282,7 @@ let build_initial_env add_type add_extension empty_env =
   |> add_extension ident_sys_error [type_string]
   |> add_extension ident_undefined_recursive_module
        [newgenty (Ttuple[type_string; type_int; type_int])]
+  |> add_extension ident_continuation_already_taken []
 
 let builtin_values =
   List.map (fun id -> (Ident.name id, id)) all_predef_exns

diff --git a/typing/predef.mli b/typing/predef.mli
index 4fde9cce6b224312a89264bd2e288884fc8d9075..4653514337331432bc9f2a75d52b98d9841a50a8 100644 (file)
--- a/typing/predef.mli
+++ b/typing/predef.mli
@@ -25,6 +25,8 @@ val type_float: type_expr
 val type_bool: type_expr
 val type_unit: type_expr
 val type_exn: type_expr
+val type_eff: type_expr -> type_expr
+val type_continuation: type_expr -> type_expr -> type_expr
 val type_array: type_expr -> type_expr
 val type_list: type_expr -> type_expr
 val type_option: type_expr -> type_expr
@@ -43,6 +45,7 @@ val path_float: Path.t
 val path_bool: Path.t
 val path_unit: Path.t
 val path_exn: Path.t
+val path_eff: Path.t
 val path_array: Path.t
 val path_list: Path.t
 val path_option: Path.t
@@ -52,6 +55,7 @@ val path_int64: Path.t
 val path_lazy_t: Path.t
 val path_extension_constructor: Path.t
 val path_floatarray: Path.t
+val path_continuation: Path.t
 
 val path_match_failure: Path.t
 val path_assert_failure : Path.t

diff --git a/typing/primitive.ml b/typing/primitive.ml
index f8e964cce1cf33e223521307ce77f5491f3bb744..a0cb5d712b4e4ce255cb684b5d09b136e9c65785 100644 (file)
--- a/typing/primitive.ml
+++ b/typing/primitive.ml
@@ -232,16 +232,16 @@ module Style = Misc.Style
 let report_error ppf err =
   match err with
   | Old_style_float_with_native_repr_attribute ->
-    Format.fprintf ppf "Cannot use %a in conjunction with %a/%a."
+    Format_doc.fprintf ppf "Cannot use %a in conjunction with %a/%a."
       Style.inline_code "float"
       Style.inline_code "[@unboxed]"
       Style.inline_code  "[@untagged]"
   | Old_style_noalloc_with_noalloc_attribute ->
-    Format.fprintf ppf "Cannot use %a in conjunction with %a."
+    Format_doc.fprintf ppf "Cannot use %a in conjunction with %a."
       Style.inline_code "noalloc"
       Style.inline_code "[@@noalloc]"
   | No_native_primitive_with_repr_attribute ->
-    Format.fprintf ppf
+    Format_doc.fprintf ppf
       "@[The native code version of the primitive is mandatory@ \
        when attributes %a or %a are present.@]"
       Style.inline_code "[@untagged]"

diff --git a/typing/printpat.ml b/typing/printpat.ml
index bc3578ce4178774975ed5fc62bc7e4ba3e518206..d4897294d01b03012bb282c0822776d1e6b29006 100644 (file)
--- a/typing/printpat.ml
+++ b/typing/printpat.ml
@@ -18,7 +18,7 @@
 open Asttypes
 open Typedtree
 open Types
-open Format
+open Format_doc
 
 let is_cons = function
 | {cstr_name = "::"} -> true
@@ -99,7 +99,7 @@ let rec pretty_val : type k . _ -> k general_pattern -> _ = fun ppf v ->
   | Tpat_lazy v ->
       fprintf ppf "@[<2>lazy@ %a@]" pretty_arg v
   | Tpat_alias (v, x,_,_) ->
-      fprintf ppf "@[(%a@ as %a)@]" pretty_val v Ident.print x
+      fprintf ppf "@[(%a@ as %a)@]" pretty_val v Ident.doc_print x
   | Tpat_value v ->
       fprintf ppf "%a" pretty_val (v :> pattern)
   | Tpat_exception v ->
@@ -144,20 +144,30 @@ and pretty_lvals ppf = function
       fprintf ppf "%s=%a;@ %a"
         lbl.lbl_name pretty_val v pretty_lvals rest
 
+let top_pretty ppf v =
+  fprintf ppf "@[%a@]" pretty_val v
+
 let pretty_pat ppf p =
-  fprintf ppf "@[%a@]" pretty_val p
+  top_pretty ppf p ;
+  pp_print_flush ppf ()
 
 type 'k matrix = 'k general_pattern list list
 
 let pretty_line ppf line =
-  Format.fprintf ppf "@[";
+  fprintf ppf "@[";
   List.iter (fun p ->
-    Format.fprintf ppf "<%a>@ "
-      pretty_val p
-  ) line;
-  Format.fprintf ppf "@]"
+      fprintf ppf "<%a>@ "
+        pretty_val p
+    ) line;
+  fprintf ppf "@]"
 
 let pretty_matrix ppf (pss : 'k matrix) =
-  Format.fprintf ppf "@[<v 2>  %a@]"
-    (Format.pp_print_list ~pp_sep:Format.pp_print_cut pretty_line)
+  fprintf ppf "@[<v 2>  %a@]"
+    (pp_print_list ~pp_sep:pp_print_cut pretty_line)
     pss
+
+module Compat = struct
+  let pretty_pat ppf x = compat pretty_pat ppf x
+  let pretty_line ppf x = compat pretty_line ppf x
+  let pretty_matrix ppf x = compat pretty_matrix ppf x
+end

diff --git a/typing/printpat.mli b/typing/printpat.mli
index 1f03508c2d27f77cc320ad0a1b749d98c16c7a6a..2d9a93ce6d6d003c66c4e6de579af95ccecdd5eb 100644 (file)
--- a/typing/printpat.mli
+++ b/typing/printpat.mli
@@ -17,11 +17,12 @@
 
 val pretty_const
   : Asttypes.constant -> string
-val pretty_val : Format.formatter -> 'k Typedtree.general_pattern -> unit
 
-val pretty_pat
-    : Format.formatter -> 'k Typedtree.general_pattern -> unit
-val pretty_line
-    : Format.formatter -> 'k Typedtree.general_pattern list -> unit
-val pretty_matrix
-    : Format.formatter -> 'k Typedtree.general_pattern list list -> unit
+val top_pretty: 'k Typedtree.general_pattern Format_doc.printer
+
+module Compat: sig
+  val pretty_pat: Format.formatter -> 'k Typedtree.general_pattern -> unit
+  val pretty_line: Format.formatter -> 'k Typedtree.general_pattern list -> unit
+  val pretty_matrix:
+    Format.formatter -> 'k Typedtree.general_pattern list list -> unit
+end

diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index 18489a5e4f3826796593f4bd324475aaaab71257..649f4b94ce6d5a9be5ece0ed2f226d069e7bafe3 100644 (file)
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -2,9 +2,9 @@
 (*                                                                        *)
 (*                                 OCaml                                  *)
 (*                                                                        *)
-(*  Xavier Leroy and Jerome Vouillon, projet Cristal, INRIA Rocquencourt  *)
+(*  Florian Angeletti, projet Cambium, INRIA Paris                        *)
 (*                                                                        *)
-(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
 (*     en Automatique.                                                    *)
 (*                                                                        *)
 (*   All rights reserved.  This file is distributed under the terms of    *)
@@ -13,2708 +13,162 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(* Printing functions *)
+open Out_type
+module Fmt = Format_doc
 
-open Misc
-open Ctype
-open Format
-open Longident
-open Path
-open Asttypes
-open Types
-open Btype
-open Outcometree
-
-module String = Misc.Stdlib.String
-module Sig_component_kind = Shape.Sig_component_kind
-module Style = Misc.Style
-
-(* Print a long identifier *)
-let longident = Pprintast.longident
-
-let () = Env.print_longident := longident
-
-(* Print an identifier avoiding name collisions *)
-
-module Out_name = struct
-  let create x = { printed_name = x }
-  let print x = x.printed_name
-end
-
-(** Some identifiers may require hiding when printing *)
-type bound_ident = { hide:bool; ident:Ident.t }
-
-(* printing environment for path shortening and naming *)
-let printing_env = ref Env.empty
-
-(* When printing, it is important to only observe the
-   current printing environment, without reading any new
-   cmi present on the file system *)
-let in_printing_env f = Env.without_cmis f !printing_env
-
- type namespace = Sig_component_kind.t =
-    | Value
-    | Type
-    | Constructor
-    | Label
-    | Module
-    | Module_type
-    | Extension_constructor
-    | Class
-    | Class_type
+let namespaced_ident namespace  id =
+  Out_name.print (ident_name (Some namespace) id)
 
+module Doc = struct
+  let wrap_printing_env = wrap_printing_env
 
-module Namespace = struct
+  let longident = Pprintast.Doc.longident
 
-  let id = function
-    | Type -> 0
-    | Module -> 1
-    | Module_type -> 2
-    | Class -> 3
-    | Class_type -> 4
-    | Extension_constructor | Value | Constructor | Label -> 5
-     (* we do not handle those component *)
+  let ident ppf id = Fmt.pp_print_string ppf
+      (Out_name.print (ident_name None id))
 
-  let size = 1 + id Value
 
 
-  let pp ppf x =
-    Format.pp_print_string ppf (Shape.Sig_component_kind.to_string x)
+  let typexp mode ppf ty =
+    !Oprint.out_type ppf (tree_of_typexp mode ty)
 
-  (** The two functions below should never access the filesystem,
-      and thus use {!in_printing_env} rather than directly
-      accessing the printing environment *)
-  let lookup =
-    let to_lookup f lid = fst @@ in_printing_env (f (Lident lid)) in
-    function
-    | Some Type -> to_lookup Env.find_type_by_name
-    | Some Module -> to_lookup Env.find_module_by_name
-    | Some Module_type -> to_lookup Env.find_modtype_by_name
-    | Some Class -> to_lookup Env.find_class_by_name
-    | Some Class_type -> to_lookup Env.find_cltype_by_name
-    | None | Some(Value|Extension_constructor|Constructor|Label) ->
-         fun _ -> raise Not_found
+  let type_expansion k ppf e =
+    pp_type_expansion ppf (trees_of_type_expansion k e)
 
-  let location namespace id =
-    let path = Path.Pident id in
-    try Some (
-        match namespace with
-        | Some Type -> (in_printing_env @@ Env.find_type path).type_loc
-        | Some Module -> (in_printing_env @@ Env.find_module path).md_loc
-        | Some Module_type -> (in_printing_env @@ Env.find_modtype path).mtd_loc
-        | Some Class -> (in_printing_env @@ Env.find_class path).cty_loc
-        | Some Class_type -> (in_printing_env @@ Env.find_cltype path).clty_loc
-        | Some (Extension_constructor|Value|Constructor|Label) | None ->
-            Location.none
-      ) with Not_found -> None
+  let type_declaration id ppf decl =
+    !Oprint.out_sig_item ppf (tree_of_type_declaration id decl Trec_first)
 
-  let best_class_namespace = function
-    | Papply _ | Pdot _ -> Some Module
-    | Pextra_ty _ -> assert false (* Only in type path *)
-    | Pident c ->
-        match location (Some Class) c with
-        | Some _ -> Some Class
-        | None -> Some Class_type
+  let type_expr ppf ty =
+    (* [type_expr] is used directly by error message printers,
+       we mark eventual loops ourself to avoid any misuse and stack overflow *)
+    prepare_for_printing [ty];
+    prepared_type_expr ppf ty
 
-end
+  let shared_type_scheme ppf ty =
+    add_type_to_preparation ty;
+    typexp Type_scheme ppf ty
 
-(** {2 Conflicts printing}
-    Conflicts arise when multiple items are attributed the same name,
-    the following module stores the global conflict references and
-    provides the printing functions for explaining the source of
-    the conflicts.
-*)
-module Conflicts = struct
-  module M = String.Map
-  type explanation =
-    { kind: namespace; name:string; root_name:string; location:Location.t}
-  let explanations = ref M.empty
+  let type_scheme ppf ty =
+    prepare_for_printing [ty];
+    prepared_type_scheme ppf ty
 
-  let add namespace name id =
-    match Namespace.location (Some namespace) id with
-    | None -> ()
-    | Some location ->
-        let explanation =
-          { kind = namespace; location; name; root_name=Ident.name id}
-        in
-        explanations := M.add name explanation !explanations
+  let path ppf p =
+    !Oprint.out_ident ppf (tree_of_path ~disambiguation:false p)
 
-  let collect_explanation namespace id ~name =
-    let root_name = Ident.name id in
-    (* if [name] is of the form "root_name/%d", we register both
-      [id] and the identifier in scope for [root_name].
-     *)
-    if root_name <> name && not (M.mem name !explanations) then
-      begin
-        add namespace name id;
-        if not (M.mem root_name !explanations) then
-          (* lookup the identifier in scope with name [root_name] and
-             add it too
-           *)
-          match Namespace.lookup (Some namespace) root_name with
-          | Pident root_id -> add namespace root_name root_id
-          | exception Not_found | _ -> ()
-      end
+  let () = Env.print_path := path
 
-  let pp_explanation ppf r=
-    Format.fprintf ppf "@[<v 2>%a:@,Definition of %s %a@]"
-      Location.print_loc r.location (Sig_component_kind.to_string r.kind)
-      Style.inline_code r.name
+  let type_path ppf p = !Oprint.out_ident ppf (tree_of_type_path p)
 
-  let print_located_explanations ppf l =
-    Format.fprintf ppf "@[<v>%a@]" (Format.pp_print_list pp_explanation) l
+  let value_description id ppf decl =
+    !Oprint.out_sig_item ppf (tree_of_value_description id decl)
 
-  let reset () = explanations := M.empty
-  let list_explanations () =
-    let c = !explanations in
+  let class_type ppf cty =
     reset ();
-    c |> M.bindings |> List.map snd |> List.sort Stdlib.compare
-
-
-  let print_toplevel_hint ppf l =
-    let conj ppf () = Format.fprintf ppf " and@ " in
-    let pp_namespace_plural ppf n = Format.fprintf ppf "%as" Namespace.pp n in
-    let root_names = List.map (fun r -> r.kind, r.root_name) l in
-    let unique_root_names = List.sort_uniq Stdlib.compare root_names in
-    let submsgs = Array.make Namespace.size [] in
-    let () = List.iter (fun (n,_ as x) ->
-        submsgs.(Namespace.id n) <- x :: submsgs.(Namespace.id n)
-      )  unique_root_names in
-    let pp_submsg ppf names =
-      match names with
-      | [] -> ()
-      | [namespace, a] ->
-          Format.fprintf ppf
-        "@ \
-         @[<2>@{<hint>Hint@}: The %a %a has been defined multiple times@ \
-         in@ this@ toplevel@ session.@ \
-         Some toplevel values still refer to@ old@ versions@ of@ this@ %a.\
-         @ Did you try to redefine them?@]"
-        Namespace.pp namespace
-        Style.inline_code a Namespace.pp namespace
-      | (namespace, _) :: _ :: _ ->
-      Format.fprintf ppf
-        "@ \
-         @[<2>@{<hint>Hint@}: The %a %a have been defined multiple times@ \
-         in@ this@ toplevel@ session.@ \
-         Some toplevel values still refer to@ old@ versions@ of@ those@ %a.\
-         @ Did you try to redefine them?@]"
-        pp_namespace_plural namespace
-        Format.(pp_print_list ~pp_sep:conj Style.inline_code)
-        (List.map snd names)
-        pp_namespace_plural namespace in
-    Array.iter (pp_submsg ppf) submsgs
-
-  let print_explanations ppf =
-    let ltop, l =
-      (* isolate toplevel locations, since they are too imprecise *)
-      let from_toplevel a =
-        a.location.Location.loc_start.Lexing.pos_fname = "//toplevel//" in
-      List.partition from_toplevel (list_explanations ())
-    in
-    begin match l with
-    | [] -> ()
-    | l -> Format.fprintf ppf "@,%a" print_located_explanations l
-    end;
-    (* if there are name collisions in a toplevel session,
-       display at least one generic hint by namespace *)
-    print_toplevel_hint ppf ltop
-
-  let exists () = M.cardinal !explanations >0
-end
-
-module Naming_context = struct
-
-module M = String.Map
-module S = String.Set
-
-let enabled = ref true
-let enable b = enabled := b
-
-(* Names bound in recursive definitions should be considered as bound
-   in the environment when printing identifiers but not when trying
-   to find shortest path.
-   For instance, if we define
-   [{
-   module Avoid__me = struct
-     type t = A
-   end
-   type t = X
-   type u = [` A of t * t ]
-   module M = struct
-     type t = A of [ u | `B ]
-     type r = Avoid__me.t
-   end
-  }]
-  It is is important that in the definition of [t] that the outer type [t] is
-  printed as [t/2] reserving the name [t] to the type being defined in the
-  current recursive definition.
-     Contrarily, in the definition of [r], one should not shorten the
-  path [Avoid__me.t] to [r] until the end of the definition of [r].
-  The [bound_in_recursion] bridges the gap between those two slightly different
-  notions of printing environment.
-*)
-let bound_in_recursion = ref M.empty
+    prepare_class_type cty;
+    !Oprint.out_class_type ppf (tree_of_class_type Type cty)
 
-(* When dealing with functor arguments, identity becomes fuzzy because the same
-   syntactic argument may be represented by different identifiers during the
-   error processing, we are thus disabling disambiguation on the argument name
-*)
-let fuzzy = ref S.empty
-let with_arg id f =
-  protect_refs [ R(fuzzy, S.add (Ident.name id) !fuzzy) ] f
-let fuzzy_id namespace id = namespace = Module && S.mem (Ident.name id) !fuzzy
+  let class_declaration id ppf cl =
+    !Oprint.out_sig_item ppf (tree_of_class_declaration id cl Trec_first)
 
-let with_hidden ids f =
-  let update m id = M.add (Ident.name id.ident) id.ident m in
-  let updated = List.fold_left update !bound_in_recursion ids in
-  protect_refs [ R(bound_in_recursion, updated )] f
+  let cltype_declaration id ppf cl =
+    !Oprint.out_sig_item ppf (tree_of_cltype_declaration id cl Trec_first)
 
-let human_id id index =
-  (* The identifier with index [k] is the (k+1)-th most recent identifier in
-     the printing environment. We print them as [name/(k+1)] except for [k=0]
-     which is printed as [name] rather than [name/1].
-  *)
-  if index = 0 then
-    Ident.name id
-  else
-    let ordinal = index + 1 in
-    String.concat "/" [Ident.name id; string_of_int ordinal]
+  let modtype ppf mty = !Oprint.out_module_type ppf (tree_of_modtype mty)
+  let modtype_declaration id ppf decl =
+    !Oprint.out_sig_item ppf (tree_of_modtype_declaration id decl)
 
-let indexed_name namespace id =
-  let find namespace id env = match namespace with
-    | Type -> Env.find_type_index id env
-    | Module -> Env.find_module_index id env
-    | Module_type -> Env.find_modtype_index id env
-    | Class -> Env.find_class_index id env
-    | Class_type-> Env.find_cltype_index id env
-    | Value | Extension_constructor | Constructor | Label -> None
-  in
-  let index =
-    match M.find_opt (Ident.name id) !bound_in_recursion with
-    | Some rec_bound_id ->
-        (* the identifier name appears in the current group of recursive
-           definition *)
-        if Ident.same rec_bound_id id then
-          Some 0
-        else
-          (* the current recursive definition shadows one more time the
-            previously existing identifier with the same name *)
-          Option.map succ (in_printing_env (find namespace id))
-    | None ->
-        in_printing_env (find namespace id)
-  in
-  let index =
-    (* If [index] is [None] at this point, it might indicate that
-       the identifier id is not defined in the environment, while there
-       are other identifiers in scope that share the same name.
-       Currently, this kind of partially incoherent environment happens
-       within functor error messages where the left and right hand side
-       have a different views of the environment at the source level.
-       Printing the source-level by using a default index of `0`
-       seems like a reasonable compromise in this situation however.*)
-    Option.value index ~default:0
-  in
-  human_id id index
-
-let ident_name namespace id =
-  match namespace, !enabled with
-  | None, _ | _, false -> Out_name.create (Ident.name id)
-  | Some namespace, true ->
-      if fuzzy_id namespace id then Out_name.create (Ident.name id)
-      else
-        let name = indexed_name namespace id in
-        Conflicts.collect_explanation namespace id ~name;
-        Out_name.create name
-end
-let ident_name = Naming_context.ident_name
-
-let ident ppf id = pp_print_string ppf
-    (Out_name.print (Naming_context.ident_name None id))
-
-let namespaced_ident namespace  id =
-  Out_name.print (Naming_context.ident_name (Some namespace) id)
+  let constructor ppf c =
+    reset_except_conflicts ();
+    add_constructor_to_preparation c;
+    prepared_constructor ppf c
 
+  let constructor_arguments ppf a =
+    let tys = tree_of_constructor_arguments a in
+    !Oprint.out_type ppf (Otyp_tuple tys)
 
-(* Print a path *)
+  let label ppf l =
+    prepare_for_printing [l.Types.ld_type];
+    !Oprint.out_label ppf (tree_of_label l)
 
-let ident_stdlib = Ident.create_persistent "Stdlib"
+  let extension_constructor id ppf ext =
+    !Oprint.out_sig_item ppf (tree_of_extension_constructor id ext Text_first)
 
-let non_shadowed_stdlib namespace = function
-  | Pdot(Pident id, s) as path ->
-      Ident.same id ident_stdlib &&
-      (match Namespace.lookup namespace s with
-       | path' -> Path.same path path'
-       | exception Not_found -> true)
-  | _ -> false
+  (* Print an extension declaration *)
 
-let find_double_underscore s =
-  let len = String.length s in
-  let rec loop i =
-    if i + 1 >= len then
-      None
-    else if s.[i] = '_' && s.[i + 1] = '_' then
-      Some i
-    else
-      loop (i + 1)
-  in
-  loop 0
 
-let rec module_path_is_an_alias_of env path ~alias_of =
-  match Env.find_module path env with
-  | { md_type = Mty_alias path'; _ } ->
-    Path.same path' alias_of ||
-    module_path_is_an_alias_of env path' ~alias_of
-  | _ -> false
-  | exception Not_found -> false
 
-(* Simple heuristic to print Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
-   for Foo__bar. This pattern is used by the stdlib. *)
-let rec rewrite_double_underscore_paths env p =
-  match p with
-  | Pdot (p, s) ->
-    Pdot (rewrite_double_underscore_paths env p, s)
-  | Papply (a, b) ->
-    Papply (rewrite_double_underscore_paths env a,
-            rewrite_double_underscore_paths env b)
-  | Pextra_ty (p, extra) ->
-    Pextra_ty (rewrite_double_underscore_paths env p, extra)
-  | Pident id ->
+  let extension_only_constructor id ppf (ext:Types.extension_constructor) =
+    reset_except_conflicts ();
+    prepare_type_constructor_arguments ext.ext_args;
+    Option.iter add_type_to_preparation ext.ext_ret_type;
     let name = Ident.name id in
-    match find_double_underscore name with
-    | None -> p
-    | Some i ->
-      let better_lid =
-        Ldot
-          (Lident (String.sub name 0 i),
-           Unit_info.modulize
-             (String.sub name (i + 2) (String.length name - i - 2)))
-      in
-      match Env.find_module_by_name better_lid env with
-      | exception Not_found -> p
-      | p', _ ->
-          if module_path_is_an_alias_of env p' ~alias_of:p then
-            p'
-          else
-          p
-
-let rewrite_double_underscore_paths env p =
-  if env == Env.empty then
-    p
-  else
-    rewrite_double_underscore_paths env p
-
-let rec tree_of_path ?(disambiguation=true) namespace p =
-  let tree_of_path namespace p = tree_of_path ~disambiguation namespace p in
-  let namespace = if disambiguation then namespace else None in
-  match p with
-  | Pident id ->
-      Oide_ident (ident_name namespace id)
-  | Pdot(_, s) as path when non_shadowed_stdlib namespace path ->
-      Oide_ident (Out_name.create s)
-  | Pdot(p, s) ->
-      Oide_dot (tree_of_path (Some Module) p, s)
-  | Papply(p1, p2) ->
-      let t1 = tree_of_path (Some Module) p1 in
-      let t2 = tree_of_path (Some Module) p2 in
-      Oide_apply (t1, t2)
-  | Pextra_ty (p, extra) -> begin
-      (* inline record types are syntactically prevented from escaping their
-         binding scope, and are never shown to users. *)
-      match extra with
-        Pcstr_ty s ->
-          Oide_dot (tree_of_path (Some Type) p, s)
-      | Pext_ty ->
-          tree_of_path None p
-    end
-
-let tree_of_path ?disambiguation namespace p =
-  tree_of_path ?disambiguation namespace
-    (rewrite_double_underscore_paths !printing_env p)
-
-let path ppf p =
-  !Oprint.out_ident ppf (tree_of_path None p)
-
-let string_of_path p =
-  Format.asprintf "%a" path p
-
-let strings_of_paths namespace p =
-  let trees = List.map (tree_of_path namespace) p in
-  List.map (Format.asprintf "%a" !Oprint.out_ident) trees
-
-let () = Env.print_path := path
-
-(* Print a recursive annotation *)
-
-let tree_of_rec = function
-  | Trec_not -> Orec_not
-  | Trec_first -> Orec_first
-  | Trec_next -> Orec_next
-
-(* Print a raw type expression, with sharing *)
-
-let raw_list pr ppf = function
-    [] -> fprintf ppf "[]"
-  | a :: l ->
-      fprintf ppf "@[<1>[%a%t]@]" pr a
-        (fun ppf -> List.iter (fun x -> fprintf ppf ";@,%a" pr x) l)
-
-let kind_vars = ref []
-let kind_count = ref 0
-
-let string_of_field_kind v =
-  match field_kind_repr v with
-  | Fpublic -> "Fpublic"
-  | Fabsent -> "Fabsent"
-  | Fprivate -> "Fprivate"
-
-let rec safe_repr v t =
-  match Transient_expr.coerce t with
-    {desc = Tlink t} when not (List.memq t v) ->
-      safe_repr (t::v) t
-  | t' -> t'
-
-let rec list_of_memo = function
-    Mnil -> []
-  | Mcons (_priv, p, _t1, _t2, rem) -> p :: list_of_memo rem
-  | Mlink rem -> list_of_memo !rem
-
-let print_name ppf = function
-    None -> fprintf ppf "None"
-  | Some name -> fprintf ppf "\"%s\"" name
-
-let string_of_label = function
-    Nolabel -> ""
-  | Labelled s -> s
-  | Optional s -> "?"^s
-
-let visited = ref []
-let rec raw_type ppf ty =
-  let ty = safe_repr [] ty in
-  if List.memq ty !visited then fprintf ppf "{id=%d}" ty.id else begin
-    visited := ty :: !visited;
-    fprintf ppf "@[<1>{id=%d;level=%d;scope=%d;desc=@,%a}@]" ty.id ty.level
-      ty.scope raw_type_desc ty.desc
-  end
-and raw_type_list tl = raw_list raw_type tl
-and raw_lid_type_list tl =
-  raw_list (fun ppf (lid, typ) ->
-             fprintf ppf "(@,%a,@,%a)" longident lid raw_type typ)
-    tl
-and raw_type_desc ppf = function
-    Tvar name -> fprintf ppf "Tvar %a" print_name name
-  | Tarrow(l,t1,t2,c) ->
-      fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
-        (string_of_label l) raw_type t1 raw_type t2
-        (if is_commu_ok c then "Cok" else "Cunknown")
-  | Ttuple tl ->
-      fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
-  | Tconstr (p, tl, abbrev) ->
-      fprintf ppf "@[<hov1>Tconstr(@,%a,@,%a,@,%a)@]" path p
-        raw_type_list tl
-        (raw_list path) (list_of_memo !abbrev)
-  | Tobject (t, nm) ->
-      fprintf ppf "@[<hov1>Tobject(@,%a,@,@[<1>ref%t@])@]" raw_type t
-        (fun ppf ->
-          match !nm with None -> fprintf ppf " None"
-          | Some(p,tl) ->
-              fprintf ppf "(Some(@,%a,@,%a))" path p raw_type_list tl)
-  | Tfield (f, k, t1, t2) ->
-      fprintf ppf "@[<hov1>Tfield(@,%s,@,%s,@,%a,@;<0 -1>%a)@]" f
-        (string_of_field_kind k)
-        raw_type t1 raw_type t2
-  | Tnil -> fprintf ppf "Tnil"
-  | Tlink t -> fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
-  | Tsubst (t, None) -> fprintf ppf "@[<1>Tsubst@,(%a,None)@]" raw_type t
-  | Tsubst (t, Some t') ->
-      fprintf ppf "@[<1>Tsubst@,(%a,@ Some%a)@]" raw_type t raw_type t'
-  | Tunivar name -> fprintf ppf "Tunivar %a" print_name name
-  | Tpoly (t, tl) ->
-      fprintf ppf "@[<hov1>Tpoly(@,%a,@,%a)@]"
-        raw_type t
-        raw_type_list tl
-  | Tvariant row ->
-      let Row {fields; more; name; fixed; closed} = row_repr row in
-      fprintf ppf
-        "@[<hov1>{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%a;@ @[<1>%s%t@]}@]"
-        "row_fields="
-        (raw_list (fun ppf (l, f) ->
-          fprintf ppf "@[%s,@ %a@]" l raw_field f))
-        fields
-        "row_more=" raw_type more
-        "row_closed=" closed
-        "row_fixed=" raw_row_fixed fixed
-        "row_name="
-        (fun ppf ->
-          match name with None -> fprintf ppf "None"
-          | Some(p,tl) ->
-              fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
-  | Tpackage (p, fl) ->
-    fprintf ppf "@[<hov1>Tpackage(@,%a,@,%a)@]" path p raw_lid_type_list fl
-and raw_row_fixed ppf = function
-| None -> fprintf ppf "None"
-| Some Types.Fixed_private -> fprintf ppf "Some Fixed_private"
-| Some Types.Rigid -> fprintf ppf "Some Rigid"
-| Some Types.Univar t -> fprintf ppf "Some(Univar(%a))" raw_type t
-| Some Types.Reified p -> fprintf ppf "Some(Reified(%a))" path p
-
-and raw_field ppf rf =
-  match_row_field
-    ~absent:(fun _ -> fprintf ppf "RFabsent")
-    ~present:(function
-      | None ->
-          fprintf ppf "RFpresent None"
-      | Some t ->
-          fprintf ppf  "@[<1>RFpresent(Some@,%a)@]" raw_type t)
-    ~either:(fun c tl m e ->
-      fprintf ppf "@[<hov1>RFeither(%B,@,%a,@,%B,@,@[<1>ref%t@])@]" c
-        raw_type_list tl m
-        (fun ppf ->
-          match e with None -> fprintf ppf " RFnone"
-          | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f))
-    rf
-
-let raw_type_expr ppf t =
-  visited := []; kind_vars := []; kind_count := 0;
-  raw_type ppf t;
-  visited := []; kind_vars := []
-
-let () = Btype.print_raw := raw_type_expr
-
-(* Normalize paths *)
-
-type param_subst = Id | Nth of int | Map of int list
-
-let is_nth = function
-    Nth _ -> true
-  | _ -> false
-
-let compose l1 = function
-  | Id -> Map l1
-  | Map l2 -> Map (List.map (List.nth l1) l2)
-  | Nth n  -> Nth (List.nth l1 n)
-
-let apply_subst s1 tyl =
-  if tyl = [] then []
-  (* cf. PR#7543: Typemod.type_package doesn't respect type constructor arity *)
-  else
-    match s1 with
-      Nth n1 -> [List.nth tyl n1]
-    | Map l1 -> List.map (List.nth tyl) l1
-    | Id -> tyl
-
-type best_path = Paths of Path.t list | Best of Path.t
-
-(** Short-paths cache: the five mutable variables below implement a one-slot
-    cache for short-paths
- *)
-let printing_old = ref Env.empty
-let printing_pers = ref String.Set.empty
-(** {!printing_old} and  {!printing_pers} are the keys of the one-slot cache *)
-
-let printing_depth = ref 0
-let printing_cont = ref ([] : Env.iter_cont list)
-let printing_map = ref Path.Map.empty
-(**
-   - {!printing_map} is the main value stored in the cache.
-   Note that it is evaluated lazily and its value is updated during printing.
-   - {!printing_dep} is the current exploration depth of the environment,
-   it is used to determine whenever the {!printing_map} should be evaluated
-   further before completing a request.
-   - {!printing_cont} is the list of continuations needed to evaluate
-   the {!printing_map} one level further (see also {!Env.run_iter_cont})
-*)
-
-let rec index l x =
-  match l with
-    [] -> raise Not_found
-  | a :: l -> if eq_type x a then 0 else 1 + index l x
-
-let rec uniq = function
-    [] -> true
-  | a :: l -> not (List.memq (a : int) l) && uniq l
-
-let rec normalize_type_path ?(cache=false) env p =
-  try
-    let (params, ty, _) = Env.find_type_expansion p env in
-    match get_desc ty with
-      Tconstr (p1, tyl, _) ->
-        if List.length params = List.length tyl
-        && List.for_all2 eq_type params tyl
-        then normalize_type_path ~cache env p1
-        else if cache || List.length params <= List.length tyl
-             || not (uniq (List.map get_id tyl)) then (p, Id)
-        else
-          let l1 = List.map (index params) tyl in
-          let (p2, s2) = normalize_type_path ~cache env p1 in
-          (p2, compose l1 s2)
-    | _ ->
-        (p, Nth (index params ty))
-  with
-    Not_found ->
-      (Env.normalize_type_path None env p, Id)
-
-let penalty s =
-  if s <> "" && s.[0] = '_' then
-    10
-  else
-    match find_double_underscore s with
-    | None -> 1
-    | Some _ -> 10
-
-let rec path_size = function
-    Pident id ->
-      penalty (Ident.name id), -Ident.scope id
-  | Pdot (p, _) | Pextra_ty (p, Pcstr_ty _) ->
-      let (l, b) = path_size p in (1+l, b)
-  | Papply (p1, p2) ->
-      let (l, b) = path_size p1 in
-      (l + fst (path_size p2), b)
-  | Pextra_ty (p, _) -> path_size p
-
-let same_printing_env env =
-  let used_pers = Env.used_persistent () in
-  Env.same_types !printing_old env && String.Set.equal !printing_pers used_pers
-
-let set_printing_env env =
-  printing_env := env;
-  if !Clflags.real_paths ||
-     !printing_env == Env.empty ||
-     same_printing_env env then
-    ()
-  else begin
-    (* printf "Reset printing_map@."; *)
-    printing_old := env;
-    printing_pers := Env.used_persistent ();
-    printing_map := Path.Map.empty;
-    printing_depth := 0;
-    (* printf "Recompute printing_map.@."; *)
-    let cont =
-      Env.iter_types
-        (fun p (p', _decl) ->
-          let (p1, s1) = normalize_type_path env p' ~cache:true in
-          (* Format.eprintf "%a -> %a = %a@." path p path p' path p1 *)
-          if s1 = Id then
-          try
-            let r = Path.Map.find p1 !printing_map in
-            match !r with
-              Paths l -> r := Paths (p :: l)
-            | Best p' -> r := Paths [p; p'] (* assert false *)
-          with Not_found ->
-            printing_map := Path.Map.add p1 (ref (Paths [p])) !printing_map)
-        env in
-    printing_cont := [cont];
-  end
-
-let wrap_printing_env env f =
-  set_printing_env env;
-  try_finally f ~always:(fun () -> set_printing_env Env.empty)
-
-let wrap_printing_env ~error env f =
-  if error then Env.without_cmis (wrap_printing_env env) f
-  else wrap_printing_env env f
-
-let rec lid_of_path = function
-    Path.Pident id ->
-      Longident.Lident (Ident.name id)
-  | Path.Pdot (p1, s) | Path.Pextra_ty (p1, Pcstr_ty s)  ->
-      Longident.Ldot (lid_of_path p1, s)
-  | Path.Papply (p1, p2) ->
-      Longident.Lapply (lid_of_path p1, lid_of_path p2)
-  | Path.Pextra_ty (p, Pext_ty) -> lid_of_path p
-
-let is_unambiguous path env =
-  let l = Env.find_shadowed_types path env in
-  List.exists (Path.same path) l || (* concrete paths are ok *)
-  match l with
-    [] -> true
-  | p :: rem ->
-      (* allow also coherent paths:  *)
-      let normalize p = fst (normalize_type_path ~cache:true env p) in
-      let p' = normalize p in
-      List.for_all (fun p -> Path.same (normalize p) p') rem ||
-      (* also allow repeatedly defining and opening (for toplevel) *)
-      let id = lid_of_path p in
-      List.for_all (fun p -> lid_of_path p = id) rem &&
-      Path.same p (fst (Env.find_type_by_name id env))
-
-let rec get_best_path r =
-  match !r with
-    Best p' -> p'
-  | Paths [] -> raise Not_found
-  | Paths l ->
-      r := Paths [];
-      List.iter
-        (fun p ->
-          (* Format.eprintf "evaluating %a@." path p; *)
-          match !r with
-            Best p' when path_size p >= path_size p' -> ()
-          | _ -> if is_unambiguous p !printing_env then r := Best p)
-              (* else Format.eprintf "%a ignored as ambiguous@." path p *)
-        l;
-      get_best_path r
-
-let best_type_path p =
-  if !printing_env == Env.empty
-  then (p, Id)
-  else if !Clflags.real_paths
-  then (p, Id)
-  else
-    let (p', s) = normalize_type_path !printing_env p in
-    let get_path () = get_best_path (Path.Map.find  p' !printing_map) in
-    while !printing_cont <> [] &&
-      try fst (path_size (get_path ())) > !printing_depth with Not_found -> true
-    do
-      printing_cont := List.map snd (Env.run_iter_cont !printing_cont);
-      incr printing_depth;
-    done;
-    let p'' = try get_path () with Not_found -> p' in
-    (* Format.eprintf "%a = %a -> %a@." path p path p' path p''; *)
-    (p'', s)
-
-(* When building a tree for a best type path, we should not disambiguate
-   identifiers whenever the short-path algorithm detected a better path than
-   the original one.*)
-let tree_of_best_type_path p p' =
-  if Path.same p p' then tree_of_path (Some Type) p'
-  else tree_of_path ~disambiguation:false None p'
-
-(* Print a type expression *)
-
-let proxy ty = Transient_expr.repr (proxy ty)
-
-(* When printing a type scheme, we print weak names.  When printing a plain
-   type, we do not.  This type controls that behavior *)
-type type_or_scheme = Type | Type_scheme
-
-let is_non_gen mode ty =
-  match mode with
-  | Type_scheme -> is_Tvar ty && get_level ty <> generic_level
-  | Type        -> false
-
-let nameable_row row =
-  row_name row <> None &&
-  List.for_all
-    (fun (_, f) ->
-       match row_field_repr f with
-       | Reither(c, l, _) ->
-           row_closed row && if c then l = [] else List.length l = 1
-       | _ -> true)
-    (row_fields row)
-
-(* This specialized version of [Btype.iter_type_expr] normalizes and
-   short-circuits the traversal of the [type_expr], so that it covers only the
-   subterms that would be printed by the type printer. *)
-let printer_iter_type_expr f ty =
-  match get_desc ty with
-  | Tconstr(p, tyl, _) ->
-      let (_p', s) = best_type_path p in
-      List.iter f (apply_subst s tyl)
-  | Tvariant row -> begin
-      match row_name row with
-      | Some(_p, tyl) when nameable_row row ->
-          List.iter f tyl
-      | _ ->
-          iter_row f row
-    end
-  | Tobject (fi, nm) -> begin
-      match !nm with
-      | None ->
-          let fields, _ = flatten_fields fi in
-          List.iter
-            (fun (_, kind, ty) ->
-               if field_kind_repr kind = Fpublic then
-                 f ty)
-            fields
-      | Some (_, l) ->
-          List.iter f (List.tl l)
-    end
-  | Tfield(_, kind, ty1, ty2) ->
-      if field_kind_repr kind = Fpublic then
-        f ty1;
-      f ty2
-  | _ ->
-      Btype.iter_type_expr f ty
-
-module Internal_names : sig
-
-  val reset : unit -> unit
-
-  val add : Path.t -> unit
-
-  val print_explanations : Env.t -> Format.formatter -> unit
-
-end = struct
-
-  let names = ref Ident.Set.empty
-
-  let reset () =
-    names := Ident.Set.empty
-
-  let add p =
-    match p with
-    | Pident id ->
-        let name = Ident.name id in
-        if String.length name > 0 && name.[0] = '$' then begin
-          names := Ident.Set.add id !names
-        end
-    | Pdot _ | Papply _ | Pextra_ty _ -> ()
-
-  let print_explanations env ppf =
-    let constrs =
-      Ident.Set.fold
-        (fun id acc ->
-          let p = Pident id in
-          match Env.find_type p env with
-          | exception Not_found -> acc
-          | decl ->
-              match type_origin decl with
-              | Existential constr ->
-                  let prev = String.Map.find_opt constr acc in
-                  let prev = Option.value ~default:[] prev in
-                  String.Map.add constr (tree_of_path None p :: prev) acc
-              | Definition | Rec_check_regularity -> acc)
-        !names String.Map.empty
+    let args, ret =
+      extension_constructor_args_and_ret_type_subtree
+        ext.ext_args
+        ext.ext_ret_type
     in
-    String.Map.iter
-      (fun constr out_idents ->
-        match out_idents with
-        | [] -> ()
-        | [out_ident] ->
-            fprintf ppf
-              "@ @[<2>@{<hint>Hint@}:@ %a@ is an existential type@ \
-               bound by the constructor@ %a.@]"
-              (Style.as_inline_code !Oprint.out_ident) out_ident
-              Style.inline_code constr
-        | out_ident :: out_idents ->
-            fprintf ppf
-              "@ @[<2>@{<hint>Hint@}:@ %a@ and %a@ are existential types@ \
-               bound by the constructor@ %a.@]"
-              (Format.pp_print_list
-                 ~pp_sep:(fun ppf () -> fprintf ppf ",@ ")
-                 (Style.as_inline_code !Oprint.out_ident))
-              (List.rev out_idents)
-              (Style.as_inline_code !Oprint.out_ident) out_ident
-              Style.inline_code constr)
-      constrs
-
-end
-
-module Names : sig
-  val reset_names : unit -> unit
-
-  val add_named_vars : type_expr -> unit
-  val add_subst : (type_expr * type_expr) list -> unit
-
-  val new_name : unit -> string
-  val new_var_name : non_gen:bool -> type_expr -> unit -> string
-
-  val name_of_type : (unit -> string) -> transient_expr -> string
-  val check_name_of_type : non_gen:bool -> transient_expr -> unit
-
-  val remove_names : transient_expr list -> unit
-
-  val with_local_names : (unit -> 'a) -> 'a
-
-  (* Refresh the weak variable map in the toplevel; for [print_items], which is
-     itself for the toplevel *)
-  val refresh_weak : unit -> unit
-end = struct
-  (* We map from types to names, but not directly; we also store a substitution,
-     which maps from types to types.  The lookup process is
-     "type -> apply substitution -> find name".  The substitution is presumed to
-     be acyclic. *)
-  let names = ref ([] : (transient_expr * string) list)
-  let name_subst = ref ([] : (transient_expr * transient_expr) list)
-  let name_counter = ref 0
-  let named_vars = ref ([] : string list)
-  let visited_for_named_vars = ref ([] : transient_expr list)
-
-  let weak_counter = ref 1
-  let weak_var_map = ref TypeMap.empty
-  let named_weak_vars = ref String.Set.empty
-
-  let reset_names () =
-    names := [];
-    name_subst := [];
-    name_counter := 0;
-    named_vars := [];
-    visited_for_named_vars := []
-
-  let add_named_var tty =
-    match tty.desc with
-      Tvar (Some name) | Tunivar (Some name) ->
-        if List.mem name !named_vars then () else
-        named_vars := name :: !named_vars
-    | _ -> ()
-
-  let rec add_named_vars ty =
-    let tty = Transient_expr.repr ty in
-    let px = proxy ty in
-    if not (List.memq px !visited_for_named_vars) then begin
-      visited_for_named_vars := px :: !visited_for_named_vars;
-      match tty.desc with
-      | Tvar _ | Tunivar _ ->
-          add_named_var tty
-      | _ ->
-          printer_iter_type_expr add_named_vars ty
-    end
-
-  let rec substitute ty =
-    match List.assq ty !name_subst with
-    | ty' -> substitute ty'
-    | exception Not_found -> ty
-
-  let add_subst subst =
-    name_subst :=
-      List.map (fun (t1,t2) -> Transient_expr.repr t1, Transient_expr.repr t2)
-        subst
-      @ !name_subst
-
-  let name_is_already_used name =
-    List.mem name !named_vars
-    || List.exists (fun (_, name') -> name = name') !names
-    || String.Set.mem name !named_weak_vars
-
-  let rec new_name () =
-    let name = Misc.letter_of_int !name_counter in
-    incr name_counter;
-    if name_is_already_used name then new_name () else name
-
-  let rec new_weak_name ty () =
-    let name = "weak" ^ Int.to_string !weak_counter in
-    incr weak_counter;
-    if name_is_already_used name then new_weak_name ty ()
-    else begin
-        named_weak_vars := String.Set.add name !named_weak_vars;
-        weak_var_map := TypeMap.add ty name !weak_var_map;
-        name
-      end
-
-  let new_var_name ~non_gen ty () =
-    if non_gen then new_weak_name ty ()
-    else new_name ()
-
-  let name_of_type name_generator t =
-    (* We've already been through repr at this stage, so t is our representative
-       of the union-find class. *)
-    let t = substitute t in
-    try List.assq t !names with Not_found ->
-      try TransientTypeMap.find t !weak_var_map with Not_found ->
-      let name =
-        match t.desc with
-          Tvar (Some name) | Tunivar (Some name) ->
-            (* Some part of the type we've already printed has assigned another
-             * unification variable to that name. We want to keep the name, so
-             * try adding a number until we find a name that's not taken. *)
-            let available name =
-              List.for_all
-                (fun (_, name') -> name <> name')
-                !names
-            in
-            if available name then name
-            else
-              let suffixed i = name ^ Int.to_string i in
-              let i = Misc.find_first_mono (fun i -> available (suffixed i)) in
-              suffixed i
-        | _ ->
-            (* No name available, create a new one *)
-            name_generator ()
-      in
-      (* Exception for type declarations *)
-      if name <> "_" then names := (t, name) :: !names;
-      name
-
-  let check_name_of_type ~non_gen px =
-    let name_gen = new_var_name ~non_gen (Transient_expr.type_expr px) in
-    ignore(name_of_type name_gen px)
-
-  let remove_names tyl =
-    let tyl = List.map substitute tyl in
-    names := List.filter (fun (ty,_) -> not (List.memq ty tyl)) !names
-
-  let with_local_names f =
-    let old_names = !names in
-    let old_subst = !name_subst in
-    names      := [];
-    name_subst := [];
-    try_finally
-      ~always:(fun () ->
-        names      := old_names;
-        name_subst := old_subst)
-      f
-
-  let refresh_weak () =
-    let refresh t name (m,s) =
-      if is_non_gen Type_scheme t then
-        begin
-          TypeMap.add t name m,
-          String.Set.add name s
-        end
-      else m, s in
-    let m, s =
-      TypeMap.fold refresh !weak_var_map (TypeMap.empty ,String.Set.empty) in
-    named_weak_vars := s;
-    weak_var_map := m
-end
-
-let reserve_names ty =
-  normalize_type ty;
-  Names.add_named_vars ty
-
-let visited_objects = ref ([] : transient_expr list)
-let aliased = ref ([] : transient_expr list)
-let delayed = ref ([] : transient_expr list)
-let printed_aliases = ref ([] : transient_expr list)
-
-(* [printed_aliases] is a subset of [aliased] that records only those aliased
-   types that have actually been printed; this allows us to avoid naming loops
-   that the user will never see. *)
-
-let add_delayed t =
-  if not (List.memq t !delayed) then delayed := t :: !delayed
-
-let is_aliased_proxy px = List.memq px !aliased
-
-let add_alias_proxy px =
-  if not (is_aliased_proxy px) then
-    aliased := px :: !aliased
-
-let add_alias ty = add_alias_proxy (proxy ty)
-
-let add_printed_alias_proxy ~non_gen px =
-  Names.check_name_of_type ~non_gen px;
-  printed_aliases := px :: !printed_aliases
-
-let add_printed_alias ty = add_printed_alias_proxy (proxy ty)
-
-let aliasable ty =
-  match get_desc ty with
-    Tvar _ | Tunivar _ | Tpoly _ -> false
-  | Tconstr (p, _, _) ->
-      not (is_nth (snd (best_type_path p)))
-  | _ -> true
-
-let should_visit_object ty =
-  match get_desc ty with
-  | Tvariant row -> not (static_row row)
-  | Tobject _ -> opened_object ty
-  | _ -> false
-
-let rec mark_loops_rec visited ty =
-  let px = proxy ty in
-  if List.memq px visited && aliasable ty then add_alias_proxy px else
-    let tty = Transient_expr.repr ty in
-    let visited = px :: visited in
-    match tty.desc with
-    | Tvariant _ | Tobject _ ->
-        if List.memq px !visited_objects then add_alias_proxy px else begin
-          if should_visit_object ty then
-            visited_objects := px :: !visited_objects;
-          printer_iter_type_expr (mark_loops_rec visited) ty
-        end
-    | Tpoly(ty, tyl) ->
-        List.iter add_alias tyl;
-        mark_loops_rec visited ty
-    | _ ->
-        printer_iter_type_expr (mark_loops_rec visited) ty
-
-let mark_loops ty =
-  mark_loops_rec [] ty
-
-let prepare_type ty =
-  reserve_names ty;
-  mark_loops ty
-
-let reset_loop_marks () =
-  visited_objects := []; aliased := []; delayed := []; printed_aliases := []
-
-let reset_except_context () =
-  Names.reset_names (); reset_loop_marks (); Internal_names.reset ()
-
-let reset () =
-  Conflicts.reset ();
-  reset_except_context ()
-
-let prepare_for_printing tyl =
-  reset_except_context ();
-  List.iter prepare_type tyl
-
-let add_type_to_preparation = prepare_type
-
-(* Disabled in classic mode when printing an unification error *)
-let print_labels = ref true
-
-let alias_nongen_row mode px ty =
-    match get_desc ty with
-    | Tvariant _ | Tobject _ ->
-        if is_non_gen mode (Transient_expr.type_expr px) then
-          add_alias_proxy px
-    | _ -> ()
-
-let rec tree_of_typexp mode ty =
-  let px = proxy ty in
-  if List.memq px !printed_aliases && not (List.memq px !delayed) then
-   let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
-   let name = Names.name_of_type (Names.new_var_name ~non_gen ty) px in
-   Otyp_var (non_gen, name) else
-
-  let pr_typ () =
-    let tty = Transient_expr.repr ty in
-    match tty.desc with
-    | Tvar _ ->
-        let non_gen = is_non_gen mode ty in
-        let name_gen = Names.new_var_name ~non_gen ty in
-        Otyp_var (non_gen, Names.name_of_type name_gen tty)
-    | Tarrow(l, ty1, ty2, _) ->
-        let lab =
-          if !print_labels || is_optional l then l else Nolabel
-        in
-        let t1 =
-          if is_optional l then
-            match get_desc ty1 with
-            | Tconstr(path, [ty], _)
-              when Path.same path Predef.path_option ->
-                tree_of_typexp mode ty
-            | _ -> Otyp_stuff "<hidden>"
-          else tree_of_typexp mode ty1 in
-        Otyp_arrow (lab, t1, tree_of_typexp mode ty2)
-    | Ttuple tyl ->
-        Otyp_tuple (tree_of_typlist mode tyl)
-    | Tconstr(p, tyl, _abbrev) ->
-        let p', s = best_type_path p in
-        let tyl' = apply_subst s tyl in
-        if is_nth s && not (tyl'=[])
-        then tree_of_typexp mode (List.hd tyl')
-        else begin
-          Internal_names.add p';
-          Otyp_constr (tree_of_best_type_path p p', tree_of_typlist mode tyl')
-        end
-    | Tvariant row ->
-        let Row {fields; name; closed; _} = row_repr row in
-        let fields =
-          if closed then
-            List.filter (fun (_, f) -> row_field_repr f <> Rabsent)
-              fields
-          else fields in
-        let present =
-          List.filter
-            (fun (_, f) ->
-               match row_field_repr f with
-               | Rpresent _ -> true
-               | _ -> false)
-            fields in
-        let all_present = List.length present = List.length fields in
-        begin match name with
-        | Some(p, tyl) when nameable_row row ->
-            let (p', s) = best_type_path p in
-            let id = tree_of_best_type_path p p' in
-            let args = tree_of_typlist mode (apply_subst s tyl) in
-            let out_variant =
-              if is_nth s then List.hd args else Otyp_constr (id, args) in
-            if closed && all_present then
-              out_variant
-            else
-              let tags =
-                if all_present then None else Some (List.map fst present) in
-              Otyp_variant (Ovar_typ out_variant, closed, tags)
-        | _ ->
-            let fields = List.map (tree_of_row_field mode) fields in
-            let tags =
-              if all_present then None else Some (List.map fst present) in
-            Otyp_variant (Ovar_fields fields, closed, tags)
-        end
-    | Tobject (fi, nm) ->
-        tree_of_typobject mode fi !nm
-    | Tnil | Tfield _ ->
-        tree_of_typobject mode ty None
-    | Tsubst _ ->
-        (* This case should only happen when debugging the compiler *)
-        Otyp_stuff "<Tsubst>"
-    | Tlink _ ->
-        fatal_error "Printtyp.tree_of_typexp"
-    | Tpoly (ty, []) ->
-        tree_of_typexp mode ty
-    | Tpoly (ty, tyl) ->
-        (*let print_names () =
-          List.iter (fun (_, name) -> prerr_string (name ^ " ")) !names;
-          prerr_string "; " in *)
-        if tyl = [] then tree_of_typexp mode ty else begin
-          let tyl = List.map Transient_expr.repr tyl in
-          let old_delayed = !delayed in
-          (* Make the names delayed, so that the real type is
-             printed once when used as proxy *)
-          List.iter add_delayed tyl;
-          let tl = List.map (Names.name_of_type Names.new_name) tyl in
-          let tr = Otyp_poly (tl, tree_of_typexp mode ty) in
-          (* Forget names when we leave scope *)
-          Names.remove_names tyl;
-          delayed := old_delayed; tr
-        end
-    | Tunivar _ ->
-        Otyp_var (false, Names.name_of_type Names.new_name tty)
-    | Tpackage (p, fl) ->
-        let fl =
-          List.map
-            (fun (li, ty) -> (
-              String.concat "." (Longident.flatten li),
-              tree_of_typexp mode ty
-            )) fl in
-        Otyp_module (tree_of_path (Some Module_type) p, fl)
-  in
-  if List.memq px !delayed then delayed := List.filter ((!=) px) !delayed;
-  alias_nongen_row mode px ty;
-  if is_aliased_proxy px && aliasable ty then begin
-    let non_gen = is_non_gen mode (Transient_expr.type_expr px) in
-    add_printed_alias_proxy ~non_gen px;
-    (* add_printed_alias chose a name, thus the name generator
-       doesn't matter.*)
-    let alias = Names.name_of_type (Names.new_var_name ~non_gen ty) px in
-    Otyp_alias {non_gen;  aliased = pr_typ (); alias } end
-  else pr_typ ()
-
-and tree_of_row_field mode (l, f) =
-  match row_field_repr f with
-  | Rpresent None | Reither(true, [], _) -> (l, false, [])
-  | Rpresent(Some ty) -> (l, false, [tree_of_typexp mode ty])
-  | Reither(c, tyl, _) ->
-      if c (* contradiction: constant constructor with an argument *)
-      then (l, true, tree_of_typlist mode tyl)
-      else (l, false, tree_of_typlist mode tyl)
-  | Rabsent -> (l, false, [] (* actually, an error *))
-
-and tree_of_typlist mode tyl =
-  List.map (tree_of_typexp mode) tyl
-
-and tree_of_typobject mode fi nm =
-  begin match nm with
-  | None ->
-      let pr_fields fi =
-        let (fields, rest) = flatten_fields fi in
-        let present_fields =
-          List.fold_right
-            (fun (n, k, t) l ->
-               match field_kind_repr k with
-               | Fpublic -> (n, t) :: l
-               | _ -> l)
-            fields [] in
-        let sorted_fields =
-          List.sort
-            (fun (n, _) (n', _) -> String.compare n n') present_fields in
-        tree_of_typfields mode rest sorted_fields in
-      let (fields, open_row) = pr_fields fi in
-      Otyp_object {fields; open_row}
-  | Some (p, _ty :: tyl) ->
-      let args = tree_of_typlist mode tyl in
-      let (p', s) = best_type_path p in
-      assert (s = Id);
-      Otyp_class (tree_of_best_type_path p p', args)
-  | _ ->
-      fatal_error "Printtyp.tree_of_typobject"
-  end
-
-and tree_of_typfields mode rest = function
-  | [] ->
-      let open_row =
-        match get_desc rest with
-        | Tvar _ | Tunivar _ | Tconstr _-> true
-        | Tnil -> false
-        | _ -> fatal_error "typfields (1)"
-      in
-      ([], open_row)
-  | (s, t) :: l ->
-      let field = (s, tree_of_typexp mode t) in
-      let (fields, rest) = tree_of_typfields mode rest l in
-      (field :: fields, rest)
-
-let typexp mode ppf ty =
-  !Oprint.out_type ppf (tree_of_typexp mode ty)
-
-let prepared_type_expr ppf ty = typexp Type ppf ty
-
-let type_expr ppf ty =
-  (* [type_expr] is used directly by error message printers,
-     we mark eventual loops ourself to avoid any misuse and stack overflow *)
-  prepare_for_printing [ty];
-  prepared_type_expr ppf ty
-
-(* "Half-prepared" type expression: [ty] should have had its names reserved, but
-   should not have had its loops marked. *)
-let type_expr_with_reserved_names ppf ty =
-  reset_loop_marks ();
-  mark_loops ty;
-  prepared_type_expr ppf ty
-
-let shared_type_scheme ppf ty =
-  prepare_type ty;
-  typexp Type_scheme ppf ty
-
-let prepared_type_scheme ppf ty = typexp Type_scheme ppf ty
-
-let type_scheme ppf ty =
-  prepare_for_printing [ty];
-  prepared_type_scheme ppf ty
-
-let type_path ppf p =
-  let (p', s) = best_type_path p in
-  let p'' = if (s = Id) then p' else p in
-  let t = tree_of_best_type_path p p'' in
-  !Oprint.out_ident ppf t
-
-let tree_of_type_scheme ty =
-  prepare_for_printing [ty];
-  tree_of_typexp Type_scheme ty
-
-(* Print one type declaration *)
-
-let tree_of_constraints params =
-  List.fold_right
-    (fun ty list ->
-       let ty' = unalias ty in
-       if proxy ty != proxy ty' then
-         let tr = tree_of_typexp Type_scheme ty in
-         (tr, tree_of_typexp Type_scheme ty') :: list
-       else list)
-    params []
-
-let filter_params tyl =
-  let params =
-    List.fold_left
-      (fun tyl ty ->
-        if List.exists (eq_type ty) tyl
-        then newty2 ~level:generic_level (Ttuple [ty]) :: tyl
-        else ty :: tyl)
-      (* Two parameters might be identical due to a constraint but we need to
-         print them differently in order to make the output syntactically valid.
-         We use [Ttuple [ty]] because it is printed as [ty]. *)
-      (* Replacing fold_left by fold_right does not work! *)
-      [] tyl
-  in List.rev params
-
-let prepare_type_constructor_arguments = function
-  | Cstr_tuple l -> List.iter prepare_type l
-  | Cstr_record l -> List.iter (fun l -> prepare_type l.ld_type) l
-
-let tree_of_label l =
-  (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp Type l.ld_type)
-
-let tree_of_constructor_arguments = function
-  | Cstr_tuple l -> tree_of_typlist Type l
-  | Cstr_record l -> [ Otyp_record (List.map tree_of_label l) ]
-
-let tree_of_single_constructor cd =
-  let name = Ident.name cd.cd_id in
-  let ret = Option.map (tree_of_typexp Type) cd.cd_res in
-  let args = tree_of_constructor_arguments cd.cd_args in
-  {
-      ocstr_name = name;
-      ocstr_args = args;
-      ocstr_return_type = ret;
-  }
-
-(* When printing GADT constructor, we need to forget the naming decision we took
-  for the type parameters and constraints. Indeed, in
-  {[
-  type 'a t = X: 'a -> 'b t
-   ]}
-  It is fine to print both the type parameter ['a] and the existentially
-  quantified ['a] in the definition of the constructor X as ['a]
- *)
-let tree_of_constructor_in_decl cd =
-  match cd.cd_res with
-  | None -> tree_of_single_constructor cd
-  | Some _ -> Names.with_local_names (fun () -> tree_of_single_constructor cd)
-
-let prepare_decl id decl =
-  let params = filter_params decl.type_params in
-  begin match decl.type_manifest with
-  | Some ty ->
-      let vars = free_variables ty in
-      List.iter
-        (fun ty ->
-          if get_desc ty = Tvar (Some "_") && List.exists (eq_type ty) vars
-          then set_type_desc ty (Tvar None))
-        params
-  | None -> ()
-  end;
-  List.iter add_alias params;
-  List.iter prepare_type params;
-  List.iter (add_printed_alias ~non_gen:false) params;
-  let ty_manifest =
-    match decl.type_manifest with
-    | None -> None
-    | Some ty ->
-        let ty =
-          (* Special hack to hide variant name *)
-          match get_desc ty with
-            Tvariant row ->
-              begin match row_name row with
-                Some (Pident id', _) when Ident.same id id' ->
-                  newgenty (Tvariant (set_row_name row None))
-              | _ -> ty
-              end
-          | _ -> ty
-        in
-        prepare_type ty;
-        Some ty
-  in
-  begin match decl.type_kind with
-  | Type_abstract _ -> ()
-  | Type_variant (cstrs, _rep) ->
-      List.iter
-        (fun c ->
-           prepare_type_constructor_arguments c.cd_args;
-           Option.iter prepare_type c.cd_res)
-        cstrs
-  | Type_record(l, _rep) ->
-      List.iter (fun l -> prepare_type l.ld_type) l
-  | Type_open -> ()
-  end;
-  ty_manifest, params
-
-let tree_of_type_decl id decl =
-  let ty_manifest, params = prepare_decl id decl in
-  let type_param ot_variance =
-    function
-    | Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
-    | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
-  in
-  let type_defined decl =
-    let abstr =
-      match decl.type_kind with
-        Type_abstract _ ->
-          decl.type_manifest = None || decl.type_private = Private
-      | Type_record _ ->
-          decl.type_private = Private
-      | Type_variant (tll, _rep) ->
-          decl.type_private = Private ||
-          List.exists (fun cd -> cd.cd_res <> None) tll
-      | Type_open ->
-          decl.type_manifest = None
-    in
-    let vari =
-      List.map2
-        (fun ty v ->
-          let is_var = is_Tvar ty in
-          if abstr || not is_var then
-            let inj =
-              type_kind_is_abstract decl && Variance.mem Inj v &&
-              match decl.type_manifest with
-              | None -> true
-              | Some ty -> (* only abstract or private row types *)
-                  decl.type_private = Private &&
-                  Btype.is_constr_row ~allow_ident:true (Btype.row_of_type ty)
-            and (co, cn) = Variance.get_upper v in
-            (if not cn then Covariant else
-             if not co then Contravariant else NoVariance),
-            (if inj then Injective else NoInjectivity)
-          else (NoVariance, NoInjectivity))
-        decl.type_params decl.type_variance
-    in
-    (Ident.name id,
-     List.map2 (fun ty cocn -> type_param cocn (tree_of_typexp Type ty))
-       params vari)
-  in
-  let tree_of_manifest ty1 =
-    match ty_manifest with
-    | None -> ty1
-    | Some ty -> Otyp_manifest (tree_of_typexp Type ty, ty1)
-  in
-  let (name, args) = type_defined decl in
-  let constraints = tree_of_constraints params in
-  let ty, priv, unboxed =
-    match decl.type_kind with
-    | Type_abstract _ ->
-        begin match ty_manifest with
-        | None -> (Otyp_abstract, Public, false)
-        | Some ty ->
-            tree_of_typexp Type ty, decl.type_private, false
-        end
-    | Type_variant (cstrs, rep) ->
-        tree_of_manifest
-          (Otyp_sum (List.map tree_of_constructor_in_decl cstrs)),
-        decl.type_private,
-        (rep = Variant_unboxed)
-    | Type_record(lbls, rep) ->
-        tree_of_manifest (Otyp_record (List.map tree_of_label lbls)),
-        decl.type_private,
-        (match rep with Record_unboxed _ -> true | _ -> false)
-    | Type_open ->
-        tree_of_manifest Otyp_open,
-        decl.type_private,
-        false
-  in
-    { otype_name = name;
-      otype_params = args;
-      otype_type = ty;
-      otype_private = priv;
-      otype_immediate = Type_immediacy.of_attributes decl.type_attributes;
-      otype_unboxed = unboxed;
-      otype_cstrs = constraints }
-
-let add_type_decl_to_preparation id decl =
-   ignore @@ prepare_decl id decl
-
-let tree_of_prepared_type_decl id decl =
-  tree_of_type_decl id decl
-
-let tree_of_type_decl id decl =
-  reset_except_context();
-  tree_of_type_decl id decl
-
-let add_constructor_to_preparation c =
-  prepare_type_constructor_arguments c.cd_args;
-  Option.iter prepare_type c.cd_res
-
-let prepared_constructor ppf c =
-  !Oprint.out_constr ppf (tree_of_single_constructor c)
-
-let constructor ppf c =
-  reset_except_context ();
-  add_constructor_to_preparation c;
-  prepared_constructor ppf c
-
-let label ppf l =
-  reset_except_context ();
-  prepare_type l.ld_type;
-  !Oprint.out_label ppf (tree_of_label l)
-
-let tree_of_type_declaration id decl rs =
-  Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
-
-let tree_of_prepared_type_declaration id decl rs =
-  Osig_type (tree_of_prepared_type_decl id decl, tree_of_rec rs)
-
-let type_declaration id ppf decl =
-  !Oprint.out_sig_item ppf (tree_of_type_declaration id decl Trec_first)
-
-let add_type_declaration_to_preparation id decl =
-  add_type_decl_to_preparation id decl
-
-let prepared_type_declaration id ppf decl =
-  !Oprint.out_sig_item ppf
-    (tree_of_prepared_type_declaration id decl Trec_first)
-
-let constructor_arguments ppf a =
-  let tys = tree_of_constructor_arguments a in
-  !Oprint.out_type ppf (Otyp_tuple tys)
-
-(* Print an extension declaration *)
-
-let extension_constructor_args_and_ret_type_subtree ext_args ext_ret_type =
-  let ret = Option.map (tree_of_typexp Type) ext_ret_type in
-  let args = tree_of_constructor_arguments ext_args in
-  (args, ret)
-
-(* When printing extension constructor, it is important to ensure that
-after printing the constructor, we are still in the scope of the constructor.
-For GADT constructor, this can be done by printing the type parameters inside
-their own isolated scope. This ensures that in
-{[
-   type 'b t += A: 'b -> 'b any t
-]}
-the type parameter `'b` is not bound when printing the type variable `'b` from
-the constructor definition from the type parameter.
-
-Contrarily, for non-gadt constructor, we must keep the same scope for
-the type parameters and the constructor because a type constraint may
-have changed the name of the type parameter:
-{[
-type -'a t = .. constraint <x:'a. 'a t -> 'a> = 'a
-(* the universal 'a is here to steal the name 'a from the type parameter *)
-type 'a t = X of 'a
-]} *)
-
-
-let add_extension_constructor_to_preparation ext =
-  let ty_params = filter_params ext.ext_type_params in
-  List.iter add_alias ty_params;
-  List.iter prepare_type ty_params;
-  prepare_type_constructor_arguments ext.ext_args;
-  Option.iter prepare_type ext.ext_ret_type
-
-let prepared_tree_of_extension_constructor
-   id ext es
-  =
-  let ty_name = Path.name ext.ext_type_path in
-  let ty_params = filter_params ext.ext_type_params in
-  let type_param =
-    function
-    | Otyp_var (_, id) -> id
-    | _ -> "?"
-  in
-  let param_scope f =
-    match ext.ext_ret_type with
-    | None ->
-        (* normal constructor: same scope for parameters and the constructor *)
-        f ()
-    | Some _ ->
-        (* gadt constructor: isolated scope for the type parameters *)
-        Names.with_local_names f
-  in
-  let ty_params =
-    param_scope
-      (fun () ->
-         List.iter (add_printed_alias ~non_gen:false) ty_params;
-         List.map (fun ty -> type_param (tree_of_typexp Type ty)) ty_params
-      )
-  in
-  let name = Ident.name id in
-  let args, ret =
-    extension_constructor_args_and_ret_type_subtree
-      ext.ext_args
-      ext.ext_ret_type
-  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 tree_of_extension_constructor id ext es =
-  reset_except_context ();
-  add_extension_constructor_to_preparation ext;
-  prepared_tree_of_extension_constructor id ext es
-
-let extension_constructor id ppf ext =
-  !Oprint.out_sig_item ppf (tree_of_extension_constructor id ext Text_first)
-
-let prepared_extension_constructor id ppf ext =
-  !Oprint.out_sig_item ppf
-    (prepared_tree_of_extension_constructor id ext Text_first)
-
-let extension_only_constructor id ppf ext =
-  reset_except_context ();
-  prepare_type_constructor_arguments ext.ext_args;
-  Option.iter prepare_type ext.ext_ret_type;
-  let name = Ident.name id in
-  let args, ret =
-    extension_constructor_args_and_ret_type_subtree
-      ext.ext_args
-      ext.ext_ret_type
-  in
-  Format.fprintf ppf "@[<hv>%a@]"
-    !Oprint.out_constr {
-      ocstr_name = name;
+    Fmt.fprintf ppf "@[<hv>%a@]"
+      !Oprint.out_constr {
+      Outcometree.ocstr_name = name;
       ocstr_args = args;
       ocstr_return_type = ret;
     }
 
-(* Print a value declaration *)
-
-let tree_of_value_description id decl =
-  (* Format.eprintf "@[%a@]@." raw_type_expr decl.val_type; *)
-  let id = Ident.name id in
-  let ty = tree_of_type_scheme decl.val_type in
-  let vd =
-    { oval_name = id;
-      oval_type = ty;
-      oval_prims = [];
-      oval_attributes = [] }
-  in
-  let vd =
-    match decl.val_kind with
-    | Val_prim p -> Primitive.print p vd
-    | _ -> vd
-  in
-  Osig_value vd
-
-let value_description id ppf decl =
-  !Oprint.out_sig_item ppf (tree_of_value_description id decl)
-
-(* Print a class type *)
-
-let method_type priv ty =
-  match priv, get_desc ty with
-  | Mpublic, Tpoly(ty, tyl) -> (ty, tyl)
-  | _ , _ -> (ty, [])
-
-let prepare_method _lab (priv, _virt, ty) =
-  let ty, _ = method_type priv ty in
-  prepare_type ty
-
-let tree_of_method mode (lab, priv, virt, ty) =
-  let (ty, tyl) = method_type priv ty in
-  let tty = tree_of_typexp mode ty in
-  Names.remove_names (List.map Transient_expr.repr tyl);
-  let priv = priv <> Mpublic in
-  let virt = virt = Virtual in
-  Ocsg_method (lab, priv, virt, tty)
-
-let rec prepare_class_type params = function
-  | Cty_constr (_p, tyl, cty) ->
-      let row = Btype.self_type_row cty in
-      if List.memq (proxy row) !visited_objects
-      || not (List.for_all is_Tvar params)
-      || List.exists (deep_occur row) tyl
-      then prepare_class_type params cty
-      else List.iter prepare_type tyl
-  | Cty_signature sign ->
-      (* Self may have a name *)
-      let px = proxy sign.csig_self_row in
-      if List.memq px !visited_objects then add_alias_proxy px
-      else visited_objects := px :: !visited_objects;
-      Vars.iter (fun _ (_, _, ty) -> prepare_type ty) sign.csig_vars;
-      Meths.iter prepare_method sign.csig_meths
-  | Cty_arrow (_, ty, cty) ->
-      prepare_type ty;
-      prepare_class_type params cty
-
-let rec tree_of_class_type mode params =
-  function
-  | Cty_constr (p', tyl, cty) ->
-      let row = Btype.self_type_row cty in
-      if List.memq (proxy row) !visited_objects
-      || not (List.for_all is_Tvar params)
-      then
-        tree_of_class_type mode params cty
-      else
-        let namespace = Namespace.best_class_namespace p' in
-        Octy_constr (tree_of_path namespace p', tree_of_typlist Type_scheme tyl)
-  | Cty_signature sign ->
-      let px = proxy sign.csig_self_row in
-      let self_ty =
-        if is_aliased_proxy px then
-          Some
-            (Otyp_var (false, Names.name_of_type Names.new_name px))
-        else None
-      in
-      let csil = [] in
-      let csil =
-        List.fold_left
-          (fun csil (ty1, ty2) -> Ocsg_constraint (ty1, ty2) :: csil)
-          csil (tree_of_constraints params)
-      in
-      let all_vars =
-        Vars.fold (fun l (m, v, t) all -> (l, m, v, t) :: all) sign.csig_vars []
-      in
-      (* Consequence of PR#3607: order of Map.fold has changed! *)
-      let all_vars = List.rev all_vars in
-      let csil =
-        List.fold_left
-          (fun csil (l, m, v, t) ->
-            Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp mode t)
-            :: csil)
-          csil all_vars
-      in
-      let all_meths =
-        Meths.fold
-          (fun l (p, v, t) all -> (l, p, v, t) :: all)
-          sign.csig_meths []
-      in
-      let all_meths = List.rev all_meths in
-      let csil =
-        List.fold_left
-          (fun csil meth -> tree_of_method mode meth :: csil)
-          csil all_meths
-      in
-      Octy_signature (self_ty, List.rev csil)
-  | Cty_arrow (l, ty, cty) ->
-      let lab =
-        if !print_labels || is_optional l then l else Nolabel
-      in
-      let tr =
-       if is_optional l then
-         match get_desc ty with
-         | Tconstr(path, [ty], _) when Path.same path Predef.path_option ->
-             tree_of_typexp mode ty
-         | _ -> Otyp_stuff "<hidden>"
-       else tree_of_typexp mode ty in
-      Octy_arrow (lab, tr, tree_of_class_type mode params cty)
-
-let class_type ppf cty =
-  reset ();
-  prepare_class_type [] cty;
-  !Oprint.out_class_type ppf (tree_of_class_type Type [] cty)
-
-let tree_of_class_param param variance =
-  let ot_variance =
-    if is_Tvar param then Asttypes.(NoVariance, NoInjectivity) else variance in
-  match tree_of_typexp Type_scheme param with
-    Otyp_var (ot_non_gen, ot_name) -> {ot_non_gen; ot_name; ot_variance}
-  | _ -> {ot_non_gen=false; ot_name="?"; ot_variance}
-
-let class_variance =
-  let open Variance in let open Asttypes in
-  List.map (fun v ->
-    (if not (mem May_pos v) then Contravariant else
-     if not (mem May_neg v) then Covariant else NoVariance),
-    NoInjectivity)
-
-let tree_of_class_declaration id cl rs =
-  let params = filter_params cl.cty_params in
-
-  reset_except_context ();
-  List.iter add_alias params;
-  prepare_class_type params cl.cty_type;
-  let px = proxy (Btype.self_type_row cl.cty_type) in
-  List.iter prepare_type params;
-
-  List.iter (add_printed_alias ~non_gen:false) params;
-  if is_aliased_proxy px then add_printed_alias_proxy ~non_gen:false px;
-
-  let vir_flag = cl.cty_new = None in
-  Osig_class
-    (vir_flag, Ident.name id,
-     List.map2 tree_of_class_param params (class_variance cl.cty_variance),
-     tree_of_class_type Type_scheme params cl.cty_type,
-     tree_of_rec rs)
-
-let class_declaration id ppf cl =
-  !Oprint.out_sig_item ppf (tree_of_class_declaration id cl Trec_first)
-
-let tree_of_cltype_declaration id cl rs =
-  let params = cl.clty_params in
-
-  reset_except_context ();
-  List.iter add_alias params;
-  prepare_class_type params cl.clty_type;
-  let px = proxy (Btype.self_type_row cl.clty_type) in
-  List.iter prepare_type params;
-
-  List.iter (add_printed_alias ~non_gen:false) params;
-  if is_aliased_proxy px then (add_printed_alias_proxy ~non_gen:false) px;
-
-  let sign = Btype.signature_of_class_type cl.clty_type in
-  let has_virtual_vars =
-    Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
-      sign.csig_vars false
-  in
-  let has_virtual_meths =
-    Meths.fold (fun _ (_,vr,_) b -> vr = Virtual || b)
-      sign.csig_meths false
-  in
-  Osig_class_type
-    (has_virtual_vars || has_virtual_meths, Ident.name id,
-     List.map2 tree_of_class_param params (class_variance cl.clty_variance),
-     tree_of_class_type Type_scheme params cl.clty_type,
-     tree_of_rec rs)
-
-let cltype_declaration id ppf cl =
-  !Oprint.out_sig_item ppf (tree_of_cltype_declaration id cl Trec_first)
-
-(* Print a module type *)
-
-let wrap_env fenv ftree arg =
-  (* We save the current value of the short-path cache *)
-  (* From keys *)
-  let env = !printing_env in
-  let old_pers = !printing_pers in
-  (* to data *)
-  let old_map = !printing_map in
-  let old_depth = !printing_depth in
-  let old_cont = !printing_cont in
-  set_printing_env (fenv env);
-  let tree = ftree arg in
-  if !Clflags.real_paths
-     || same_printing_env env then ()
-   (* our cached key is still live in the cache, and we want to keep all
-      progress made on the computation of the [printing_map] *)
-  else begin
-    (* we restore the snapshotted cache before calling set_printing_env *)
-    printing_old := env;
-    printing_pers := old_pers;
-    printing_depth := old_depth;
-    printing_cont := old_cont;
-    printing_map := old_map
-  end;
-  set_printing_env env;
-  tree
-
-let dummy =
-  {
-    type_params = [];
-    type_arity = 0;
-    type_kind = Type_abstract Definition;
-    type_private = Public;
-    type_manifest = None;
-    type_variance = [];
-    type_separability = [];
-    type_is_newtype = false;
-    type_expansion_scope = Btype.lowest_level;
-    type_loc = Location.none;
-    type_attributes = [];
-    type_immediate = Unknown;
-    type_unboxed_default = false;
-    type_uid = Uid.internal_not_actually_unique;
-  }
-
-(** we hide items being defined from short-path to avoid shortening
-    [type t = Path.To.t] into [type t = t].
-*)
-
-let ident_sigitem = function
-  | Types.Sig_type(ident,_,_,_) ->  {hide=true;ident}
-  | Types.Sig_class(ident,_,_,_)
-  | Types.Sig_class_type (ident,_,_,_)
-  | Types.Sig_module(ident,_, _,_,_)
-  | Types.Sig_value (ident,_,_)
-  | Types.Sig_modtype (ident,_,_)
-  | Types.Sig_typext (ident,_,_,_)   ->  {hide=false; ident }
-
-let hide ids env =
-  let hide_id id env =
-    (* Global idents cannot be renamed *)
-    if id.hide && not (Ident.global id.ident) then
-      Env.add_type ~check:false (Ident.rename id.ident) dummy env
-    else env
-  in
-  List.fold_right hide_id ids env
-
-let with_hidden_items ids f =
-  let with_hidden_in_printing_env ids f =
-    wrap_env (hide ids) (Naming_context.with_hidden ids) f
-  in
-  if not !Clflags.real_paths then
-    with_hidden_in_printing_env ids f
-  else
-    Naming_context.with_hidden ids f
-
-
-let add_sigitem env x =
-  Env.add_signature (Signature_group.flatten x) env
-
-let rec tree_of_modtype ?(ellipsis=false) = function
-  | Mty_ident p ->
-      Omty_ident (tree_of_path (Some Module_type) p)
-  | Mty_signature sg ->
-      Omty_signature (if ellipsis then [Osig_ellipsis]
-                      else tree_of_signature sg)
-  | Mty_functor(param, ty_res) ->
-      let param, env =
-        tree_of_functor_parameter param
-      in
-      let res = wrap_env env (tree_of_modtype ~ellipsis) ty_res in
-      Omty_functor (param, res)
-  | Mty_alias p ->
-      Omty_alias (tree_of_path (Some Module) p)
-
-and tree_of_functor_parameter = function
-  | Unit ->
-      None, fun k -> k
-  | Named (param, ty_arg) ->
-      let name, env =
-        match param with
-        | None -> None, fun env -> env
-        | Some id ->
-            Some (Ident.name id),
-            Env.add_module ~arg:true id Mp_present ty_arg
-      in
-      Some (name, tree_of_modtype ~ellipsis:false ty_arg), env
-
-and tree_of_signature sg =
-  wrap_env (fun env -> env)(fun sg ->
-      let tree_groups = tree_of_signature_rec !printing_env sg in
-      List.concat_map (fun (_env,l) -> List.map snd l) tree_groups
-    ) sg
-
-and tree_of_signature_rec env' sg =
-  let structured = List.of_seq (Signature_group.seq sg) in
-  let collect_trees_of_rec_group group =
-    let env = !printing_env in
-    let env', group_trees =
-       trees_of_recursive_sigitem_group env group
-    in
-    set_printing_env env';
-    (env, group_trees) in
-  set_printing_env env';
-  List.map collect_trees_of_rec_group structured
-
-and trees_of_recursive_sigitem_group env
-    (syntactic_group: Signature_group.rec_group) =
-  let display (x:Signature_group.sig_item) = x.src, tree_of_sigitem x.src in
-  let env = Env.add_signature syntactic_group.pre_ghosts env in
-  match syntactic_group.group with
-  | Not_rec x -> add_sigitem env x, [display x]
-  | Rec_group items ->
-      let ids = List.map (fun x -> ident_sigitem x.Signature_group.src) items in
-      List.fold_left add_sigitem env items,
-      with_hidden_items ids (fun () -> List.map display items)
+  (* Print a signature body (used by -i when compiling a .ml) *)
 
-and tree_of_sigitem = function
-  | Sig_value(id, decl, _) ->
-      tree_of_value_description id decl
-  | Sig_type(id, decl, rs, _) ->
-      tree_of_type_declaration id decl rs
-  | Sig_typext(id, ext, es, _) ->
-      tree_of_extension_constructor id ext es
-  | Sig_module(id, _, md, rs, _) ->
-      let ellipsis =
-        List.exists (function
-          | Parsetree.{attr_name = {txt="..."}; attr_payload = PStr []} -> true
-          | _ -> false)
-          md.md_attributes in
-      tree_of_module id md.md_type rs ~ellipsis
-  | Sig_modtype(id, decl, _) ->
-      tree_of_modtype_declaration id decl
-  | Sig_class(id, decl, rs, _) ->
-      tree_of_class_declaration id decl rs
-  | Sig_class_type(id, decl, rs, _) ->
-      tree_of_cltype_declaration id decl rs
+  let print_signature ppf tree =
+    Fmt.fprintf ppf "@[<v>%a@]" !Oprint.out_signature tree
 
-and tree_of_modtype_declaration id decl =
-  let mty =
-    match decl.mtd_type with
-    | None -> Omty_abstract
-    | Some mty -> tree_of_modtype mty
-  in
-  Osig_modtype (Ident.name id, mty)
+  let signature ppf sg =
+    Fmt.fprintf ppf "%a" print_signature (tree_of_signature sg)
 
-and tree_of_module id ?ellipsis mty rs =
-  Osig_module (Ident.name id, tree_of_modtype ?ellipsis mty, tree_of_rec rs)
-
-let rec functor_parameters ~sep custom_printer = function
-  | [] -> ignore
-  | [id,param] ->
-      Format.dprintf "%t%t"
-        (custom_printer param)
-        (functor_param ~sep ~custom_printer id [])
-  | (id,param) :: q ->
-      Format.dprintf "%t%a%t"
-        (custom_printer param)
-        sep ()
-        (functor_param ~sep ~custom_printer id q)
-and functor_param ~sep ~custom_printer id q =
-  match id with
-  | None -> functor_parameters ~sep custom_printer q
-  | Some id ->
-      Naming_context.with_arg id
-        (fun () -> functor_parameters ~sep custom_printer q)
-
-
-
-let modtype ppf mty = !Oprint.out_module_type ppf (tree_of_modtype mty)
-let modtype_declaration id ppf decl =
-  !Oprint.out_sig_item ppf (tree_of_modtype_declaration id decl)
-
-(* For the toplevel: merge with tree_of_signature? *)
-
-let print_items showval env x =
-  Names.refresh_weak();
-  Conflicts.reset ();
-  let extend_val env (sigitem,outcome) = outcome, showval env sigitem in
-  let post_process (env,l) = List.map (extend_val env) l in
-  List.concat_map post_process @@ tree_of_signature_rec env x
-
-(* Print a signature body (used by -i when compiling a .ml) *)
+end
+open Doc
+let string_of_path p = Fmt.asprintf "%a" path p
 
-let print_signature ppf tree =
-  fprintf ppf "@[<v>%a@]" !Oprint.out_signature tree
+let strings_of_paths namespace p =
+  let trees = List.map (namespaced_tree_of_path namespace) p in
+  List.map (Fmt.asprintf "%a" !Oprint.out_ident) trees
+
+let wrap_printing_env = wrap_printing_env
+let ident = Fmt.compat ident
+let longident = Fmt.compat longident
+let path = Fmt.compat path
+let type_path = Fmt.compat type_path
+let type_expr = Fmt.compat type_expr
+let type_scheme = Fmt.compat type_scheme
+let shared_type_scheme = Fmt.compat shared_type_scheme
+
+let type_declaration  = Fmt.compat1 type_declaration
+let type_expansion = Fmt.compat1 type_expansion
+let value_description = Fmt.compat1 value_description
+let label = Fmt.compat label
+let constructor = Fmt.compat constructor
+let constructor_arguments = Fmt.compat constructor_arguments
+let extension_constructor = Fmt.compat1 extension_constructor
+let extension_only_constructor = Fmt.compat1 extension_only_constructor
+
+let modtype = Fmt.compat modtype
+let modtype_declaration = Fmt.compat1 modtype_declaration
+let signature = Fmt.compat signature
+
+let class_declaration = Fmt.compat1 class_declaration
+let class_type = Fmt.compat class_type
+let cltype_declaration = Fmt.compat1 cltype_declaration
 
-let signature ppf sg =
-  fprintf ppf "%a" print_signature (tree_of_signature sg)
 
 (* Print a signature body (used by -i when compiling a .ml) *)
 let printed_signature sourcefile ppf sg =
   (* we are tracking any collision event for warning 63 *)
-  Conflicts.reset ();
+  Ident_conflicts.reset ();
   let t = tree_of_signature sg in
-  if Warnings.(is_active @@ Erroneous_printed_signature "")
-  && Conflicts.exists ()
-  then begin
-    let conflicts = Format.asprintf "%t" Conflicts.print_explanations in
-    Location.prerr_warning (Location.in_file sourcefile)
-      (Warnings.Erroneous_printed_signature conflicts);
-    Warnings.check_fatal ()
-  end;
-  fprintf ppf "%a" print_signature t
-
-(* Trace-specific printing *)
-
-(* A configuration type that controls which trace we print.  This could be
-   exposed, but we instead expose three separate
-   [report_{unification,equality,moregen}_error] functions.  This also lets us
-   give the unification case an extra optional argument without adding it to the
-   equality and moregen cases. *)
-type 'variety trace_format =
-  | Unification : Errortrace.unification trace_format
-  | Equality    : Errortrace.comparison  trace_format
-  | Moregen     : Errortrace.comparison  trace_format
-
-let incompatibility_phrase (type variety) : variety trace_format -> string =
-  function
-  | Unification -> "is not compatible with type"
-  | Equality    -> "is not equal to type"
-  | Moregen     -> "is not compatible with type"
-
-(* Print a unification error *)
-
-let same_path t t' =
-  eq_type t t' ||
-  match get_desc t, get_desc t' with
-    Tconstr(p,tl,_), Tconstr(p',tl',_) ->
-      let (p1, s1) = best_type_path p and (p2, s2)  = best_type_path p' in
-      begin match s1, s2 with
-        Nth n1, Nth n2 when n1 = n2 -> true
-      | (Id | Map _), (Id | Map _) when Path.same p1 p2 ->
-          let tl = apply_subst s1 tl and tl' = apply_subst s2 tl' in
-          List.length tl = List.length tl' &&
-          List.for_all2 eq_type tl tl'
-      | _ -> false
-      end
-  | _ ->
-      false
-
-type 'a diff = Same of 'a | Diff of 'a * 'a
-
-let trees_of_type_expansion mode Errortrace.{ty = t; expanded = t'} =
-  reset_loop_marks ();
-  mark_loops t;
-  if same_path t t'
-  then begin add_delayed (proxy t); Same (tree_of_typexp mode t) end
-  else begin
-    mark_loops t';
-    let t' = if proxy t == proxy t' then unalias t' else t' in
-    (* beware order matter due to side effect,
-       e.g. when printing object types *)
-    let first = tree_of_typexp mode t in
-    let second = tree_of_typexp mode t' in
-    if first = second then Same first
-    else Diff(first,second)
-  end
-
-let type_expansion ppf = function
-  | Same t -> Style.as_inline_code !Oprint.out_type ppf t
-  | Diff(t,t') ->
-      fprintf ppf "@[<2>%a@ =@ %a@]"
-        (Style.as_inline_code !Oprint.out_type) t
-        (Style.as_inline_code !Oprint.out_type) t'
-
-let trees_of_trace mode =
-  List.map (Errortrace.map_diff (trees_of_type_expansion mode))
-
-let trees_of_type_path_expansion (tp,tp') =
-  if Path.same tp tp' then Same(tree_of_path (Some Type) tp) else
-    Diff(tree_of_path (Some Type) tp, tree_of_path (Some Type) tp')
-
-let type_path_expansion ppf = function
-  | Same p -> Style.as_inline_code !Oprint.out_ident ppf p
-  | Diff(p,p') ->
-      fprintf ppf "@[<2>%a@ =@ %a@]"
-        (Style.as_inline_code !Oprint.out_ident) p
-        (Style.as_inline_code !Oprint.out_ident) p'
-
-let rec trace fst txt ppf = function
-  | {Errortrace.got; expected} :: rem ->
-      if not fst then fprintf ppf "@,";
-      fprintf ppf "@[Type@;<1 2>%a@ %s@;<1 2>%a@]%a"
-       type_expansion got txt type_expansion expected
-       (trace false txt) rem
-  | _ -> ()
-
-type printing_status =
-  | Discard
-  | Keep
-  | Optional_refinement
-  (** An [Optional_refinement] printing status is attributed to trace
-      elements that are focusing on a new subpart of a structural type.
-      Since the whole type should have been printed earlier in the trace,
-      we only print those elements if they are the last printed element
-      of a trace, and there is no explicit explanation for the
-      type error.
-  *)
-
-let diff_printing_status Errortrace.{ got      = {ty = t1; expanded = t1'};
-                                      expected = {ty = t2; expanded = t2'} } =
-  if  is_constr_row ~allow_ident:true t1'
-   || is_constr_row ~allow_ident:true t2'
-  then Discard
-  else if same_path t1 t1' && same_path t2 t2' then Optional_refinement
-  else Keep
-
-let printing_status = function
-  | Errortrace.Diff d -> diff_printing_status d
-  | Errortrace.Escape {kind = Constraint} -> Keep
-  | _ -> Keep
-
-(** Flatten the trace and remove elements that are always discarded
-    during printing *)
-
-(* Takes [printing_status] to change behavior for [Subtype] *)
-let prepare_any_trace printing_status tr =
-  let clean_trace x l = match printing_status x with
-    | Keep -> x :: l
-    | Optional_refinement when l = [] -> [x]
-    | Optional_refinement | Discard -> l
-  in
-  match tr with
-  | [] -> []
-  | elt :: rem -> elt :: List.fold_right clean_trace rem []
-
-let prepare_trace f tr =
-  prepare_any_trace printing_status (Errortrace.map f tr)
-
-(** Keep elements that are [Diff _ ] and take the decision
-    for the last element, require a prepared trace *)
-let rec filter_trace keep_last = function
-  | [] -> []
-  | [Errortrace.Diff d as elt]
-    when printing_status elt = Optional_refinement ->
-    if keep_last then [d] else []
-  | Errortrace.Diff d :: rem -> d :: filter_trace keep_last rem
-  | _ :: rem -> filter_trace keep_last rem
-
-let type_path_list =
-  Format.pp_print_list ~pp_sep:(fun ppf () -> Format.pp_print_break ppf 2 0)
-    type_path_expansion
-
-(* Hide variant name and var, to force printing the expanded type *)
-let hide_variant_name t =
-  match get_desc t with
-  | Tvariant row ->
-      let Row {fields; more; name; fixed; closed} = row_repr row in
-      if name = None then t else
-      newty2 ~level:(get_level t)
-        (Tvariant
-           (create_row ~fields ~fixed ~closed ~name:None
-              ~more:(newvar2 (get_level more))))
-  | _ -> t
-
-let prepare_expansion Errortrace.{ty; expanded} =
-  let expanded = hide_variant_name expanded in
-  reserve_names ty;
-  if not (same_path ty expanded) then reserve_names expanded;
-  Errortrace.{ty; expanded}
-
-let may_prepare_expansion compact (Errortrace.{ty; expanded} as ty_exp) =
-  match get_desc expanded with
-    Tvariant _ | Tobject _ when compact ->
-      reserve_names ty; Errortrace.{ty; expanded = ty}
-  | _ -> prepare_expansion ty_exp
-
-let print_path p =
-  Format.dprintf "%a" !Oprint.out_ident (tree_of_path (Some Type) p)
-
-let print_tag ppf s = Style.inline_code ppf ("`" ^ s)
-
-let print_tags =
-  let comma ppf () = Format.fprintf ppf ",@ " in
-  Format.pp_print_list ~pp_sep:comma print_tag
-
-let is_unit env ty =
-  match get_desc (Ctype.expand_head env ty) with
-  | Tconstr (p, _, _) -> Path.same p Predef.path_unit
-  | _ -> false
-
-let unifiable env ty1 ty2 =
-  let snap = Btype.snapshot () in
-  let res =
-    try Ctype.unify env ty1 ty2; true
-    with Unify _ -> false
-  in
-  Btype.backtrack snap;
-  res
-
-let explanation_diff env t3 t4 : (Format.formatter -> unit) option =
-  match get_desc t3, get_desc t4 with
-  | Tarrow (_, ty1, ty2, _), _
-    when is_unit env ty1 && unifiable env ty2 t4 ->
-      Some (fun ppf ->
-        fprintf ppf
-          "@,@[@{<hint>Hint@}: Did you forget to provide %a as argument?@]"
-          Style.inline_code "()"
-        )
-  | _, Tarrow (_, ty1, ty2, _)
-    when is_unit env ty1 && unifiable env t3 ty2 ->
-      Some (fun ppf ->
-        fprintf ppf
-          "@,@[@{<hint>Hint@}: Did you forget to wrap the expression using \
-           %a?@]"
-          Style.inline_code "fun () ->"
-        )
-  | _ ->
-      None
-
-let explain_fixed_row_case ppf = function
-  | Errortrace.Cannot_be_closed ->
-      fprintf ppf "it cannot be closed"
-  | Errortrace.Cannot_add_tags tags ->
-      fprintf ppf "it may not allow the tag(s) %a"
-        print_tags tags
-
-let explain_fixed_row pos expl = match expl with
-  | Fixed_private ->
-    dprintf "The %a variant type is private" Errortrace.print_pos pos
-  | Univar x ->
-    reserve_names x;
-    dprintf "The %a variant type is bound to the universal type variable %a"
-      Errortrace.print_pos pos
-      (Style.as_inline_code type_expr_with_reserved_names) x
-  | Reified p ->
-    dprintf "The %a variant type is bound to %a"
-      Errortrace.print_pos pos
-      (Style.as_inline_code
-         (fun ppf p ->
-           Internal_names.add p;
-           print_path p ppf))
-      p
-  | Rigid -> ignore
-
-let explain_variant (type variety) : variety Errortrace.variant -> _ = function
-  (* Common *)
-  | Errortrace.Incompatible_types_for s ->
-      Some(dprintf "@,Types for tag %a are incompatible"
-             print_tag s
-          )
-  (* Unification *)
-  | Errortrace.No_intersection ->
-      Some(dprintf "@,These two variant types have no intersection")
-  | Errortrace.No_tags(pos,fields) -> Some(
-      dprintf
-        "@,@[The %a variant type does not allow tag(s)@ @[<hov>%a@]@]"
-        Errortrace.print_pos pos
-        print_tags (List.map fst fields)
-    )
-  | Errortrace.Fixed_row (pos,
-                          k,
-                          (Univar _ | Reified _ | Fixed_private as e)) ->
-      Some (
-        dprintf "@,@[%t,@ %a@]" (explain_fixed_row pos e)
-          explain_fixed_row_case k
-      )
-  | Errortrace.Fixed_row (_,_, Rigid) ->
-      (* this case never happens *)
-      None
-  (* Equality & Moregen *)
-  | Errortrace.Presence_not_guaranteed_for (pos, s) -> Some(
-      dprintf
-        "@,@[The tag %a is guaranteed to be present in the %a variant type,\
-         @ but not in the %a@]"
-        print_tag s
-        Errortrace.print_pos (Errortrace.swap_position pos)
-        Errortrace.print_pos pos
-    )
-  | Errortrace.Openness pos ->
-      Some(dprintf "@,The %a variant type is open and the %a is not"
-             Errortrace.print_pos pos
-             Errortrace.print_pos (Errortrace.swap_position pos))
-
-let explain_escape pre = function
-  | Errortrace.Univ u ->
-      reserve_names u;
-      Some(
-        dprintf "%t@,The universal variable %a would escape its scope"
-          pre
-          (Style.as_inline_code type_expr_with_reserved_names) u
-      )
-  | Errortrace.Constructor p -> Some(
-      dprintf
-        "%t@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
-        pre (Style.as_inline_code path) p
-    )
-  | Errortrace.Module_type p -> Some(
-      dprintf
-        "%t@,@[The module type@;<1 2>%a@ would escape its scope@]"
-        pre (Style.as_inline_code path) p
-    )
-  | Errortrace.Equation Errortrace.{ty = _; expanded = t} ->
-      reserve_names t;
-      Some(
-        dprintf "%t @,@[<hov>This instance of %a is ambiguous:@ %s@]"
-          pre
-          (Style.as_inline_code type_expr_with_reserved_names) t
-          "it would escape the scope of its equation"
-      )
-  | Errortrace.Self ->
-      Some (dprintf "%t@,Self type cannot escape its class" pre)
-  | Errortrace.Constraint ->
-      None
-
-let explain_object (type variety) : variety Errortrace.obj -> _ = function
-  | Errortrace.Missing_field (pos,f) -> Some(
-      dprintf "@,@[The %a object type has no method %a@]"
-        Errortrace.print_pos pos Style.inline_code f
-    )
-  | Errortrace.Abstract_row pos -> Some(
-      dprintf
-        "@,@[The %a object type has an abstract row, it cannot be closed@]"
-        Errortrace.print_pos pos
-    )
-  | Errortrace.Self_cannot_be_closed ->
-      Some (dprintf "@,Self type cannot be unified with a closed object type")
-
-let explain_incompatible_fields name (diff: Types.type_expr Errortrace.diff) =
-  reserve_names diff.got;
-  reserve_names diff.expected;
-  dprintf "@,@[The method %a has type@ %a,@ \
-  but the expected method type was@ %a@]"
-    Style.inline_code name
-    (Style.as_inline_code type_expr_with_reserved_names) diff.got
-    (Style.as_inline_code type_expr_with_reserved_names) diff.expected
-
-let explanation (type variety) intro prev env
-  : (Errortrace.expanded_type, variety) Errortrace.elt -> _ = function
-  | Errortrace.Diff {got; expected} ->
-    explanation_diff env got.expanded expected.expanded
-  | Errortrace.Escape {kind; context} ->
-    let pre =
-      match context, kind, prev with
-      | Some ctx, _, _ ->
-        reserve_names ctx;
-        dprintf "@[%t@;<1 2>%a@]" intro
-          (Style.as_inline_code type_expr_with_reserved_names) ctx
-      | None, Univ _, Some(Errortrace.Incompatible_fields {name; diff}) ->
-        explain_incompatible_fields name diff
-      | _ -> ignore
-    in
-    explain_escape pre kind
-  | Errortrace.Incompatible_fields { name; diff} ->
-    Some(explain_incompatible_fields name diff)
-  | Errortrace.Variant v ->
-    explain_variant v
-  | Errortrace.Obj o ->
-    explain_object o
-  | Errortrace.Rec_occur(x,y) ->
-    reserve_names x;
-    reserve_names y;
-    begin match get_desc x with
-    | Tvar _ | Tunivar _  ->
-        Some(fun ppf ->
-          reset_loop_marks ();
-          mark_loops x;
-          mark_loops y;
-          dprintf "@,@[<hov>The type variable %a occurs inside@ %a@]"
-            (Style.as_inline_code prepared_type_expr) x
-            (Style.as_inline_code prepared_type_expr) y
-            ppf)
-    | _ ->
-        (* We had a delayed unification of the type variable with
-           a non-variable after the occur check. *)
-        Some ignore
-        (* There is no need to search further for an explanation, but
-           we don't want to print a message of the form:
-             {[ The type int occurs inside int list -> 'a |}
-        *)
-    end
-
-let mismatch intro env trace =
-  Errortrace.explain trace (fun ~prev h -> explanation intro prev env h)
-
-let explain mis ppf =
-  match mis with
-  | None -> ()
-  | Some explain -> explain ppf
-
-let warn_on_missing_def env ppf t =
-  match get_desc t with
-  | Tconstr (p,_,_) ->
-    begin match Env.find_type p env with
-    | exception Not_found ->
-        fprintf ppf
-          "@,@[<hov>Type %a is abstract because@ no corresponding\
-           @ cmi file@ was found@ in path.@]" (Style.as_inline_code path) p
-    | { type_manifest = Some _; _ } -> ()
-    | { type_manifest = None; _ } as decl ->
-        match type_origin decl with
-        | Rec_check_regularity ->
-            fprintf ppf
-              "@,@[<hov>Type %a was considered abstract@ when checking\
-               @ constraints@ in this@ recursive type definition.@]"
-              (Style.as_inline_code path) p
-        | Definition | Existential _ -> ()
-      end
-  | _ -> ()
-
-let prepare_expansion_head empty_tr = function
-  | Errortrace.Diff d ->
-      Some (Errortrace.map_diff (may_prepare_expansion empty_tr) d)
-  | _ -> None
-
-let head_error_printer mode txt_got txt_but = function
-  | None -> ignore
-  | Some d ->
-      let d = Errortrace.map_diff (trees_of_type_expansion mode) d in
-      dprintf "%t@;<1 2>%a@ %t@;<1 2>%a"
-        txt_got type_expansion d.Errortrace.got
-        txt_but type_expansion d.Errortrace.expected
-
-let warn_on_missing_defs env ppf = function
-  | None -> ()
-  | Some Errortrace.{got      = {ty=te1; expanded=_};
-                     expected = {ty=te2; expanded=_} } ->
-      warn_on_missing_def env ppf te1;
-      warn_on_missing_def env ppf te2
-
-(* [subst] comes out of equality, and is [[]] otherwise *)
-let error trace_format mode subst env tr txt1 ppf txt2 ty_expect_explanation =
-  reset ();
-  (* We want to substitute in the opposite order from [Eqtype] *)
-  Names.add_subst (List.map (fun (ty1,ty2) -> ty2,ty1) subst);
-  let tr =
-    prepare_trace
-      (fun ty_exp ->
-         Errortrace.{ty_exp with expanded = hide_variant_name ty_exp.expanded})
-      tr
-  in
-  let mis = mismatch txt1 env tr in
-  match tr with
-  | [] -> assert false
-  | elt :: tr ->
-    try
-      print_labels := not !Clflags.classic;
-      let tr = filter_trace (mis = None) tr in
-      let head = prepare_expansion_head (tr=[]) elt in
-      let tr = List.map (Errortrace.map_diff prepare_expansion) tr in
-      let head_error = head_error_printer mode txt1 txt2 head in
-      let tr = trees_of_trace mode tr in
-      fprintf ppf
-        "@[<v>\
-          @[%t%t@]%a%t\
-         @]"
-        head_error
-        ty_expect_explanation
-        (trace false (incompatibility_phrase trace_format)) tr
-        (explain mis);
-      if env <> Env.empty
-      then warn_on_missing_defs env ppf head;
-      Internal_names.print_explanations env ppf;
-      Conflicts.print_explanations ppf;
-      print_labels := true
-    with exn ->
-      print_labels := true;
-      raise exn
-
-let report_error trace_format ppf mode env tr
-      ?(subst = [])
-      ?(type_expected_explanation = fun _ -> ())
-      txt1 txt2 =
-  wrap_printing_env ~error:true env (fun () ->
-    error trace_format mode subst env tr txt1 ppf txt2
-      type_expected_explanation)
-
-let report_unification_error
-      ppf env ({trace} : Errortrace.unification_error) =
-  report_error Unification ppf Type env
-    ?subst:None trace
-
-let report_equality_error
-      ppf mode env ({subst; trace} : Errortrace.equality_error) =
-  report_error Equality ppf mode env
-    ~subst ?type_expected_explanation:None trace
-
-let report_moregen_error
-      ppf mode env ({trace} : Errortrace.moregen_error) =
-  report_error Moregen ppf mode env
-    ?subst:None ?type_expected_explanation:None trace
-
-let report_comparison_error ppf mode env = function
-  | Errortrace.Equality_error error -> report_equality_error ppf mode env error
-  | Errortrace.Moregen_error  error -> report_moregen_error  ppf mode env error
-
-module Subtype = struct
-  (* There's a frustrating amount of code duplication between this module and
-     the outside code, particularly in [prepare_trace] and [filter_trace].
-     Unfortunately, [Subtype] is *just* similar enough to have code duplication,
-     while being *just* different enough (it's only [Diff]) for the abstraction
-     to be nonobvious.  Someday, perhaps... *)
-
-  let printing_status = function
-    | Errortrace.Subtype.Diff d -> diff_printing_status d
-
-  let prepare_unification_trace = prepare_trace
-
-  let prepare_trace f tr =
-    prepare_any_trace printing_status (Errortrace.Subtype.map f tr)
-
-  let trace filter_trace get_diff fst keep_last txt ppf tr =
-    print_labels := not !Clflags.classic;
-    try match tr with
-      | elt :: tr' ->
-        let diffed_elt = get_diff elt in
-        let tr =
-          trees_of_trace Type
-          @@ List.map (Errortrace.map_diff prepare_expansion)
-          @@ filter_trace keep_last tr' in
-        let tr =
-          match fst, diffed_elt with
-          | true, Some elt -> elt :: tr
-          | _, _ -> tr
-        in
-        trace fst txt ppf tr;
-        print_labels := true
-      | _ -> ()
-    with exn ->
-      print_labels := true;
-      raise exn
-
-  let rec filter_subtype_trace keep_last = function
-    | [] -> []
-    | [Errortrace.Subtype.Diff d as elt]
-      when printing_status elt = Optional_refinement ->
-        if keep_last then [d] else []
-    | Errortrace.Subtype.Diff d :: rem ->
-        d :: filter_subtype_trace keep_last rem
-
-  let unification_get_diff = function
-    | Errortrace.Diff diff ->
-        Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
-    | _ -> None
-
-  let subtype_get_diff = function
-    | Errortrace.Subtype.Diff diff ->
-        Some (Errortrace.map_diff (trees_of_type_expansion Type) diff)
-
-  let report_error
-        ppf
-        env
-        (Errortrace.Subtype.{trace = tr_sub; unification_trace = tr_unif})
-        txt1 =
-    wrap_printing_env ~error:true env (fun () ->
-      reset ();
-      let tr_sub = prepare_trace prepare_expansion tr_sub in
-      let tr_unif = prepare_unification_trace prepare_expansion tr_unif in
-      let keep_first = match tr_unif with
-        | [Obj _ | Variant _ | Escape _ ] | [] -> true
-        | _ -> false in
-      fprintf ppf "@[<v>%a"
-        (trace filter_subtype_trace subtype_get_diff true keep_first txt1)
-        tr_sub;
-      if tr_unif = [] then fprintf ppf "@]" else
-        let mis = mismatch (dprintf "Within this type") env tr_unif in
-        fprintf ppf "%a%t%t@]"
-          (trace filter_trace unification_get_diff false
-             (mis = None) "is not compatible with type") tr_unif
-          (explain mis)
-          Conflicts.print_explanations
-    )
-end
-
-let report_ambiguous_type_error ppf env tp0 tpl txt1 txt2 txt3 =
-  wrap_printing_env ~error:true env (fun () ->
-    reset ();
-    let tp0 = trees_of_type_path_expansion tp0 in
-      match tpl with
-      [] -> assert false
-    | [tp] ->
-        fprintf ppf
-          "@[%t@;<1 2>%a@ \
-             %t@;<1 2>%a\
-           @]"
-          txt1 type_path_expansion (trees_of_type_path_expansion tp)
-          txt3 type_path_expansion tp0
-    | _ ->
-        fprintf ppf
-          "@[%t@;<1 2>@[<hv>%a@]\
-             @ %t@;<1 2>%a\
-           @]"
-          txt2 type_path_list (List.map trees_of_type_path_expansion tpl)
-          txt3 type_path_expansion tp0)
-
-(* Adapt functions to exposed interface *)
-let tree_of_path = tree_of_path None
-let tree_of_modtype = tree_of_modtype ~ellipsis:false
-let type_expansion mode ppf ty_exp =
-  type_expansion ppf (trees_of_type_expansion mode ty_exp)
-let tree_of_type_declaration ident td rs =
-  with_hidden_items [{hide=true; ident}]
-    (fun () -> tree_of_type_declaration ident td rs)
+  if Warnings.(is_active @@ Erroneous_printed_signature "") then
+    begin match Ident_conflicts.err_msg () with
+    | None -> ()
+    | Some msg ->
+        let conflicts = Fmt.asprintf "%a" Fmt.pp_doc msg in
+        Location.prerr_warning (Location.in_file sourcefile)
+          (Warnings.Erroneous_printed_signature conflicts);
+        Warnings.check_fatal ()
+    end;
+  Fmt.compat print_signature ppf t

diff --git a/typing/printtyp.mli b/typing/printtyp.mli
index 838a54f362a7a96d3f66faccf7499e39d7bd48d6..75955f4268e772c3054c5aac3d7efae531b1c26f 100644 (file)
--- a/typing/printtyp.mli
+++ b/typing/printtyp.mli
@@ -2,9 +2,9 @@
 (*                                                                        *)
 (*                                 OCaml                                  *)
 (*                                                                        *)
-(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*  Florian Angeletti, projet Cambium, INRIA Paris                        *)
 (*                                                                        *)
-(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
 (*     en Automatique.                                                    *)
 (*                                                                        *)
 (*   All rights reserved.  This file is distributed under the terms of    *)
@@ -13,237 +13,91 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(* Printing functions *)
+(** Printing functions *)
+
 
-open Format
 open Types
-open Outcometree
 
-val longident: formatter -> Longident.t -> unit
-val ident: formatter -> Ident.t -> unit
-val namespaced_ident: Shape.Sig_component_kind.t -> Ident.t -> string
-val tree_of_path: Path.t -> out_ident
-val path: formatter -> Path.t -> unit
+type namespace := Shape.Sig_component_kind.t
+
+val namespaced_ident: namespace -> Ident.t -> string
 val string_of_path: Path.t -> string
+val strings_of_paths: namespace -> Path.t list -> string list
+(** Print a list of paths, using the same naming context to
+    avoid name collisions *)
 
-val type_path: formatter -> Path.t -> unit
-(** Print a type path taking account of [-short-paths].
-    Calls should be within [wrap_printing_env]. *)
+(** [printed_signature sourcefile ppf sg] print the signature [sg] of
+        [sourcefile] with potential warnings for name collisions *)
+val printed_signature: string -> Format.formatter -> signature -> unit
 
-module Out_name: sig
-  val create: string -> out_name
-  val print: out_name -> string
-end
+module type Printers := sig
 
-type namespace := Shape.Sig_component_kind.t option
+    val wrap_printing_env: error:bool -> Env.t -> (unit -> 'a) -> 'a
+    (** Call the function using the environment for type path shortening This
+        affects all the printing functions below Also, if [~error:true], then
+        disable the loading of cmis *)
 
-val strings_of_paths: namespace -> Path.t list -> string list
-    (** Print a list of paths, using the same naming context to
-        avoid name collisions *)
-
-val raw_type_expr: formatter -> type_expr -> unit
-val string_of_label: Asttypes.arg_label -> string
-
-val wrap_printing_env: error:bool -> Env.t -> (unit -> 'a) -> 'a
-    (* Call the function using the environment for type path shortening *)
-    (* This affects all the printing functions below *)
-    (* Also, if [~error:true], then disable the loading of cmis *)
-
-module Naming_context: sig
-  val enable: bool -> unit
-  (** When contextual names are enabled, the mapping between identifiers
-      and names is ensured to be one-to-one. *)
-end
-
-(** The [Conflicts] module keeps track of conflicts arising when attributing
-    names to identifiers and provides functions that can print explanations
-    for these conflict in error messages *)
-module Conflicts: sig
-  val exists: unit -> bool
-  (** [exists()] returns true if the current naming context renamed
-        an identifier to avoid a name collision *)
-
-  type explanation =
-    { kind: Shape.Sig_component_kind.t;
-      name:string;
-      root_name:string;
-      location:Location.t
-    }
-
-  val list_explanations: unit -> explanation list
-(** [list_explanations()] return the list of conflict explanations
-    collected up to this point, and reset the list of collected
-    explanations *)
-
-  val print_located_explanations:
-    Format.formatter -> explanation list -> unit
-
-  val print_explanations: Format.formatter -> unit
-  (** Print all conflict explanations collected up to this point *)
-
-  val reset: unit -> unit
-end
-
-val reset: unit -> unit
-
-(** Print out a type.  This will pick names for type variables, and will not
-    reuse names for common type variables shared across multiple type
-    expressions.  (It will also reset the printing state, which matters for
-    other type formatters such as [prepared_type_expr].)  If you want multiple
-    types to use common names for type variables, see [prepare_for_printing] and
-    [prepared_type_expr].  *)
-val type_expr: formatter -> type_expr -> unit
-
-(** [prepare_for_printing] resets the global printing environment, a la [reset],
-    and prepares the types for printing by reserving names and marking loops.
-    Any type variables that are shared between multiple types in the input list
-    will be given the same name when printed with [prepared_type_expr]. *)
-val prepare_for_printing: type_expr list -> unit
-
-(** [add_type_to_preparation ty] extend a previous type expression preparation
-    to the type expression [ty]
-*)
-val add_type_to_preparation: type_expr -> unit
-
-val prepared_type_expr: formatter -> type_expr -> unit
-(** The function [prepared_type_expr] is a less-safe but more-flexible version
-    of [type_expr] that should only be called on [type_expr]s that have been
-    passed to [prepare_for_printing].  Unlike [type_expr], this function does no
-    extra work before printing a type; in particular, this means that any loops
-    in the type expression may cause a stack overflow (see #8860) since this
-    function does not mark any loops.  The benefit of this is that if multiple
-    type expressions are prepared simultaneously and then printed with
-    [prepared_type_expr], they will use the same names for the same type
-    variables. *)
-
-val constructor_arguments: formatter -> constructor_arguments -> unit
-val tree_of_type_scheme: type_expr -> out_type
-val type_scheme: formatter -> type_expr -> unit
-val prepared_type_scheme: formatter -> type_expr -> unit
-val shared_type_scheme: formatter -> type_expr -> unit
-(** [shared_type_scheme] is very similar to [type_scheme], but does not reset
-    the printing context first.  This is intended to be used in cases where the
-    printing should have a particularly wide context, such as documentation
-    generators; most use cases, such as error messages, have narrower contexts
-    for which [type_scheme] is better suited. *)
-
-val tree_of_value_description: Ident.t -> value_description -> out_sig_item
-val value_description: Ident.t -> formatter -> value_description -> unit
-val label : formatter -> label_declaration -> unit
-val add_constructor_to_preparation : constructor_declaration -> unit
-val prepared_constructor : formatter -> constructor_declaration -> unit
-val constructor : formatter -> constructor_declaration -> unit
-val tree_of_type_declaration:
-    Ident.t -> type_declaration -> rec_status -> out_sig_item
-val add_type_declaration_to_preparation :
-  Ident.t -> type_declaration -> unit
-val prepared_type_declaration: Ident.t -> formatter -> type_declaration -> unit
-val type_declaration: Ident.t -> formatter -> type_declaration -> unit
-val tree_of_extension_constructor:
-    Ident.t -> extension_constructor -> ext_status -> out_sig_item
-val add_extension_constructor_to_preparation :
-    extension_constructor -> unit
-val prepared_extension_constructor:
-    Ident.t -> formatter -> extension_constructor -> unit
-val extension_constructor:
-    Ident.t -> formatter -> extension_constructor -> unit
-(* Prints extension constructor with the type signature:
-     type ('a, 'b) bar += A of float
-*)
-
-val extension_only_constructor:
-    Ident.t -> formatter -> extension_constructor -> unit
-(* Prints only extension constructor without type signature:
-     A of float
-*)
-
-val tree_of_module:
-    Ident.t -> ?ellipsis:bool -> module_type -> rec_status -> out_sig_item
-val modtype: formatter -> module_type -> unit
-val signature: formatter -> signature -> unit
-val tree_of_modtype: module_type -> out_module_type
-val tree_of_modtype_declaration:
-    Ident.t -> modtype_declaration -> out_sig_item
-
-(** Print a list of functor parameters while adjusting the printing environment
-    for each functor argument.
-
-    Currently, we are disabling disambiguation for functor argument name to
-    avoid the need to track the moving association between identifiers and
-    syntactic names in situation like:
-
-    got: (X: sig module type T end) (Y:X.T) (X:sig module type T end) (Z:X.T)
-    expect: (_: sig end) (Y:X.T) (_:sig end) (Z:X.T)
-*)
-val functor_parameters:
-  sep:(Format.formatter -> unit -> unit) ->
-  ('b -> Format.formatter -> unit) ->
-  (Ident.t option * 'b) list -> Format.formatter -> unit
-
-type type_or_scheme = Type | Type_scheme
-
-val tree_of_signature: Types.signature -> out_sig_item list
-val tree_of_typexp: type_or_scheme -> type_expr -> out_type
-val modtype_declaration: Ident.t -> formatter -> modtype_declaration -> unit
-val class_type: formatter -> class_type -> unit
-val tree_of_class_declaration:
-    Ident.t -> class_declaration -> rec_status -> out_sig_item
-val class_declaration: Ident.t -> formatter -> class_declaration -> unit
-val tree_of_cltype_declaration:
-    Ident.t -> class_type_declaration -> rec_status -> out_sig_item
-val cltype_declaration: Ident.t -> formatter -> class_type_declaration -> unit
-val type_expansion :
-  type_or_scheme -> Format.formatter -> Errortrace.expanded_type -> unit
-val prepare_expansion: Errortrace.expanded_type -> Errortrace.expanded_type
-val report_ambiguous_type_error:
-    formatter -> Env.t -> (Path.t * Path.t) -> (Path.t * Path.t) list ->
-    (formatter -> unit) -> (formatter -> unit) -> (formatter -> unit) -> unit
-
-val report_unification_error :
-  formatter ->
-  Env.t -> Errortrace.unification_error ->
-  ?type_expected_explanation:(formatter -> unit) ->
-  (formatter -> unit) -> (formatter -> unit) ->
-  unit
-
-val report_equality_error :
-  formatter ->
-  type_or_scheme ->
-  Env.t -> Errortrace.equality_error ->
-  (formatter -> unit) -> (formatter -> unit) ->
-  unit
-
-val report_moregen_error :
-  formatter ->
-  type_or_scheme ->
-  Env.t -> Errortrace.moregen_error ->
-  (formatter -> unit) -> (formatter -> unit) ->
-  unit
-
-val report_comparison_error :
-  formatter ->
-  type_or_scheme ->
-  Env.t -> Errortrace.comparison_error ->
-  (formatter -> unit) -> (formatter -> unit) ->
-  unit
-
-module Subtype : sig
-  val report_error :
-    formatter ->
-    Env.t ->
-    Errortrace.Subtype.error ->
-    string ->
-    unit
-end
-
-(* for toploop *)
-val print_items: (Env.t -> signature_item -> 'a option) ->
-  Env.t -> signature_item list -> (out_sig_item * 'a option) list
-
-(* Simple heuristic to rewrite Foo__bar.* as Foo.Bar.* when Foo.Bar is an alias
-   for Foo__bar. This pattern is used by the stdlib. *)
-val rewrite_double_underscore_paths: Env.t -> Path.t -> Path.t
+    type 'a printer
+    val longident: Longident.t printer
+    val ident: Ident.t printer
+    val path: Path.t printer
+    val type_path: Path.t printer
+    (** Print a type path taking account of [-short-paths].
+        Calls should be within [wrap_printing_env]. *)
 
-(** [printed_signature sourcefile ppf sg] print the signature [sg] of
-    [sourcefile] with potential warnings for name collisions *)
-val printed_signature: string -> formatter -> signature -> unit
+
+    (** Print out a type. This will pick names for type variables, and will not
+        reuse names for common type variables shared across multiple type
+        expressions. (It will also reset the printing state, which matters for
+        other type formatters such as [prepared_type_expr].) If you want
+        multiple types to use common names for type variables, see
+        {!Out_type.prepare_for_printing} and {!Out_type.prepared_type_expr}. *)
+    val type_expr: type_expr printer
+
+    val type_scheme: type_expr printer
+
+    val shared_type_scheme: type_expr printer
+    (** [shared_type_scheme] is very similar to [type_scheme], but does not
+        reset the printing context first. This is intended to be used in cases
+        where the printing should have a particularly wide context, such as
+        documentation generators; most use cases, such as error messages, have
+        narrower contexts for which [type_scheme] is better suited. *)
+
+    val type_expansion:
+      Out_type.type_or_scheme -> Errortrace.expanded_type printer
+
+    val label : label_declaration printer
+
+    val constructor : constructor_declaration printer
+    val constructor_arguments: constructor_arguments printer
+
+    val extension_constructor:
+      Ident.t -> extension_constructor printer
+    (** Prints extension constructor with the type signature:
+         type ('a, 'b) bar += A of float
+    *)
+
+    val extension_only_constructor:
+      Ident.t -> extension_constructor printer
+    (** Prints only extension constructor without type signature:
+         A of float
+    *)
+
+
+    val value_description: Ident.t -> value_description printer
+    val type_declaration: Ident.t -> type_declaration printer
+    val modtype_declaration: Ident.t -> modtype_declaration printer
+    val class_declaration: Ident.t -> class_declaration printer
+    val cltype_declaration: Ident.t -> class_type_declaration printer
+
+
+    val modtype: module_type printer
+    val signature: signature printer
+    val class_type: class_type printer
+
+  end
+
+module Doc : Printers with type 'a printer := 'a Format_doc.printer
+
+(** For compatibility with Format printers *)
+include Printers with type 'a printer := 'a Format_doc.format_printer

diff --git a/typing/printtyped.ml b/typing/printtyped.ml
index f7bd8e48e61edce15d0705a874ca81cffe688f45..c68c7a6c379a3c9961ea9a69fb078e3de5616e2e 100644 (file)
--- a/typing/printtyped.ml
+++ b/typing/printtyped.ml
@@ -351,15 +351,16 @@ and expression i ppf x =
       line i ppf "Texp_apply\n";
       expression i ppf e;
       list i label_x_expression ppf l;
-  | Texp_match (e, l, partial) ->
-      line i ppf "Texp_match%a\n"
-        fmt_partiality partial;
+  | Texp_match (e, l1, l2, partial) ->
+      line i ppf "Texp_match%a\n" fmt_partiality partial;
       expression i ppf e;
-      list i case ppf l;
-  | Texp_try (e, l) ->
+      list i case ppf l1;
+      list i case ppf l2;
+  | Texp_try (e, l1, l2) ->
       line i ppf "Texp_try\n";
       expression i ppf e;
-      list i case ppf l;
+      list i case ppf l1;
+      list i case ppf l2;
   | Texp_tuple (l) ->
       line i ppf "Texp_tuple\n";
       list i expression ppf l;

diff --git a/typing/rawprinttyp.ml b/typing/rawprinttyp.ml
new file mode 100644 (file)
index 0000000..00d94fc
--- /dev/null
+++ b/typing/rawprinttyp.ml
@@ -0,0 +1,147 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*  Jacques Garrigue, Graduate School of Mathematics, Nagoya University   *)
+(*                                                                        *)
+(*   Copyright 2003 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+(* Print a raw type expression, with sharing *)
+
+open Format
+open Types
+open Asttypes
+let longident = Pprintast.longident
+
+let raw_list pr ppf = function
+    [] -> fprintf ppf "[]"
+  | a :: l ->
+      fprintf ppf "@[<1>[%a%t]@]" pr a
+        (fun ppf -> List.iter (fun x -> fprintf ppf ";@,%a" pr x) l)
+
+let kind_vars = ref []
+let kind_count = ref 0
+
+let string_of_field_kind v =
+  match field_kind_repr v with
+  | Fpublic -> "Fpublic"
+  | Fabsent -> "Fabsent"
+  | Fprivate -> "Fprivate"
+
+let rec safe_repr v t =
+  match Transient_expr.coerce t with
+    {desc = Tlink t} when not (List.memq t v) ->
+      safe_repr (t::v) t
+  | t' -> t'
+
+let rec list_of_memo = function
+    Mnil -> []
+  | Mcons (_priv, p, _t1, _t2, rem) -> p :: list_of_memo rem
+  | Mlink rem -> list_of_memo !rem
+
+let print_name ppf = function
+    None -> fprintf ppf "None"
+  | Some name -> fprintf ppf "\"%s\"" name
+
+let path = Format_doc.compat Path.print
+
+let visited = ref []
+let rec raw_type ppf ty =
+  let ty = safe_repr [] ty in
+  if List.memq ty !visited then fprintf ppf "{id=%d}" ty.id else begin
+    visited := ty :: !visited;
+    fprintf ppf "@[<1>{id=%d;level=%d;scope=%d;marks=%x;desc=@,%a}@]"
+      ty.id ty.level
+      (Transient_expr.get_scope ty) (Transient_expr.get_marks ty)
+      raw_type_desc ty.desc
+  end
+and raw_type_list tl = raw_list raw_type tl
+and raw_lid_type_list tl =
+  raw_list (fun ppf (lid, typ) ->
+             fprintf ppf "(@,%a,@,%a)" longident lid raw_type typ)
+    tl
+and raw_type_desc ppf = function
+    Tvar name -> fprintf ppf "Tvar %a" print_name name
+  | Tarrow(l,t1,t2,c) ->
+      fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
+        (string_of_label l) raw_type t1 raw_type t2
+        (if is_commu_ok c then "Cok" else "Cunknown")
+  | Ttuple tl ->
+      fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
+  | Tconstr (p, tl, abbrev) ->
+      fprintf ppf "@[<hov1>Tconstr(@,%a,@,%a,@,%a)@]" path p
+        raw_type_list tl
+        (raw_list path) (list_of_memo !abbrev)
+  | Tobject (t, nm) ->
+      fprintf ppf "@[<hov1>Tobject(@,%a,@,@[<1>ref%t@])@]" raw_type t
+        (fun ppf ->
+          match !nm with None -> fprintf ppf " None"
+          | Some(p,tl) ->
+              fprintf ppf "(Some(@,%a,@,%a))" path p raw_type_list tl)
+  | Tfield (f, k, t1, t2) ->
+      fprintf ppf "@[<hov1>Tfield(@,%s,@,%s,@,%a,@;<0 -1>%a)@]" f
+        (string_of_field_kind k)
+        raw_type t1 raw_type t2
+  | Tnil -> fprintf ppf "Tnil"
+  | Tlink t -> fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
+  | Tsubst (t, None) -> fprintf ppf "@[<1>Tsubst@,(%a,None)@]" raw_type t
+  | Tsubst (t, Some t') ->
+      fprintf ppf "@[<1>Tsubst@,(%a,@ Some%a)@]" raw_type t raw_type t'
+  | Tunivar name -> fprintf ppf "Tunivar %a" print_name name
+  | Tpoly (t, tl) ->
+      fprintf ppf "@[<hov1>Tpoly(@,%a,@,%a)@]"
+        raw_type t
+        raw_type_list tl
+  | Tvariant row ->
+      let Row {fields; more; name; fixed; closed} = row_repr row in
+      fprintf ppf
+        "@[<hov1>{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%B;@ %s%a;@ @[<1>%s%t@]}@]"
+        "row_fields="
+        (raw_list (fun ppf (l, f) ->
+          fprintf ppf "@[%s,@ %a@]" l raw_field f))
+        fields
+        "row_more=" raw_type more
+        "row_closed=" closed
+        "row_fixed=" raw_row_fixed fixed
+        "row_name="
+        (fun ppf ->
+          match name with None -> fprintf ppf "None"
+          | Some(p,tl) ->
+              fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
+  | Tpackage (p, fl) ->
+    fprintf ppf "@[<hov1>Tpackage(@,%a,@,%a)@]" path p raw_lid_type_list fl
+and raw_row_fixed ppf = function
+| None -> fprintf ppf "None"
+| Some Types.Fixed_private -> fprintf ppf "Some Fixed_private"
+| Some Types.Rigid -> fprintf ppf "Some Rigid"
+| Some Types.Univar t -> fprintf ppf "Some(Univar(%a))" raw_type t
+| Some Types.Reified p -> fprintf ppf "Some(Reified(%a))" path p
+
+and raw_field ppf rf =
+  match_row_field
+    ~absent:(fun _ -> fprintf ppf "RFabsent")
+    ~present:(function
+      | None ->
+          fprintf ppf "RFpresent None"
+      | Some t ->
+          fprintf ppf  "@[<1>RFpresent(Some@,%a)@]" raw_type t)
+    ~either:(fun c tl m (_,e) ->
+      fprintf ppf "@[<hov1>RFeither(%B,@,%a,@,%B,@,@[<1>ref%t@])@]" c
+        raw_type_list tl m
+        (fun ppf ->
+          match e with None -> fprintf ppf " RFnone"
+          | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f))
+    rf
+
+let type_expr ppf t =
+  visited := []; kind_vars := []; kind_count := 0;
+  raw_type ppf t;
+  visited := []; kind_vars := []

diff --git a/typing/rawprinttyp.mli b/typing/rawprinttyp.mli
new file mode 100644 (file)
index 0000000..205bf29
--- /dev/null
+++ b/typing/rawprinttyp.mli
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*  Jacques Garrigue, Graduate School of Mathematics, Nagoya University   *)
+(*                                                                        *)
+(*   Copyright 2003 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** This module provides function(s) for printing the internal representation of
+    type expressions. It is targetted at internal use when debbuging the
+    compiler itself. *)
+
+val type_expr: Format.formatter -> Types.type_expr -> unit

diff --git a/typing/shape.ml b/typing/shape.ml
index c58bdaecfb74d0f569812212c0d5618e578a2107..67e6b7a19b97d653ae5df2e4e4aa4af7cb167657 100644 (file)
--- a/typing/shape.ml
+++ b/typing/shape.ml
@@ -16,7 +16,7 @@
 module Uid = struct
   type t =
     | Compilation_unit of string
-    | Item of { comp_unit: string; id: int }
+    | Item of { comp_unit: string; id: int; from: Unit_info.intf_or_impl }
     | Internal
     | Predef of string
 
@@ -27,11 +27,16 @@ module Uid = struct
     let compare (x : t) y = compare x y
     let hash (x : t) = Hashtbl.hash x
 
+    let pp_intf_or_impl fmt = function
+      | Unit_info.Intf -> Format.pp_print_string fmt "[intf]"
+      | Unit_info.Impl -> ()
+
     let print fmt = function
       | Internal -> Format.pp_print_string fmt "<internal>"
       | Predef name -> Format.fprintf fmt "<predef:%s>" name
       | Compilation_unit s -> Format.pp_print_string fmt s
-      | Item { comp_unit; id } -> Format.fprintf fmt "%s.%d" comp_unit id
+      | Item { comp_unit; id; from } ->
+          Format.fprintf fmt "%a%s.%d" pp_intf_or_impl from comp_unit id
 
     let output oc t =
       let fmt = Format.formatter_of_out_channel oc in
@@ -43,8 +48,14 @@ module Uid = struct
   let reinit () = id := (-1)
 
   let mk  ~current_unit =
+      let comp_unit, from =
+        let open Unit_info in
+        match current_unit with
+        | None -> "", Impl
+        | Some ui -> modname ui, kind ui
+      in
       incr id;
-      Item { comp_unit = current_unit; id = !id }
+      Item { comp_unit; id = !id; from }
 
   let of_compilation_unit_id id =
     if not (Ident.persistent id) then

diff --git a/typing/shape.mli b/typing/shape.mli
index 25852be12f32b9f32d9c55def95a0b4cd33ad0e9..8da909fb76d4a32572eed781954f401fb81dd90f 100644 (file)
--- a/typing/shape.mli
+++ b/typing/shape.mli
@@ -43,9 +43,9 @@
       [cmt_format.cmt_uid_to_decl] table of the corresponding compilation unit.
 
   See:
-  - {{: https://icfp22.sigplan.org/details/mlfamilyworkshop-2022-papers/10/Module-Shapes-for-Modern-Tooling }
+  - {{:https://icfp22.sigplan.org/details/mlfamilyworkshop-2022-papers/10/Module-Shapes-for-Modern-Tooling}
     the design document}
-  - {{: https://www.lix.polytechnique.fr/Labo/Gabriel.Scherer/research/shapes/2022-ml-workshop-shapes-talk.pdf }
+  - {{:https://www.lix.polytechnique.fr/Labo/Gabriel.Scherer/research/shapes/2022-ml-workshop-shapes-talk.pdf}
     a talk about the reduction strategy
 *)
 
@@ -57,13 +57,13 @@
 module Uid : sig
   type t = private
     | Compilation_unit of string
-    | Item of { comp_unit: string; id: int }
+    | Item of { comp_unit: string; id: int; from: Unit_info.intf_or_impl }
     | Internal
     | Predef of string
 
   val reinit : unit -> unit
 
-  val mk : current_unit:string -> t
+  val mk : current_unit:(Unit_info.t option) -> t
   val of_compilation_unit_id : Ident.t -> t
   val of_predef_id : Ident.t -> t
   val internal_not_actually_unique : t

diff --git a/typing/stypes.ml b/typing/stypes.ml
index c3db19a552c77f366fa25d279b67c01efbb6bda3..400b2a84b66b63465eee56a4f13d159c2abb29f6 100644 (file)
--- a/typing/stypes.ml
+++ b/typing/stypes.ml
@@ -103,7 +103,7 @@ let sort_filter_phrases () =
 let rec printtyp_reset_maybe loc =
   match !phrases with
   | cur :: t when cur.loc_start.pos_cnum <= loc.loc_start.pos_cnum ->
-     Printtyp.reset ();
+     Out_type.reset ();
      phrases := t;
      printtyp_reset_maybe loc;
   | _ -> ()
@@ -148,7 +148,9 @@ let print_info pp prev_loc ti =
       printtyp_reset_maybe loc;
       Format.pp_print_string Format.str_formatter "  ";
       Printtyp.wrap_printing_env ~error:false env
-        (fun () -> Printtyp.shared_type_scheme Format.str_formatter typ);
+        (fun () ->
+           Printtyp.shared_type_scheme Format.str_formatter typ
+        );
       Format.pp_print_newline Format.str_formatter ();
       let s = Format.flush_str_formatter () in
       output_string pp s;

diff --git a/typing/subst.ml b/typing/subst.ml
index 87b6ec6e97f5a3c5b86ae5d39ad154605955cbee..2fb4fe14f7c7115d8161ca4de75bd8b8bf7f58d0 100644 (file)
--- a/typing/subst.ml
+++ b/typing/subst.ml
@@ -26,7 +26,7 @@ type type_replacement =
   | Path of Path.t
   | Type_function of { params : type_expr list; body : type_expr }
 
-type t =
+type s =
   { types: type_replacement Path.Map.t;
     modules: Path.t Path.Map.t;
     modtypes: module_type Path.Map.t;
@@ -34,6 +34,12 @@ type t =
     loc: Location.t option;
   }
 
+type 'a subst = s
+type safe = [`Safe]
+type unsafe = [`Unsafe]
+type t = safe subst
+exception Module_type_path_substituted_away of Path.t * Types.module_type
+
 let identity =
   { types = Path.Map.empty;
     modules = Path.Map.empty;
@@ -42,17 +48,17 @@ let identity =
     loc = None;
   }
 
-let add_type_path id p s = { s with types = Path.Map.add id (Path p) s.types }
-let add_type id p s = add_type_path (Pident id) p s
+let unsafe x = x
 
-let add_type_function id ~params ~body s =
-  { s with types = Path.Map.add id (Type_function { params; body }) s.types }
+let add_type id p s =
+    { s with types = Path.Map.add (Pident id) (Path p) s.types }
 
-let add_module_path id p s = { s with modules = Path.Map.add id p s.modules }
-let add_module id p s = add_module_path (Pident id) p s
+let add_module id p s =
+  { s with modules = Path.Map.add (Pident id) p s.modules }
 
-let add_modtype_path p ty s = { s with modtypes = Path.Map.add p ty s.modtypes }
-let add_modtype id ty s = add_modtype_path (Pident id) ty s
+let add_modtype_gen p ty s = { s with modtypes = Path.Map.add p ty s.modtypes }
+let add_modtype_path p p' s = add_modtype_gen p (Mty_ident p') s
+let add_modtype id p s = add_modtype_path (Pident id) p s
 
 let for_saving s = { s with for_saving = true }
 
@@ -100,8 +106,8 @@ let rec module_path s path =
 let modtype_path s path =
       match Path.Map.find path s.modtypes with
       | Mty_ident p -> p
-      | Mty_alias _ | Mty_signature _ | Mty_functor _ ->
-         fatal_error "Subst.modtype_path"
+      | Mty_alias _ | Mty_signature _ | Mty_functor _ as mty ->
+         raise (Module_type_path_substituted_away (path,mty))
       | exception Not_found ->
          match path with
          | Pdot(p, n) ->
@@ -584,7 +590,7 @@ let rename_bound_idents scoping s sg =
     | SigL_modtype(id, mtd, vis) :: rest ->
         let id' = rename id in
         rename_bound_idents
-          (add_modtype id (Mty_ident(Pident id')) s)
+          (add_modtype id (Pident id') s)
           (SigL_modtype(id', mtd, vis) :: sg)
           rest
     | SigL_class(id, cd, rs, vis) :: rest ->
@@ -832,3 +838,27 @@ let modtype_declaration sc s decl =
 
 let module_declaration scoping s decl =
   Lazy.(decl |> of_module_decl |> module_decl scoping s |> force_module_decl)
+
+module Unsafe = struct
+
+  type t = unsafe subst
+  type error = Fcm_type_substituted_away of Path.t * Types.module_type
+
+  let add_modtype_path = add_modtype_gen
+  let add_modtype id mty s = add_modtype_path (Pident id) mty s
+  let add_type_path id p s = { s with types = Path.Map.add id (Path p) s.types }
+  let add_type_function id ~params ~body s =
+    { s with types = Path.Map.add id (Type_function { params; body }) s.types }
+  let add_module_path id p s = { s with modules = Path.Map.add id p s.modules }
+
+  let wrap f = match f () with
+    | x -> Ok x
+    | exception Module_type_path_substituted_away (p,mty) ->
+        Error (Fcm_type_substituted_away (p,mty))
+
+  let signature_item sc s comp = wrap (fun () -> signature_item sc s comp)
+  let signature sc s comp = wrap (fun () -> signature sc s comp )
+  let compose s1 s2 = wrap (fun () -> compose s1 s2)
+  let type_declaration s t = wrap (fun () -> type_declaration s t)
+
+end

diff --git a/typing/subst.mli b/typing/subst.mli
index 8812d2a51d15a2269c612a183436b5f0637ea7e7..b218803d7575c8ea85cb9aa86c75c5f04dc93423 100644 (file)
--- a/typing/subst.mli
+++ b/typing/subst.mli
@@ -13,13 +13,12 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(* Substitutions *)
+(** Substitutions *)
 
 open Types
 
-type t
 
-(*
+(**
    Substitutions are used to translate a type from one context to
    another.  This requires substituting paths for identifiers, and
    possibly also lowering the level of non-generic variables so that
@@ -29,22 +28,32 @@ type t
    Indeed, non-variable node of a type are duplicated, with their
    levels set to generic level.  That way, the resulting type is
    well-formed (decreasing levels), even if the original one was not.
-*)
 
-val identity: t
+   In the presence of local substitutions for module types, a substitution for a
+   type expression may fail to produce a well-formed type. In order to confine
+   this issue to local substitutions, the type of substitutions is split into a
+   safe and unsafe variant. Only unsafe substitutions may expand a module type
+   path into a generic module type. *)
+
+(** Type familly for substitutions *)
+type +'k subst
+
+type safe = [`Safe]
+type unsafe = [`Unsafe]
+
+type t = safe subst
+(** Standard substitution*)
 
-val add_type: Ident.t -> Path.t -> t -> t
-val add_type_path: Path.t -> Path.t -> t -> t
-val add_type_function:
-  Path.t -> params:type_expr list -> body:type_expr -> t -> t
-val add_module: Ident.t -> Path.t -> t -> t
-val add_module_path: Path.t -> Path.t -> t -> t
-val add_modtype: Ident.t -> module_type -> t -> t
-val add_modtype_path: Path.t -> module_type -> t -> t
+val identity: 'a subst
+val unsafe: t -> unsafe subst
+
+val add_type: Ident.t -> Path.t -> 'k subst -> 'k subst
+val add_module: Ident.t -> Path.t -> 'k subst -> 'k subst
+val add_modtype: Ident.t -> Path.t -> 'k subst -> 'k subst
 
 val for_saving: t -> t
 val reset_for_saving: unit -> unit
-val change_locs: t -> Location.t -> t
+val change_locs: 'k subst -> Location.t -> 'k subst
 
 val module_path: t -> Path.t -> Path.t
 val type_path: t -> Path.t -> Path.t
@@ -59,7 +68,7 @@ val extension_constructor:
 val class_declaration: t -> class_declaration -> class_declaration
 val cltype_declaration: t -> class_type_declaration -> class_type_declaration
 
-(*
+(**
    When applied to a signature item, a substitution not only modifies the types
    present in its declaration, but also refreshes the identifier of the item.
    Effectively this creates new declarations, and so one should decide what the
@@ -80,10 +89,44 @@ val modtype_declaration:
   scoping -> t -> modtype_declaration -> modtype_declaration
 val module_declaration: scoping -> t -> module_declaration -> module_declaration
 
-(* Composition of substitutions:
-     apply (compose s1 s2) x = apply s2 (apply s1 x) *)
+(** Composition of substitutions:
+     apply (compose s1 s2) x = apply s2 (apply s1 x) **)
 val compose: t -> t -> t
 
+module Unsafe: sig
+
+  type t = unsafe subst
+  (** Unsafe substitutions introduced by [with] constraints, local substitutions
+      ([type t := int * int]) or recursive module check. *)
+
+(** Replacing a module type name S by a non-path signature is unsafe as the
+    packed module type [(module S)] becomes ill-formed. *)
+  val add_modtype: Ident.t -> module_type -> 'any subst -> t
+  val add_modtype_path: Path.t -> module_type -> 'any subst -> t
+
+  (** Deep editing inside a module type require to retypecheck the module, for
+      applicative functors in path and module aliases. *)
+  val add_type_path: Path.t -> Path.t -> t -> t
+  val add_type_function:
+    Path.t -> params:type_expr list -> body:type_expr -> t -> t
+  val add_module_path: Path.t -> Path.t -> t -> t
+
+  type error =
+    | Fcm_type_substituted_away of Path.t * Types.module_type
+
+  type 'a res := ('a, error) result
+
+  val type_declaration:  t -> type_declaration -> type_declaration res
+  val signature_item: scoping -> t -> signature_item -> signature_item res
+  val signature: scoping -> t -> signature -> signature res
+
+  val compose: t -> t -> t res
+  (** Composition of substitutions is eager and fails when the two substitution
+      are incompatible, for example [ module type t := sig end] is not
+      compatible with [module type s := sig type t=(module t) end]*)
+
+end
+
 module Lazy : sig
   type module_decl =
     {

diff --git a/typing/tast_iterator.ml b/typing/tast_iterator.ml
index 98a76c66b257e8229e4ca2ef63ffaf27654898ab..6ec345d5b27f155ab30f68c63c0e6af75b8b0e7c 100644 (file)
--- a/typing/tast_iterator.ml
+++ b/typing/tast_iterator.ml
@@ -309,12 +309,14 @@ let expr sub {exp_loc; exp_extra; exp_desc; exp_env; exp_attributes; _} =
   | Texp_apply (exp, list) ->
       sub.expr sub exp;
       List.iter (fun (_, o) -> Option.iter (sub.expr sub) o) list
-  | Texp_match (exp, cases, _) ->
+  | Texp_match (exp, cases, effs, _) ->
       sub.expr sub exp;
-      List.iter (sub.case sub) cases
-  | Texp_try (exp, cases) ->
+      List.iter (sub.case sub) cases;
+      List.iter (sub.case sub) effs
+  | Texp_try (exp, cases, effs) ->
       sub.expr sub exp;
-      List.iter (sub.case sub) cases
+      List.iter (sub.case sub) cases;
+      List.iter (sub.case sub) effs
   | Texp_tuple list -> List.iter (sub.expr sub) list
   | Texp_construct (lid, _, args) ->
       iter_loc sub lid;

diff --git a/typing/tast_mapper.ml b/typing/tast_mapper.ml
index ec416e3f602ac591453e37d9e63efd3d76d895f8..05b7a66ce84a614501f216868a034872c26b0d38 100644 (file)
--- a/typing/tast_mapper.ml
+++ b/typing/tast_mapper.ml
@@ -362,16 +362,18 @@ let expr sub x =
           sub.expr sub exp,
           List.map (tuple2 id (Option.map (sub.expr sub))) list
         )
-    | Texp_match (exp, cases, p) ->
+    | Texp_match (exp, cases, eff_cases, p) ->
         Texp_match (
           sub.expr sub exp,
           List.map (sub.case sub) cases,
+          List.map (sub.case sub) eff_cases,
           p
         )
-    | Texp_try (exp, cases) ->
+    | Texp_try (exp, exn_cases, eff_cases) ->
         Texp_try (
           sub.expr sub exp,
-          List.map (sub.case sub) cases
+          List.map (sub.case sub) exn_cases,
+          List.map (sub.case sub) eff_cases
         )
     | Texp_tuple list ->
         Texp_tuple (List.map (sub.expr sub) list)
@@ -843,11 +845,12 @@ let value_bindings sub (rec_flag, list) =
 
 let case
   : type k . mapper -> k case -> k case
-  = fun sub {c_lhs; c_guard; c_rhs} ->
+  = fun sub {c_lhs; c_guard; c_rhs; c_cont} ->
   {
     c_lhs = sub.pat sub c_lhs;
     c_guard = Option.map (sub.expr sub) c_guard;
     c_rhs = sub.expr sub c_rhs;
+    c_cont
   }
 
 let value_binding sub x =

diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 90301394f224ac608f7c8bbed98d63639210e146..043b9e908df47873296bd9d75676d84eecd28e6e 100644 (file)
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -19,7 +19,6 @@ open Path
 open Types
 open Typecore
 open Typetexp
-open Format
 
 
 type 'a class_info = {
@@ -48,7 +47,7 @@ type class_type_info = {
 
 type 'a full_class = {
   id : Ident.t;
-  id_loc : tag loc;
+  id_loc : string loc;
   clty: class_declaration;
   ty_id: Ident.t;
   cltydef: class_type_declaration;
@@ -94,7 +93,7 @@ type error =
   | Bad_class_type_parameters of Ident.t * type_expr list * type_expr list
   | Class_match_failure of Ctype.class_match_failure list
   | Unbound_val of string
-  | Unbound_type_var of (formatter -> unit) * Ctype.closed_class_failure
+  | Unbound_type_var of Format_doc.t * Ctype.closed_class_failure
   | Non_generalizable_class of
       { id : Ident.t
       ; clty : Types.class_declaration
@@ -465,7 +464,7 @@ let enter_ancestor_met ~loc name ~sign ~meths ~cl_num ~ty ~attrs met_env =
     { val_type = ty; val_kind = kind;
       val_attributes = attrs;
       Types.val_loc = loc;
-      val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+      val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) }
   in
   Env.enter_value ~check name desc met_env
 
@@ -480,7 +479,7 @@ let add_self_met loc id sign self_var_kind vars cl_num
     { val_type = ty; val_kind = kind;
       val_attributes = attrs;
       Types.val_loc = loc;
-      val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+      val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) }
   in
   Env.add_value ~check id desc met_env
 
@@ -495,7 +494,7 @@ let add_instance_var_met loc label id sign cl_num attrs met_env =
     { val_type = ty; val_kind = kind;
       val_attributes = attrs;
       Types.val_loc = loc;
-      val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) }
+      val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) }
   in
   Env.add_value id desc met_env
 
@@ -654,10 +653,9 @@ let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
       with_attrs
         (fun () ->
            let cty =
-             Ctype.with_local_level_if_principal
+             Ctype.with_local_level_generalize_structure_if_principal
                (fun () -> Typetexp.transl_simple_type val_env
                             ~closed:false styp)
-               ~post:(fun cty -> Ctype.generalize_structure cty.ctyp_type)
            in
            add_instance_variable ~strict:true loc val_env
              label.txt mut Virtual cty.ctyp_type sign;
@@ -694,8 +692,7 @@ let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
                            No_overriding ("instance variable", label.txt)))
            end;
            let definition =
-             Ctype.with_local_level_if_principal
-               ~post:Typecore.generalize_structure_exp
+             Ctype.with_local_level_generalize_structure_if_principal
                (fun () -> type_exp val_env sdefinition)
            in
            add_instance_variable ~strict:true loc val_env
@@ -1028,7 +1025,7 @@ and class_structure cl_num virt self_scope final val_env met_env loc
         raise(Error(loc, val_env, Closing_self_type sign));
   end;
   (* Typing of method bodies *)
-  Ctype.generalize_class_signature_spine val_env sign;
+  Ctype.generalize_class_signature_spine sign;
   let self_var_kind =
     match virt with
     | Virtual -> Self_virtual(ref meths)
@@ -1036,9 +1033,9 @@ and class_structure cl_num virt self_scope final val_env met_env loc
   in
   let met_env =
     List.fold_right
-      (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes} met_env ->
+      (fun {pv_id; pv_type; pv_loc; pv_kind; pv_attributes} met_env ->
          add_self_met pv_loc pv_id sign self_var_kind vars
-           cl_num pv_as_var pv_type pv_attributes met_env)
+           cl_num (pv_kind=As_var) pv_type pv_attributes met_env)
       self_pat_vars met_env
   in
   let fields =
@@ -1151,13 +1148,9 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
       class_expr cl_num val_env met_env virt self_scope sfun
   | Pcl_fun (l, None, spat, scl') ->
       let (pat, pv, val_env', met_env) =
-        Ctype.with_local_level_if_principal
+        Ctype.with_local_level_generalize_structure_if_principal
           (fun () ->
             Typecore.type_class_arg_pattern cl_num val_env met_env l spat)
-          ~post: begin fun (pat, _, _, _) ->
-            let gen {pat_type = ty} = Ctype.generalize_structure ty in
-            iter_pattern gen pat
-          end
       in
       let pv =
         List.map
@@ -1183,7 +1176,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
       let partial =
         let dummy = type_exp val_env (Ast_helper.Exp.unreachable ()) in
         Typecore.check_partial val_env pat.pat_type pat.pat_loc
-          [{c_lhs = pat; c_guard = None; c_rhs = dummy}]
+          [{c_lhs = pat; c_cont = None; c_guard = None; c_rhs = dummy}]
       in
       let cl =
         Ctype.with_raised_nongen_level
@@ -1201,9 +1194,8 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
   | Pcl_apply (scl', sargs) ->
       assert (sargs <> []);
       let cl =
-        Ctype.with_local_level_if_principal
+        Ctype.with_local_level_generalize_structure_if_principal
           (fun () -> class_expr cl_num val_env met_env virt self_scope scl')
-          ~post:(fun cl -> Ctype.generalize_class_type_structure cl.cl_type)
       in
       let rec nonopt_labels ls ty_fun =
         match ty_fun with
@@ -1222,7 +1214,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
           Location.prerr_warning
             cl.cl_loc
             (Warnings.Labels_omitted
-               (List.map Printtyp.string_of_label
+               (List.map Asttypes.string_of_label
                          (List.filter ((<>) Nolabel) labels)));
           true
         end
@@ -1270,7 +1262,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
                     if not optional && Btype.is_optional l' then
                       Location.prerr_warning sarg.pexp_loc
                         (Warnings.Nonoptional_label
-                           (Printtyp.string_of_label l));
+                           (Asttypes.string_of_label l));
                     remaining_sargs, use_arg sarg l'
                 | None ->
                     sargs,
@@ -1314,7 +1306,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
              (* do not mark the value as used *)
              let vd = Env.find_value path val_env in
              let ty =
-               Ctype.with_local_level ~post:Ctype.generalize
+               Ctype.with_local_level_generalize
                  (fun () -> Ctype.instance vd.val_type)
              in
              let expr =
@@ -1372,8 +1364,10 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
           cl, clty
         end
         ~post: begin fun ({cl_type=cl}, {cltyp_type=clty}) ->
-          Ctype.limited_generalize_class_type (Btype.self_type_row cl) cl;
-          Ctype.limited_generalize_class_type (Btype.self_type_row clty) clty;
+          Ctype.limited_generalize_class_type
+            (Btype.self_type_row cl) ~inside:cl;
+          Ctype.limited_generalize_class_type
+            (Btype.self_type_row clty) ~inside:clty;
         end
       in
       begin match
@@ -1474,8 +1468,8 @@ let initial_env define_class approx
 
   (* Temporary type for the class constructor *)
   let constr_type =
-    Ctype.with_local_level_if_principal (fun () -> approx cl.pci_expr)
-      ~post:Ctype.generalize_structure
+    Ctype.with_local_level_generalize_structure_if_principal
+      (fun () -> approx cl.pci_expr)
   in
   let dummy_cty = Cty_signature (Ctype.new_class_signature ()) in
   let dummy_class =
@@ -1560,8 +1554,10 @@ let class_infos define_class kind
     end
     ~post: begin fun (_, params, _, _, typ, sign) ->
       (* Generalize the row variable *)
-      List.iter (Ctype.limited_generalize sign.csig_self_row) params;
-      Ctype.limited_generalize_class_type sign.csig_self_row typ;
+      List.iter
+        (fun inside -> Ctype.limited_generalize sign.csig_self_row ~inside)
+        params;
+      Ctype.limited_generalize_class_type sign.csig_self_row ~inside:typ;
     end
   in
   (* Check the abbreviation for the object type *)
@@ -1710,31 +1706,20 @@ let class_infos define_class kind
     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, ci_params,
-     arity, pub_meths, coe, expr) =
-  let cl_abbr = cltydef.clty_hash_type in
-
-  begin try Ctype.collapse_conj_params env clty.cty_params
+let collapse_conj_class_params env (cl, id, clty, _, _, _, _, _, _, _, _, _) =
+  try Ctype.collapse_conj_params env clty.cty_params
   with Ctype.Unify err ->
     raise(Error(cl.pci_loc, env, Non_collapsable_conjunction (id, clty, err)))
-  end;
-
-  List.iter Ctype.generalize clty.cty_params;
-  Ctype.generalize_class_type clty.cty_type;
-  Option.iter  Ctype.generalize clty.cty_new;
-  List.iter Ctype.generalize obj_abbr.type_params;
-  Option.iter  Ctype.generalize obj_abbr.type_manifest;
-  List.iter Ctype.generalize cl_abbr.type_params;
-  Option.iter  Ctype.generalize cl_abbr.type_manifest;
 
+let final_decl env define_class
+    (cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, ci_params,
+     arity, pub_meths, coe, expr) =
   Ctype.nongen_vars_in_class_declaration clty
   |> Option.iter (fun vars ->
       let nongen_vars = Btype.TypeSet.elements vars in
       raise(Error(cl.pci_loc, env
                  , Non_generalizable_class { id; clty; nongen_vars }));
     );
-
   begin match
     Ctype.closed_class clty.cty_params
       (Btype.signature_of_class_type clty.cty_type)
@@ -1743,8 +1728,11 @@ let final_decl env define_class
   | Some reason ->
       let printer =
         if define_class
-        then function ppf -> Printtyp.class_declaration id ppf clty
-        else function ppf -> Printtyp.cltype_declaration id ppf cltydef
+        then
+          Format_doc.doc_printf "%a" (Printtyp.Doc.class_declaration id) clty
+        else
+          Format_doc.doc_printf "%a"
+            (Printtyp.Doc.cltype_declaration id) cltydef
       in
       raise(Error(cl.pci_loc, env, Unbound_type_var(printer, reason)))
   end;
@@ -1848,18 +1836,19 @@ let type_classes define_class approx kind env cls =
           Ident.create_scoped ~scope cl.pci_name.txt,
           Ident.create_scoped ~scope cl.pci_name.txt,
           Ident.create_scoped ~scope cl.pci_name.txt,
-          Uid.mk ~current_unit:(Env.get_unit_name ())
+          Uid.mk ~current_unit:(Env.get_current_unit ())
          ))
       cls
   in
   let res, env =
-    Ctype.with_local_level_for_class begin fun () ->
+    Ctype.with_local_level_generalize_for_class begin fun () ->
       let (res, env) =
         List.fold_left (initial_env define_class approx) ([], env) cls
       in
       let (res, env) =
         List.fold_right (class_infos define_class kind) res ([], env)
       in
+      List.iter (collapse_conj_class_params env) res;
       res, env
     end
   in
@@ -1980,7 +1969,7 @@ let approx_class_declarations env sdecls =
 
 (* Error report *)
 
-open Format
+open Format_doc
 
 let non_virtual_string_of_kind : kind -> string = function
   | Object -> "object"
@@ -1988,32 +1977,36 @@ let non_virtual_string_of_kind : kind -> string = function
   | Class_type -> "non-virtual class type"
 
 module Style=Misc.Style
+module Printtyp = Printtyp.Doc
 
-let report_error env ppf =
+let out_type ppf t = Style.as_inline_code !Oprint.out_type ppf t
+let quoted_type ppf t = Style.as_inline_code Printtyp.type_expr ppf t
+
+let report_error_doc env ppf =
   let pp_args ppf args =
-    let args = List.map (Printtyp.tree_of_typexp Type) args in
+    let args = List.map (Out_type.tree_of_typexp Type) args in
     Style.as_inline_code !Oprint.out_type_args ppf args
   in
   function
   | Repeated_parameter ->
       fprintf ppf "A type parameter occurs several times"
   | Unconsistent_constraint err ->
+      let msg = Format_doc.Doc.msg in
       fprintf ppf "@[<v>The class constraints are not consistent.@ ";
-      Printtyp.report_unification_error ppf env err
-        (fun ppf -> fprintf ppf "Type")
-        (fun ppf -> fprintf ppf "is not compatible with type");
+      Errortrace_report.unification ppf env err
+        (msg "Type")
+        (msg "is not compatible with type");
       fprintf ppf "@]"
   | Field_type_mismatch (k, m, err) ->
-      Printtyp.report_unification_error ppf env err
-        (function ppf ->
-           fprintf ppf "The %s %a@ has type" k Style.inline_code m)
-        (function ppf ->
-           fprintf ppf "but is expected to have type")
+      let msg  = Format_doc.doc_printf in
+      Errortrace_report.unification ppf env err
+        (msg "The %s %a@ has type" k Style.inline_code m)
+        (msg "but is expected to have type")
   | Unexpected_field (ty, lab) ->
       fprintf ppf
         "@[@[<2>This object is expected to have type :@ %a@]\
          @ This type does not have a method %a."
-        (Style.as_inline_code Printtyp.type_expr) ty
+        quoted_type ty
         Style.inline_code lab
   | Structure_expected clty ->
       fprintf ppf
@@ -2034,7 +2027,7 @@ let report_error env ppf =
       (* XXX Revoir message d'erreur | Improve error message *)
       fprintf ppf "@[%s@ %a@]"
         "This pattern cannot match self: it only matches values of type"
-        (Style.as_inline_code Printtyp.type_expr) ty
+        quoted_type ty
   | Unbound_class_2 cl ->
       fprintf ppf "@[The class@ %a@ is not yet completely defined@]"
       (Style.as_inline_code Printtyp.longident) cl
@@ -2043,23 +2036,19 @@ let report_error env ppf =
       (Style.as_inline_code Printtyp.longident) cl
   | Abbrev_type_clash (abbrev, actual, expected) ->
       (* XXX Afficher une trace ? | Print a trace? *)
-      Printtyp.prepare_for_printing [abbrev; actual; expected];
+      Out_type.prepare_for_printing [abbrev; actual; expected];
       fprintf ppf "@[The abbreviation@ %a@ expands to type@ %a@ \
        but is used with type@ %a@]"
-        (Style.as_inline_code !Oprint.out_type)
-        (Printtyp.tree_of_typexp Type abbrev)
-        (Style.as_inline_code !Oprint.out_type)
-        (Printtyp.tree_of_typexp Type actual)
-        (Style.as_inline_code !Oprint.out_type)
-        (Printtyp.tree_of_typexp Type expected)
+        out_type (Out_type.tree_of_typexp Type abbrev)
+        out_type (Out_type.tree_of_typexp Type actual)
+        out_type (Out_type.tree_of_typexp Type expected)
   | Constructor_type_mismatch (c, err) ->
-      Printtyp.report_unification_error ppf env err
-        (function ppf ->
-           fprintf ppf "The expression %a has type"
+      let msg = Format_doc.doc_printf in
+      Errortrace_report.unification ppf env err
+        (msg "The expression %a has type"
              Style.inline_code ("new " ^ c)
         )
-        (function ppf ->
-           fprintf ppf "but is used with type")
+        (msg "but is used with type")
   | Virtual_class (kind, mets, vals) ->
       let kind = non_virtual_string_of_kind kind in
       let missings =
@@ -2085,13 +2074,12 @@ let report_error env ppf =
            but is here applied to %i type argument(s)@]"
         (Style.as_inline_code Printtyp.longident) lid expected provided
   | Parameter_mismatch err ->
-      Printtyp.report_unification_error ppf env err
-        (function ppf ->
-           fprintf ppf "The type parameter")
-        (function ppf ->
-           fprintf ppf "does not meet its constraint: it should be")
+      let msg = Format_doc.Doc.msg in
+      Errortrace_report.unification ppf env err
+        (msg  "The type parameter")
+        (msg "does not meet its constraint: it should be")
   | Bad_parameters (id, params, cstrs) ->
-      Printtyp.prepare_for_printing (params @ cstrs);
+      Out_type.prepare_for_printing (params @ cstrs);
       fprintf ppf
         "@[The abbreviation %a@ is used with parameter(s)@ %a@ \
            which are incompatible with constraint(s)@ %a@]"
@@ -2100,7 +2088,7 @@ let report_error env ppf =
         pp_args cstrs
   | Bad_class_type_parameters (id, params, cstrs) ->
       let pp_hash ppf id = fprintf ppf "#%a" Printtyp.ident id in
-      Printtyp.prepare_for_printing (params @ cstrs);
+      Out_type.prepare_for_printing (params @ cstrs);
       fprintf ppf
         "@[The class type %a@ is used with parameter(s)@ %a,@ \
            whereas the class type definition@ constrains@ \
@@ -2109,10 +2097,10 @@ let report_error env ppf =
        pp_args params
        pp_args cstrs
   | Class_match_failure error ->
-      Includeclass.report_error Type ppf error
+      Includeclass.report_error_doc Type ppf error
   | Unbound_val lab ->
       fprintf ppf "Unbound instance variable %a" Style.inline_code lab
-  | Unbound_type_var (printer, reason) ->
+  | Unbound_type_var (msg, reason) ->
       let print_reason ppf { Ctype.free_variable; meth; meth_ty; } =
         let (ty0, kind) = free_variable in
         let ty1 =
@@ -2120,28 +2108,27 @@ let report_error env ppf =
           | Type_variable -> ty0
           | Row_variable -> Btype.newgenty(Tobject(ty0, ref None))
         in
-        Printtyp.add_type_to_preparation meth_ty;
-        Printtyp.add_type_to_preparation ty1;
-        let pp_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty in
+        Out_type.add_type_to_preparation meth_ty;
+        Out_type.add_type_to_preparation ty1;
         fprintf ppf
           "The method %a@ has type@;<1 2>%a@ where@ %a@ is unbound"
           Style.inline_code meth
-          pp_type (Printtyp.tree_of_typexp Type meth_ty)
-          pp_type (Printtyp.tree_of_typexp Type ty0)
+          out_type (Out_type.tree_of_typexp Type meth_ty)
+          out_type (Out_type.tree_of_typexp Type ty0)
       in
       fprintf ppf
-        "@[<v>@[Some type variables are unbound in this type:@;<1 2>%t@]@ \
+        "@[<v>@[Some type variables are unbound in this type:@;<1 2>%a@]@ \
               @[%a@]@]"
-       printer print_reason reason
+       pp_doc msg print_reason reason
   | Non_generalizable_class {id;  clty; nongen_vars } ->
       let[@manual.ref "ss:valuerestriction"] manual_ref = [ 6; 1; 2] in
-      Printtyp.prepare_for_printing nongen_vars;
+      Out_type.prepare_for_printing nongen_vars;
       fprintf ppf
         "@[The type of this class,@ %a,@ \
          contains the non-generalizable type variable(s): %a.@ %a@]"
         (Style.as_inline_code @@ Printtyp.class_declaration id) clty
         (pp_print_list ~pp_sep:(fun f () -> fprintf f ",@ ")
-           (Style.as_inline_code Printtyp.prepared_type_scheme)
+           (Style.as_inline_code Out_type.prepared_type_scheme)
         ) nongen_vars
         Misc.print_see_manual manual_ref
 
@@ -2152,20 +2139,20 @@ let report_error env ppf =
            Some occurrences are contravariant@]"
         (Style.as_inline_code Printtyp.type_scheme) ty
   | Non_collapsable_conjunction (id, clty, err) ->
+      let msg = Format_doc.Doc.msg in
       fprintf ppf
         "@[The type of this class,@ %a,@ \
            contains non-collapsible conjunctive types in constraints.@ %t@]"
         (Style.as_inline_code @@ Printtyp.class_declaration id) clty
-        (fun ppf -> Printtyp.report_unification_error ppf env err
-            (fun ppf -> fprintf ppf "Type")
-            (fun ppf -> fprintf ppf "is not compatible with type")
+        (fun ppf -> Errortrace_report.unification ppf env err
+            (msg "Type")
+            (msg "is not compatible with type")
         )
   | Self_clash err ->
-      Printtyp.report_unification_error ppf env err
-        (function ppf ->
-           fprintf ppf "This object is expected to have type")
-        (function ppf ->
-           fprintf ppf "but actually has type")
+      let msg = Format_doc.Doc.msg in
+      Errortrace_report.unification ppf env err
+        (msg "This object is expected to have type")
+        (msg "but actually has type")
   | Mutability_mismatch (_lab, mut) ->
       let mut1, mut2 =
         if mut = Immutable then "mutable", "immutable"
@@ -2192,17 +2179,19 @@ let report_error env ppf =
        completely defined.@]"
       (Style.as_inline_code Printtyp.type_scheme) sign.csig_self
 
-let report_error env ppf err =
+let report_error_doc env ppf err =
   Printtyp.wrap_printing_env ~error:true
-    env (fun () -> report_error env ppf err)
+    env (fun () -> report_error_doc env ppf err)
 
 let () =
   Location.register_error_of_exn
     (function
       | Error (loc, env, err) ->
-        Some (Location.error_of_printer ~loc (report_error env) err)
+        Some (Location.error_of_printer ~loc (report_error_doc env) err)
       | Error_forward err ->
         Some err
       | _ ->
         None
     )
+
+let report_error = Format_doc.compat1 report_error_doc

diff --git a/typing/typeclass.mli b/typing/typeclass.mli
index cdecc8dfb75db1a2d9ba587b3b8c8290f70f5d1d..89e230d14dd2665d48dc701d2dce72e9f6510375 100644 (file)
--- a/typing/typeclass.mli
+++ b/typing/typeclass.mli
@@ -15,8 +15,6 @@
 
 open Asttypes
 open Types
-open Format
-
 type 'a class_info = {
   cls_id : Ident.t;
   cls_id_loc : string loc;
@@ -111,7 +109,7 @@ type error =
   | Bad_class_type_parameters of Ident.t * type_expr list * type_expr list
   | Class_match_failure of Ctype.class_match_failure list
   | Unbound_val of string
-  | Unbound_type_var of (formatter -> unit) * Ctype.closed_class_failure
+  | Unbound_type_var of Format_doc.t * Ctype.closed_class_failure
   | Non_generalizable_class of
       { id : Ident.t
       ; clty : Types.class_declaration
@@ -129,7 +127,8 @@ type error =
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
 
-val report_error : Env.t -> formatter -> error -> unit
+val report_error : Env.t -> Format.formatter -> error -> unit
+val report_error_doc : Env.t -> error Format_doc.printer
 
 (* Forward decl filled in by Typemod.type_open_descr *)
 val type_open_descr :

diff --git a/typing/typecore.ml b/typing/typecore.ml
index 9a54846656b36f125a9712b620ee50aaf7753b2e..efa97077c3a54e52909bf6913e003eb6eb02c877 100644 (file)
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -96,6 +96,11 @@ type existential_restriction =
   | In_class_def  (** or in [class c = let ... in ...] *)
   | In_self_pattern (** or in self pattern *)
 
+type existential_binding =
+  | Bind_already_bound
+  | Bind_not_in_scope
+  | Bind_non_locally_abstract
+
 type error =
   | Constructor_arity_mismatch of Longident.t * int * int
   | Label_mismatch of Longident.t * Errortrace.unification_error
@@ -106,7 +111,7 @@ type error =
   | Orpat_vars of Ident.t * Ident.t list
   | Expr_type_clash of
       Errortrace.unification_error * type_forcing_context option
-      * Parsetree.expression_desc option
+      * Parsetree.expression option
   | Function_arity_type_clash of
       { syntactic_arity :  int;
         type_constraint : type_expr;
@@ -175,6 +180,8 @@ type error =
   | No_value_clauses
   | Exception_pattern_disallowed
   | Mixed_value_and_exception_patterns_under_guard
+  | Effect_pattern_below_toplevel
+  | Invalid_continuation_pattern
   | Inlined_record_escape
   | Inlined_record_expected
   | Unrefuted_pattern of pattern
@@ -189,10 +196,15 @@ type error =
   | Andop_type_clash of string * Errortrace.unification_error
   | Bindings_type_clash of Errortrace.unification_error
   | Unbound_existential of Ident.t list * type_expr
+  | Bind_existential of existential_binding * Ident.t * type_expr
   | Missing_type_constraint
   | Wrong_expected_kind of wrong_kind_sort * wrong_kind_context * type_expr
   | Expr_not_a_record_type of type_expr
 
+
+let not_principal fmt =
+  Format_doc.Doc.kmsg (fun x -> Warnings.Not_principal x) fmt
+
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
 
@@ -256,7 +268,7 @@ type recarg =
 let mk_expected ?explanation ty = { ty; explanation; }
 
 let case lhs rhs =
-  {c_lhs = lhs; c_guard = None; c_rhs = rhs}
+  {c_lhs = lhs; c_cont = None; c_guard = None; c_rhs = rhs}
 
 (* Typing of constants *)
 
@@ -269,7 +281,8 @@ let type_constant = function
   | Const_int64 _ -> instance Predef.type_int64
   | Const_nativeint _ -> instance Predef.type_nativeint
 
-let constant : Parsetree.constant -> (Asttypes.constant, error) result =
+let constant_desc
+  : Parsetree.constant_desc -> (Asttypes.constant, error) result =
   function
   | Pconst_integer (i,None) ->
      begin
@@ -297,6 +310,8 @@ let constant : Parsetree.constant -> (Asttypes.constant, error) result =
   | Pconst_float (f,None)-> Ok (Const_float f)
   | Pconst_float (f,Some c) -> Error (Unknown_literal (f, c))
 
+let constant const = constant_desc const.pconst_desc
+
 let constant_or_raise env loc cst =
   match constant cst with
   | Ok c -> c
@@ -368,6 +383,23 @@ let is_principal ty =
 
 (* Typing of patterns *)
 
+(* Simplified patterns for effect continuations *)
+let type_continuation_pat env expected_ty sp =
+  let loc = sp.ppat_loc in
+  match sp.ppat_desc with
+  | Ppat_any -> None
+  | Ppat_var name ->
+      let id = Ident.create_local name.txt in
+      let desc =
+        { val_type = expected_ty; val_kind = Val_reg;
+          Types.val_loc = loc; val_attributes = [];
+          val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()); }
+      in
+        Some (id, desc)
+  | Ppat_extension ext ->
+      raise (Error_forward (Builtin_attributes.error_of_extension ext))
+  | _ -> raise (Error (loc, env, Invalid_continuation_pattern))
+
 (* unification inside type_exp and type_expect *)
 let unify_exp_types loc env ty expected_ty =
   (* Format.eprintf "@[%a@ %a@]@." Printtyp.raw_type_expr exp.exp_type
@@ -404,6 +436,8 @@ let unify_pat_types_return_equated_pairs ~refine loc penv ty ty' =
       raise(Typetexp.Error(loc, !!penv, Typetexp.Variant_tags (l1, l2)))
 
 let unify_pat_types_refine ~refine loc penv ty ty' =
+  (* [refine=true] only in calls originating from [check_counter_example_pat],
+     which in turn may contain only non-leaking type variables *)
   ignore (unify_pat_types_return_equated_pairs ~refine loc penv ty ty')
 
 (** [sdesc_for_hint] is used by error messages to report literals in their
@@ -463,12 +497,17 @@ let finalize_variants p =
 (* [type_pat_state] and related types for pattern environment;
    these should not be confused with Pattern_env.t, which is a part of the
    interface to unification functions in [Ctype] *)
+type pattern_variable_kind =
+  | Std_var
+  | As_var
+  | Continuation_var
+
 type pattern_variable =
   {
     pv_id: Ident.t;
     pv_type: type_expr;
     pv_loc: Location.t;
-    pv_as_var: bool;
+    pv_kind: pattern_variable_kind;
     pv_attributes: attributes;
     pv_uid : Uid.t;
   }
@@ -518,7 +557,17 @@ type type_pat_state =
     *)
   }
 
-let create_type_pat_state allow_modules =
+let continuation_variable = function
+  | None -> []
+  | Some (id, (desc:Types.value_description)) ->
+    [{pv_id = id;
+     pv_type = desc.val_type;
+     pv_loc = desc.val_loc;
+     pv_kind = Continuation_var;
+     pv_attributes = desc.val_attributes;
+     pv_uid= desc.val_uid}]
+
+let create_type_pat_state ?cont allow_modules =
   let tps_module_variables =
     match allow_modules with
     | Modules_allowed { scope } ->
@@ -526,7 +575,7 @@ let create_type_pat_state allow_modules =
     | Modules_ignored -> Modvars_ignored
     | Modules_rejected -> Modvars_rejected
   in
-  { tps_pattern_variables = [];
+  { tps_pattern_variables = continuation_variable cont;
     tps_module_variables;
     tps_pattern_force = [];
   }
@@ -581,7 +630,7 @@ let enter_variable ?(is_module=false) ?(is_as_variable=false) tps loc name ty
           { mv_id = id;
             mv_name = name;
             mv_loc = loc;
-            mv_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+            mv_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
           } :: module_variables
         in
         tps.tps_module_variables <-
@@ -590,12 +639,12 @@ let enter_variable ?(is_module=false) ?(is_as_variable=false) tps loc name ty
     end else
       Ident.create_local name.txt
   in
-  let pv_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+  let pv_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
   tps.tps_pattern_variables <-
     {pv_id = id;
      pv_type = ty;
      pv_loc = loc;
-     pv_as_var = is_as_variable;
+     pv_kind = if is_as_variable then As_var else Std_var;
      pv_attributes = attrs;
      pv_uid} :: tps.tps_pattern_variables;
   id, pv_uid
@@ -650,7 +699,7 @@ and build_as_type_extra env p = function
   | (Tpat_constraint {ctyp_type = ty; _}, _, _) :: rest ->
       (* If the type constraint is ground, then this is the best type
          we can return, so just return an instance (cf. #12313) *)
-      if free_variables ty = [] then instance ty else
+      if closed_type_expr ty then instance ty else
       (* Otherwise we combine the inferred type for the pattern with
          then non-ground constraint in a non-ambivalent way *)
       let as_ty = build_as_type_extra env p rest in
@@ -660,7 +709,7 @@ and build_as_type_extra env p = function
          If we used [generic_instance] we would lose the sharing between
          [instance ty] and [ty].  *)
       let ty =
-        with_local_level ~post:generalize_structure (fun () -> instance ty)
+        with_local_level_generalize_structure (fun () -> instance ty)
       in
       (* This call to unify may only fail due to missing GADT equations *)
       unify_pat_types p.pat_loc env (instance as_ty) (instance ty);
@@ -740,7 +789,7 @@ let solve_Ppat_poly_constraint tps env loc sty expected_ty =
   | _ -> assert false
 
 let solve_Ppat_alias env pat =
-  with_local_level ~post:generalize (fun () -> build_as_type env pat)
+  with_local_level_generalize (fun () -> build_as_type env pat)
 
 let solve_Ppat_tuple (type a) ~refine loc env (args : a list) expected_ty =
   let vars = List.map (fun _ -> newgenvar ()) args in
@@ -750,23 +799,31 @@ let solve_Ppat_tuple (type a) ~refine loc env (args : a list) expected_ty =
   vars
 
 let solve_constructor_annotation
-    tps (penv : Pattern_env.t) name_list sty ty_args ty_ex =
+    tps (penv : Pattern_env.t) name_list sty ty_args ty_ex unify_res =
   let expansion_scope = penv.equations_scope in
-  let ids =
+  (* Introduce fresh type names that expand to type variables.
+     They should eventually be bound to ground types. *)
+  let ids_decls =
     List.map
       (fun name ->
-        let decl = new_local_type ~loc:name.loc Definition in
+        let tv = newvar () in
+        let decl =
+          new_local_type ~loc:name.loc Definition
+            ~manifest_and_scope:(tv, Ident.lowest_scope) in
         let (id, new_env) =
           Env.enter_type ~scope:expansion_scope name.txt decl !!penv in
         Pattern_env.set_env penv new_env;
-        {name with txt = id})
+        ({name with txt = id}, (decl, tv)))
       name_list
   in
+  (* Translate the type annotation using these type names. *)
   let cty, ty, force =
-    with_local_level ~post:(fun (_,ty,_) -> generalize_structure ty)
+    with_local_level_generalize_structure
       (fun () -> Typetexp.transl_simple_type_delayed !!penv sty)
   in
   tps.tps_pattern_force <- force :: tps.tps_pattern_force;
+  (* Only unify the return type after generating the ids *)
+  unify_res ();
   let ty_args =
     let ty1 = instance ty and ty2 = instance ty in
     match ty_args with
@@ -780,24 +837,62 @@ let solve_constructor_annotation
           Ttuple tyl -> tyl
         | _ -> assert false
   in
-  if ids <> [] then ignore begin
-    let ids = List.map (fun x -> x.txt) ids in
+  if ids_decls <> [] then begin
+    let ids_decls = List.map (fun (x,dm) -> (x.txt,dm)) ids_decls in
+    let ids = List.map fst ids_decls in
     let rem =
+      (* First process the existentials introduced by this constructor.
+         Just need to make their definitions abstract. *)
       List.fold_left
         (fun rem tv ->
           match get_desc tv with
-            Tconstr(Path.Pident id, [], _) when List.mem id rem ->
-              list_remove id rem
+            Tconstr(Path.Pident id, [], _) when List.mem_assoc id rem ->
+              let decl, tv' = List.assoc id ids_decls in
+              let env =
+                Env.add_type ~check:false id
+                  {decl with type_manifest = None} !!penv
+              in
+              Pattern_env.set_env penv env;
+              (* We have changed the definition, so clean up *)
+              Btype.cleanup_abbrev ();
+              (* Since id is now abstract, this does not create a cycle *)
+              unify_pat_types cty.ctyp_loc env tv tv';
+              List.remove_assoc id rem
           | _ ->
               raise (Error (cty.ctyp_loc, !!penv,
                             Unbound_existential (ids, ty))))
-        ids ty_ex
+        ids_decls ty_ex
     in
-    if rem <> [] then
-      raise (Error (cty.ctyp_loc, !!penv,
-                    Unbound_existential (ids, ty)))
+    (* The other type names should be bound to newly introduced existentials. *)
+    let bound_ids = ref ids in
+    List.iter
+      (fun (id, (decl, tv')) ->
+        let tv' = expand_head !!penv tv' in
+        begin match get_desc tv' with
+        | Tconstr (Path.Pident id', [], _) ->
+              if List.exists (Ident.same id') !bound_ids then
+                raise (Error (cty.ctyp_loc, !!penv,
+                              Bind_existential (Bind_already_bound, id, tv')));
+              (* Both id and id' are Scoped identifiers, so their stamps grow *)
+              if Ident.scope id' <> penv.equations_scope
+              || Ident.compare_stamp id id' > 0 then
+                raise (Error (cty.ctyp_loc, !!penv,
+                              Bind_existential (Bind_not_in_scope, id, tv')));
+              bound_ids := id' :: !bound_ids
+        | _ ->
+            raise (Error (cty.ctyp_loc, !!penv,
+                          Bind_existential
+                            (Bind_non_locally_abstract, id, tv')));
+        end;
+        let env =
+          Env.add_type ~check:false id
+            {decl with type_manifest = Some (duplicate_type tv')} !!penv
+        in
+        Pattern_env.set_env penv env)
+      rem;
+    if rem <> [] then Btype.cleanup_abbrev ();
   end;
-  ty_args, Some (ids, cty)
+  ty_args, Some (List.map fst ids_decls, cty)
 
 let solve_Ppat_construct ~refine tps penv loc constr no_existentials
         existential_styp expected_ty =
@@ -810,11 +905,13 @@ let solve_Ppat_construct ~refine tps penv loc constr no_existentials
   let unify_res ty_res expected_ty =
     let refine =
       refine || constr.cstr_generalized && no_existentials = None in
+    (* Here [ty_res] contains only fresh (non-leaking) type variables,
+       so the requirement of [unify_gadt] is fulfilled. *)
     unify_pat_types_return_equated_pairs ~refine loc penv ty_res expected_ty
   in
 
   let ty_args, equated_types, existential_ctyp =
-    with_local_level_iter ~post: generalize_structure begin fun () ->
+    with_local_level_generalize_structure begin fun () ->
       let expected_ty = instance expected_ty in
       let ty_args, ty_res, equated_types, existential_ctyp =
         match existential_styp with
@@ -835,16 +932,16 @@ let solve_Ppat_construct ~refine tps penv loc constr no_existentials
             let ty_args, ty_res, ty_ex =
               instance_constructor existential_treatment constr
             in
-            let equated_types = unify_res ty_res expected_ty in
+            let equated_types = lazy (unify_res ty_res expected_ty) in
             let ty_args, existential_ctyp =
               solve_constructor_annotation tps penv name_list sty ty_args ty_ex
+                (fun () -> ignore (Lazy.force equated_types))
             in
-            ty_args, ty_res, equated_types, existential_ctyp
+            ty_args, ty_res, Lazy.force equated_types, existential_ctyp
       in
       if constr.cstr_existentials <> [] then
         lower_variables_only !!penv penv.Pattern_env.equations_scope ty_res;
-      ((ty_args, equated_types, existential_ctyp),
-       expected_ty :: ty_res :: ty_args)
+      (ty_args, equated_types, existential_ctyp)
     end
   in
   if !Clflags.principal && not refine then begin
@@ -853,16 +950,14 @@ let solve_Ppat_construct ~refine tps penv loc constr no_existentials
     try
       TypePairs.iter
         (fun (t1, t2) ->
-          generalize_structure t1;
-          generalize_structure t2;
           if not (fully_generic t1 && fully_generic t2) then
             let msg =
-              Format.asprintf
+              Format_doc.doc_printf
                 "typing this pattern requires considering@ %a@ and@ %a@ as \
                 equal.@,\
                 But the knowledge of these types"
-                    Printtyp.type_expr t1
-                    Printtyp.type_expr t2
+                    Printtyp.Doc.type_expr t1
+                    Printtyp.Doc.type_expr t2
             in
             Location.prerr_warning loc (Warnings.Not_principal msg);
             raise Warn_only_once)
@@ -872,7 +967,7 @@ let solve_Ppat_construct ~refine tps penv loc constr no_existentials
   (ty_args, existential_ctyp)
 
 let solve_Ppat_record_field ~refine loc penv label label_lid record_ty =
-  with_local_level_iter ~post:generalize_structure begin fun () ->
+  with_local_level_generalize_structure begin fun () ->
     let (_, ty_arg, ty_res) = instance_label ~fixed:false label in
     begin try
       unify_pat_types_refine ~refine loc penv ty_res (instance record_ty)
@@ -880,7 +975,7 @@ let solve_Ppat_record_field ~refine loc penv label label_lid record_ty =
       raise(Error(label_lid.loc, !!penv,
                   Label_mismatch(label_lid.txt, err)))
     end;
-    (ty_arg, [ty_res; ty_arg])
+    ty_arg
   end
 
 let solve_Ppat_array ~refine loc env expected_ty =
@@ -898,7 +993,7 @@ let solve_Ppat_lazy ~refine loc env expected_ty =
 
 let solve_Ppat_constraint tps loc env sty expected_ty =
   let cty, ty, force =
-    with_local_level ~post:(fun (_, ty, _) -> generalize_structure ty)
+    with_local_level_generalize_structure
       (fun () -> Typetexp.transl_simple_type_delayed env sty)
   in
   tps.tps_pattern_force <- force :: tps.tps_pattern_force;
@@ -1055,7 +1150,7 @@ end) = struct
       [_] -> []
     | _ -> let open Printtyp in
         wrap_printing_env ~error:true env (fun () ->
-            reset(); strings_of_paths (Some Type) tpaths)
+            Out_type.reset(); strings_of_paths Type tpaths)
 
   let disambiguate_by_type env tpath lbls =
     match lbls with
@@ -1070,10 +1165,12 @@ end) = struct
   (* warn if there are several distinct candidates in scope *)
   let warn_if_ambiguous warn lid env lbl rest =
     if Warnings.is_active (Ambiguous_name ([],[],false,"")) then begin
-      Printtyp.Conflicts.reset ();
+      Out_type.Ident_conflicts.reset ();
       let paths = ambiguous_types env lbl rest in
-      let expansion =
-        Format.asprintf "%t" Printtyp.Conflicts.print_explanations in
+      let expansion = match Out_type.Ident_conflicts.err_msg () with
+        | None -> ""
+        | Some msg -> Format_doc.(asprintf "%a" pp_doc) msg
+      in
       if paths <> [] then
         warn lid.loc
           (Warnings.Ambiguous_name ([Longident.last lid.txt],
@@ -1084,15 +1181,15 @@ end) = struct
   let warn_non_principal warn lid =
     let name = Datatype_kind.label_name kind in
     warn lid.loc
-      (Warnings.Not_principal
-         ("this type-based " ^ name ^ " disambiguation"))
+      (not_principal "this type-based %s disambiguation" name)
 
   (* we selected a name out of the lexical scope *)
   let warn_out_of_scope warn lid env tpath =
     if Warnings.is_active (Name_out_of_scope ("",[],false)) then begin
       let path_s =
         Printtyp.wrap_printing_env ~error:true env
-          (fun () -> Printtyp.string_of_path tpath) in
+          (fun () -> Format_doc.asprintf "%a" Printtyp.Doc.type_path tpath)
+      in
       warn lid.loc
         (Warnings.Name_out_of_scope (path_s, [Longident.last lid.txt], false))
     end
@@ -1332,7 +1429,7 @@ let disambiguate_lid_a_list loc closed env usage expected_type lid_a_list =
   in
   if !w_pr then
     Location.prerr_warning loc
-      (Warnings.Not_principal "this type-based record disambiguation")
+      (not_principal  "this type-based record disambiguation")
   else begin
     match List.rev !w_amb with
       (_,types,ex)::_ as amb ->
@@ -1485,6 +1582,7 @@ let rec has_literal_pattern p = match p.ppat_desc with
      List.exists has_literal_pattern ps
   | Ppat_record (ps, _) ->
      List.exists (fun (_,p) -> has_literal_pattern p) ps
+  | Ppat_effect (p, q)
   | Ppat_or (p, q) ->
      has_literal_pattern p || has_literal_pattern q
 
@@ -1658,22 +1756,27 @@ and type_pat_aux
         pat_type = type_constant cst;
         pat_attributes = sp.ppat_attributes;
         pat_env = !!penv }
-  | Ppat_interval (Pconst_char c1, Pconst_char c2) ->
-      let open Ast_helper.Pat in
+  | Ppat_interval (c1, c2) ->
+      let open Ast_helper in
+      let get_bound = function
+        | {pconst_desc = Pconst_char c; _} -> c
+        | {pconst_loc = loc; _} ->
+            raise (Error (loc, !!penv, Invalid_interval))
+      in
+      let c1 = get_bound c1 in
+      let c2 = get_bound c2 in
       let gloc = {loc with Location.loc_ghost=true} in
       let rec loop c1 c2 =
-        if c1 = c2 then constant ~loc:gloc (Pconst_char c1)
+        if c1 = c2 then Pat.constant ~loc:gloc (Const.char ~loc:gloc c1)
         else
-          or_ ~loc:gloc
-            (constant ~loc:gloc (Pconst_char c1))
+          Pat.or_ ~loc:gloc
+            (Pat.constant ~loc:gloc (Const.char ~loc:gloc c1))
             (loop (Char.chr(Char.code c1 + 1)) c2)
       in
       let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in
       let p = {p with ppat_loc=loc} in
       type_pat tps category p expected_ty
         (* TODO: record 'extra' to remember about interval *)
-  | Ppat_interval _ ->
-      raise (Error (loc, !!penv, Invalid_interval))
   | Ppat_tuple spl ->
       assert (List.length spl >= 2);
       let expected_tys =
@@ -1843,6 +1946,8 @@ and type_pat_aux
          forces. *)
       let tps1 = copy_type_pat_state tps in
       let tps2 = {(copy_type_pat_state tps) with tps_pattern_force = []} in
+      (* Introduce a new level to avoid keeping nodes at intermediate levels *)
+      let pat_desc = with_local_level_generalize begin fun () ->
       (* Introduce a new scope using with_local_level without generalizations *)
       let env1, p1, env2, p2 =
         with_local_level begin fun () ->
@@ -1885,7 +1990,10 @@ and type_pat_aux
           }
         ~dst:tps;
       let p2 = alpha_pat alpha_env p2 in
-      rp { pat_desc = Tpat_or (p1, p2, None);
+      Tpat_or (p1, p2, None)
+      end
+      in
+      rp { pat_desc = pat_desc;
            pat_loc = loc; pat_extra = [];
            pat_type = instance expected_ty;
            pat_attributes = sp.ppat_attributes;
@@ -1944,6 +2052,8 @@ and type_pat_aux
         pat_env = !!penv;
         pat_attributes = sp.ppat_attributes;
       }
+  | Ppat_effect _ ->
+      raise (Error (loc, !!penv, Effect_pattern_below_toplevel))
   | Ppat_extension ext ->
       raise (Error_forward (Builtin_attributes.error_of_extension ext))
 
@@ -1952,8 +2062,8 @@ let iter_pattern_variables_type f : pattern_variable list -> unit =
 
 let add_pattern_variables ?check ?check_as env pv =
   List.fold_right
-    (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes; pv_uid} env ->
-       let check = if pv_as_var then check_as else check in
+    (fun {pv_id; pv_type; pv_loc; pv_kind; pv_attributes; pv_uid} env ->
+       let check = if pv_kind=As_var then check_as else check in
        Env.add_value ?check pv_id
          {val_type = pv_type; val_kind = Val_reg; Types.val_loc = pv_loc;
           val_attributes = pv_attributes;
@@ -2002,8 +2112,8 @@ let add_module_variables env module_variables =
 let type_pat tps category ?no_existentials penv =
   type_pat tps category ~no_existentials ~penv
 
-let type_pattern category ~lev env spat expected_ty allow_modules =
-  let tps = create_type_pat_state allow_modules in
+let type_pattern category ~lev env spat expected_ty ?cont allow_modules =
+  let tps = create_type_pat_state ?cont allow_modules in
   let new_penv = Pattern_env.make env
       ~equations_scope:lev ~allow_recursive_equations:false in
   let pat = type_pat tps category new_penv spat expected_ty in
@@ -2049,13 +2159,13 @@ let type_class_arg_pattern cl_num val_env met_env l spat =
   if is_optional l then unify_pat val_env pat (type_option (newvar ()));
   let (pv, val_env, met_env) =
     List.fold_right
-      (fun {pv_id; pv_type; pv_loc; pv_as_var; pv_attributes}
+      (fun {pv_id; pv_type; pv_loc; pv_kind; pv_attributes}
         (pv, val_env, met_env) ->
          let check s =
-           if pv_as_var then Warnings.Unused_var s
+           if pv_kind = As_var then Warnings.Unused_var s
            else Warnings.Unused_var_strict s in
          let id' = Ident.rename pv_id in
-         let val_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+         let val_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
          let val_env =
           Env.add_value pv_id
             { val_type = pv_type
@@ -2388,8 +2498,10 @@ let check_counter_example_pat ~counter_example_args penv tp expected_ty =
      way -- one of the functions it calls writes an entry into
      [tps_pattern_forces] -- so we can just ignore module patterns. *)
   let type_pat_state = create_type_pat_state Modules_ignored in
-  check_counter_example_pat
-    ~info:counter_example_args ~penv type_pat_state tp expected_ty (fun x -> x)
+  wrap_trace_gadt_instances ~force:true !!penv
+    (check_counter_example_pat ~info:counter_example_args ~penv
+       type_pat_state tp expected_ty)
+    (fun x -> x)
 
 (* this function is passed to Partial.parmatch
    to type check gadt nonexhaustiveness *)
@@ -2458,9 +2570,9 @@ let rec final_subexpression exp =
   match exp.exp_desc with
     Texp_let (_, _, e)
   | Texp_sequence (_, e)
-  | Texp_try (e, _)
+  | Texp_try (e, _, _)
   | Texp_ifthenelse (_, e, _)
-  | Texp_match (_, {c_rhs=e} :: _, _)
+  | Texp_match (_, {c_rhs=e} :: _, _, _)
   | Texp_letmodule (_, _, _, _, e)
   | Texp_letexception (_, e)
   | Texp_open (_, e)
@@ -2481,7 +2593,7 @@ let rec is_nonexpansive exp =
       is_nonexpansive body
   | Texp_apply(e, (_,None)::el) ->
       is_nonexpansive e && List.for_all is_nonexpansive_opt (List.map snd el)
-  | Texp_match(e, cases, _) ->
+  | Texp_match(e, cases, _, _) ->
      (* Not sure this is necessary, if [e] is nonexpansive then we shouldn't
          care if there are exception patterns. But the previous version enforced
          that there be none, so... *)
@@ -2746,14 +2858,19 @@ let rec list_labels_aux env visited ls ty_fun =
       List.rev ls, is_Tvar ty
 
 let list_labels env ty =
-  wrap_trace_gadt_instances env (list_labels_aux env TypeSet.empty []) ty
+  let snap = Btype.snapshot () in
+  let result =
+    wrap_trace_gadt_instances env (list_labels_aux env TypeSet.empty []) ty
+  in
+  Btype.backtrack snap;
+  result
 
 (* Check that all univars are safe in a type. Both exp.exp_type and
    ty_expected should already be generalized. *)
 let check_univars env kind exp ty_expected vars =
   let pty = instance ty_expected in
   let exp_ty, vars =
-    with_local_level_iter ~post:generalize begin fun () ->
+    with_local_level_generalize begin fun () ->
       match get_desc pty with
         Tpoly (body, tl) ->
           (* Enforce scoping for type_let:
@@ -2762,7 +2879,7 @@ let check_univars env kind exp ty_expected vars =
           let _, ty' = instance_poly ~fixed:true tl body in
           let vars, exp_ty = instance_parameterized_type vars exp.exp_type in
           unify_exp_types exp.exp_loc env exp_ty ty';
-          ((exp_ty, vars), exp_ty::vars)
+          (exp_ty, vars)
       | _ -> assert false
     end
   in
@@ -2776,12 +2893,6 @@ let check_univars env kind exp ty_expected vars =
                                 ~trace:[Ctype.expanded_diff env
                                           ~got:ty ~expected:ty_expected])))
 
-let generalize_and_check_univars env kind exp ty_expected vars =
-  generalize exp.exp_type;
-  generalize ty_expected;
-  List.iter generalize vars;
-  check_univars env kind exp ty_expected vars
-
 (* [check_statement] implements the [non-unit-statement] check.
 
    This check is called in contexts where the value of the expression is known
@@ -2856,10 +2967,13 @@ let check_partial_application ~statement exp =
             | Texp_extension_constructor _ | Texp_ifthenelse (_, _, None)
             | Texp_function _ ->
                 check_statement ()
-            | Texp_match (_, cases, _) ->
-                List.iter (fun {c_rhs; _} -> check c_rhs) cases
-            | Texp_try (e, cases) ->
-                check e; List.iter (fun {c_rhs; _} -> check c_rhs) cases
+            | Texp_match (_, cases, eff_cases, _) ->
+                List.iter (fun {c_rhs; _} -> check c_rhs) cases;
+                List.iter (fun {c_rhs; _} -> check c_rhs) eff_cases
+            | Texp_try (e, cases, eff_cases) ->
+                check e;
+                List.iter (fun {c_rhs; _} -> check c_rhs) cases;
+                List.iter (fun {c_rhs; _} -> check c_rhs) eff_cases
             | Texp_ifthenelse (_, e1, Some e2) ->
                 check e1; check e2
             | Texp_let (_, _, e) | Texp_sequence (_, e) | Texp_open (_, e)
@@ -2899,13 +3013,13 @@ let pattern_needs_partial_application_check p =
 
 (* Check that a type is generalizable at some level *)
 let generalizable level ty =
-  let rec check ty =
-    if not_marked_node ty then
-      if get_level ty <= level then raise Exit else
-      (flip_mark_node ty; iter_type_expr check ty)
-  in
-  try check ty; unmark_type ty; true
-  with Exit -> unmark_type ty; false
+  with_type_mark begin fun mark ->
+    let rec check ty =
+      if try_mark_node mark ty then
+        if get_level ty <= level then raise Exit else iter_type_expr check ty
+    in
+    try check ty; true with Exit -> false
+  end
 
 (* Hack to allow coercion of self. Will clean-up later. *)
 let self_coercion = ref ([] : (Path.t * Location.t list ref) list)
@@ -2913,8 +3027,9 @@ let self_coercion = ref ([] : (Path.t * Location.t list ref) list)
 (* Helpers for type_cases *)
 
 let contains_variant_either ty =
+  with_type_mark begin fun mark ->
   let rec loop ty =
-    if try_mark_node ty then
+    if try_mark_node mark ty then
       begin match get_desc ty with
         Tvariant row ->
           if not (is_fixed row) then
@@ -2927,8 +3042,8 @@ let contains_variant_either ty =
           iter_type_expr loop ty
       end
   in
-  try loop ty; unmark_type ty; false
-  with Exit -> unmark_type ty; true
+  try loop ty; false with Exit -> true
+  end
 
 let shallow_iter_ppat f p =
   match p.ppat_desc with
@@ -2937,7 +3052,8 @@ let shallow_iter_ppat f p =
   | Ppat_extension _
   | Ppat_type _ | Ppat_unpack _ -> ()
   | Ppat_array pats -> List.iter f pats
-  | Ppat_or (p1,p2) -> f p1; f p2
+  | Ppat_or (p1,p2)
+  | Ppat_effect(p1, p2) -> f p1; f p2
   | Ppat_variant (_, arg) -> Option.iter f arg
   | Ppat_tuple lst ->  List.iter f lst
   | Ppat_construct (_, Some (_, p))
@@ -3006,14 +3122,14 @@ let check_absent_variant env =
       || not (is_fixed row) && not (static_row row)  (* same as Ctype.poly *)
       then () else
       let ty_arg =
-        match arg with None -> [] | Some p -> [correct_levels p.pat_type] in
+        match arg with None -> [] | Some p -> [duplicate_type p.pat_type] in
       let fields = [s, rf_either ty_arg ~no_arg:(arg=None) ~matched:true] in
       let row' =
         create_row ~fields
           ~more:(newvar ()) ~closed:false ~fixed:None ~name:None in
       (* Should fail *)
       unify_pat env {pat with pat_type = newty (Tvariant row')}
-                     (correct_levels pat.pat_type)
+                     (duplicate_type pat.pat_type)
     | _ -> () }
 
 (* Getting proper location of already typed expressions.
@@ -3052,14 +3168,14 @@ let name_cases default lst =
 
 (* Typing of expressions *)
 
-(** [sdesc_for_hint] is used by error messages to report literals in their
+(** [sexp_for_hint] is used by error messages to report literals in their
     original formatting *)
-let unify_exp ?sdesc_for_hint env exp expected_ty =
+let unify_exp ~sexp env exp expected_ty =
   let loc = proper_exp_loc exp in
   try
     unify_exp_types loc env exp.exp_type expected_ty
   with Error(loc, env, Expr_type_clash(err, tfc, None)) ->
-    raise (Error(loc, env, Expr_type_clash(err, tfc, sdesc_for_hint)))
+    raise (Error(loc, env, Expr_type_clash(err, tfc, Some sexp)))
 
 (* If [is_inferred e] is true, [e] will be typechecked without using
    the "expected type" provided by the context. *)
@@ -3111,10 +3227,8 @@ let with_explanation explanation f =
         raise (Error (loc', env', err))
 
 (* Generalize expressions *)
-let generalize_structure_exp exp = generalize_structure exp.exp_type
-let may_lower_contravariant_then_generalize env exp =
-  if maybe_expansive exp then lower_contravariant env exp.exp_type;
-  generalize exp.exp_type
+let may_lower_contravariant env exp =
+  if maybe_expansive exp then lower_contravariant env exp.exp_type
 
 (* value binding elaboration *)
 
@@ -3206,16 +3320,15 @@ and type_expect_
     env sexp ty_expected_explained =
   let { ty = ty_expected; explanation } = ty_expected_explained in
   let loc = sexp.pexp_loc in
-  let desc = sexp.pexp_desc in
   (* Record the expression type before unifying it with the expected type *)
   let with_explanation = with_explanation explanation in
   (* Unify the result with [ty_expected], enforcing the current level *)
   let rue exp =
     with_explanation (fun () ->
-      unify_exp ~sdesc_for_hint:desc env (re exp) (instance ty_expected));
+      unify_exp ~sexp env (re exp) (instance ty_expected));
     exp
   in
-  match desc with
+  match sexp.pexp_desc with
   | Pexp_ident lid ->
       let path, desc = type_ident env ~recarg lid in
       let exp_desc =
@@ -3242,7 +3355,7 @@ and type_expect_
         exp_type = instance desc.val_type;
         exp_attributes = sexp.pexp_attributes;
         exp_env = env }
-  | Pexp_constant(Pconst_string (str, _, _) as cst) -> (
+  | Pexp_constant({pconst_desc = Pconst_string (str, _, _); _} as cst) -> (
     let cst = constant_or_raise env loc cst in
     (* Terrible hack for format strings *)
     let ty_exp = expand_head env (protect_expansion env ty_expected) in
@@ -3254,7 +3367,7 @@ and type_expect_
       | Tconstr(path, _, _) when Path.same path fmt6_path ->
         if !Clflags.principal && get_level ty_exp <> generic_level then
           Location.prerr_warning loc
-            (Warnings.Not_principal "this coercion to format6");
+            (not_principal "this coercion to format6");
         true
       | _ -> false
     in
@@ -3302,7 +3415,7 @@ and type_expect_
            introduced by those unpacks. The below code checks for scope escape
            via both of these pathways (body, bound expressions).
         *)
-        with_local_level_if may_contain_modules begin fun () ->
+        with_local_level_generalize_if may_contain_modules begin fun () ->
           let allow_modules =
             if may_contain_modules
             then
@@ -3333,7 +3446,6 @@ and type_expect_
                     types added to [new_env].
                  *)
                 let bound_exp = vb.vb_expr in
-                generalize_structure_exp bound_exp;
                 let bound_exp_type = Ctype.instance bound_exp.exp_type in
                 let loc = proper_exp_loc bound_exp in
                 let outer_var = newvar2 outer_level in
@@ -3347,9 +3459,9 @@ and type_expect_
           end;
           (pat_exp_list, body, new_env)
         end
-        ~post:(fun (_pat_exp_list, body, new_env) ->
+        ~before_generalize:(fun (_pat_exp_list, body, new_env) ->
           (* The "body" component of the scope escape check. *)
-          unify_exp new_env body (newvar ()))
+          unify_exp ~sexp new_env body (newvar ()))
       in
       re {
         exp_desc = Texp_let(rec_flag, pat_exp_list, body);
@@ -3413,28 +3525,27 @@ and type_expect_
         }
   | Pexp_apply(sfunct, sargs) ->
       assert (sargs <> []);
+      let outer_level = get_current_level () in
       let rec lower_args seen ty_fun =
         let ty = expand_head env ty_fun in
         if TypeSet.mem ty seen then () else
           match get_desc ty with
             Tarrow (_l, ty_arg, ty_fun, _com) ->
-              (try enforce_current_level env ty_arg
+              (try Ctype.unify_var env (newvar2 outer_level) ty_arg
                with Unify _ -> assert false);
               lower_args (TypeSet.add ty seen) ty_fun
           | _ -> ()
       in
+      (* one more level for warning on non-returning functions *)
+      with_local_level_generalize begin fun () ->
       let type_sfunct sfunct =
-        (* one more level for warning on non-returning functions *)
-        with_local_level_iter
-          begin fun () ->
-            let funct =
-              with_local_level_if_principal (fun () -> type_exp env sfunct)
-                ~post: generalize_structure_exp
-            in
-            let ty = instance funct.exp_type in
-            (funct, [ty])
-          end
-          ~post:(wrap_trace_gadt_instances env (lower_args TypeSet.empty))
+        let funct =
+          with_local_level_generalize_structure_if_principal
+            (fun () -> type_exp env sfunct)
+        in
+        let ty = instance funct.exp_type in
+        wrap_trace_gadt_instances env (lower_args TypeSet.empty) ty;
+        funct
       in
       let funct, sargs =
         let funct = type_sfunct sfunct in
@@ -3460,33 +3571,72 @@ and type_expect_
         exp_type = ty_res;
         exp_attributes = sexp.pexp_attributes;
         exp_env = env }
+      end
   | Pexp_match(sarg, caselist) ->
       let arg =
-        with_local_level (fun () -> type_exp env sarg)
-          ~post:(may_lower_contravariant_then_generalize env)
+        with_local_level_generalize (fun () -> type_exp env sarg)
+          ~before_generalize:(may_lower_contravariant env)
+      in
+      let rec split_cases valc effc conts = function
+        | [] -> List.rev valc, List.rev effc, List.rev conts
+        | {pc_lhs = {ppat_desc=Ppat_effect(p1, p2)}} as c :: rest ->
+            split_cases valc
+              (({c with pc_lhs = p1}) :: effc) (p2 :: conts) rest
+        | c :: rest ->
+            split_cases (c :: valc) effc conts rest
+      in
+      let val_caselist, eff_caselist, eff_conts =
+        split_cases [] [] [] caselist
+      in
+      if val_caselist = [] && eff_caselist <> [] then
+        raise (Error (loc, env, No_value_clauses));
+      let val_cases, partial =
+        type_cases Computation env arg.exp_type ty_expected_explained
+          ~check_if_total:true loc val_caselist
+      in
+      let eff_cases =
+        match eff_caselist with
+        | [] -> []
+        | eff_caselist ->
+            type_effect_cases Value env ty_expected_explained loc eff_caselist
+              eff_conts
       in
-      let cases, partial =
-        type_cases Computation env
-          arg.exp_type ty_expected_explained
-          ~check_if_total:true loc caselist in
       if
         List.for_all (fun c -> pattern_needs_partial_application_check c.c_lhs)
-          cases
+          val_cases
       then check_partial_application ~statement:false arg;
       re {
-        exp_desc = Texp_match(arg, cases, partial);
+        exp_desc = Texp_match(arg, val_cases, eff_cases, partial);
         exp_loc = loc; exp_extra = [];
         exp_type = instance ty_expected;
         exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_try(sbody, caselist) ->
       let body = type_expect env sbody ty_expected_explained in
-      let cases, _ =
-        type_cases Value env
-          Predef.type_exn ty_expected_explained
-          ~check_if_total:false loc caselist in
+      let rec split_cases exnc effc conts = function
+        | [] -> List.rev exnc, List.rev effc, List.rev conts
+        | {pc_lhs = {ppat_desc=Ppat_effect(p1, p2)}} as c :: rest ->
+            split_cases exnc
+              (({c with pc_lhs = p1}) :: effc) (p2 :: conts) rest
+        | c :: rest ->
+            split_cases (c :: exnc) effc conts rest
+      in
+      let exn_caselist, eff_caselist, eff_conts =
+        split_cases [] [] [] caselist
+      in
+      let exn_cases, _ =
+        type_cases Value env Predef.type_exn ty_expected_explained
+          ~check_if_total:false loc exn_caselist
+      in
+      let eff_cases =
+        match eff_caselist with
+        | [] -> []
+        | eff_caselist ->
+            type_effect_cases Value env ty_expected_explained loc eff_caselist
+              eff_conts
+      in
       re {
-        exp_desc = Texp_try(body, cases);
+        exp_desc = Texp_try(body, exn_cases, eff_cases);
         exp_loc = loc; exp_extra = [];
         exp_type = body.exp_type;
         exp_attributes = sexp.pexp_attributes;
@@ -3509,7 +3659,7 @@ and type_expect_
         exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_construct(lid, sarg) ->
-      type_construct env loc lid sarg ty_expected_explained sexp.pexp_attributes
+      type_construct env ~sexp lid sarg ty_expected_explained
   | Pexp_variant(l, sarg) ->
       (* Keep sharing *)
       let ty_expected1 = protect_expansion env ty_expected in
@@ -3558,9 +3708,8 @@ and type_expect_
           None -> None
         | Some sexp ->
             let exp =
-              with_local_level_if_principal
+              with_local_level_generalize_structure_if_principal
                 (fun () -> type_exp ~recarg env sexp)
-                ~post: generalize_structure_exp
             in
             Some exp
       in
@@ -3593,7 +3742,7 @@ and type_expect_
         | (None | Some (_, _, false)), Some (_, p', _) ->
             let decl = Env.find_type p' env in
             let ty =
-              with_local_level ~post:generalize_structure
+              with_local_level_generalize_structure
                 (fun () -> newconstr p' (instance_list decl.type_params))
             in
             ty, opt_exp_opath
@@ -3699,7 +3848,7 @@ and type_expect_
         type_label_access env srecord Env.Projection lid
       in
       let (_, ty_arg, ty_res) = instance_label ~fixed:false label in
-      unify_exp env record ty_res;
+      unify_exp ~sexp env record ty_res;
       rue {
         exp_desc = Texp_field(record, lid, label);
         exp_loc = loc; exp_extra = [];
@@ -3713,7 +3862,7 @@ and type_expect_
         if expected_type = None then newvar () else record.exp_type in
       let (label_loc, label, newval) =
         type_label_exp false env loc ty_record (lid, label, snewval) in
-      unify_exp env record ty_record;
+      unify_exp ~sexp env record ty_record;
       if label.lbl_mut = Immutable then
         raise(Error(loc, env, Label_not_mutable lid.txt));
       rue {
@@ -3752,7 +3901,7 @@ and type_expect_
           let ifso = type_expect env sifso ty_expected_explained in
           let ifnot = type_expect env sifnot ty_expected_explained in
           (* Keep sharing *)
-          unify_exp env ifnot ifso.exp_type;
+          unify_exp ~sexp env ifnot ifso.exp_type;
           re {
             exp_desc = Texp_ifthenelse(cond, ifso, Some ifnot);
             exp_loc = loc; exp_extra = [];
@@ -3799,7 +3948,7 @@ and type_expect_
                val_attributes = [];
                val_kind = Val_reg;
                val_loc = loc;
-               val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+               val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
               } env
               ~check:(fun s -> Warnings.Unused_for_index s)
         | _ ->
@@ -3838,9 +3987,8 @@ and type_expect_
       }
   | Pexp_send (e, {txt=met}) ->
       let (obj,meth,typ) =
-        with_local_level_if_principal
+        with_local_level_generalize_structure_if_principal
           (fun () -> type_send env loc explanation e met)
-          ~post:(fun (_,_,typ) -> generalize_structure typ)
       in
       let typ =
         match get_desc typ with
@@ -3849,7 +3997,7 @@ and type_expect_
         | Tpoly (ty, tl) ->
             if !Clflags.principal && get_level typ <> generic_level then
               Location.prerr_warning loc
-                (Warnings.Not_principal "this use of a polymorphic method");
+                (not_principal "this use of a polymorphic method");
             snd (instance_poly ~fixed:false tl ty)
         | Tvar _ ->
             let ty' = newvar () in
@@ -3944,7 +4092,7 @@ and type_expect_
   | Pexp_letmodule(name, smodl, sbody) ->
       let lv = get_current_level () in
       let (id, pres, modl, _, body) =
-        with_local_level begin fun () ->
+        with_local_level_generalize begin fun () ->
           let modl, pres, id, new_env =
             Typetexp.TyVarEnv.with_local_scope begin fun () ->
               let modl, md_shape = !type_module env smodl in
@@ -3955,7 +4103,7 @@ and type_expect_
                 | _ -> Mp_present
               in
               let scope = create_scope () in
-              let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+              let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
               let md_shape = Shape.set_uid_if_none md_shape md_uid in
               let md =
                 { md_type = modl.mod_type; md_attributes = [];
@@ -3983,7 +4131,7 @@ and type_expect_
           let body = type_expect new_env sbody ty_expected_explained in
           (id, pres, modl, new_env, body)
         end
-        ~post: begin fun (_id, _pres, _modl, new_env, body) ->
+        ~before_generalize: begin fun (_id, _pres, _modl, new_env, body) ->
           (* Ensure that local definitions do not leak. *)
           (* required for implicit unpack *)
           enforce_current_level new_env body.exp_type
@@ -4052,8 +4200,7 @@ and type_expect_
       }
   | Pexp_poly(sbody, sty) ->
       let ty, cty =
-        with_local_level_if_principal
-          ~post:(fun (ty,_) -> generalize_structure ty)
+        with_local_level_generalize_structure_if_principal
           begin fun () ->
             match sty with None -> protect_expansion env ty_expected, None
             | Some sty ->
@@ -4072,32 +4219,29 @@ and type_expect_
             { exp with exp_type = instance ty }
         | Tpoly (ty', tl) ->
             (* One more level to generalize locally *)
-            let (exp,_) =
-              with_local_level begin fun () ->
+            let (exp, vars) =
+              with_local_level_generalize begin fun () ->
                 let vars, ty'' =
-                  with_local_level_if_principal
+                  with_local_level_generalize_structure_if_principal
                     (fun () -> instance_poly ~fixed:true tl ty')
-                    ~post:(fun (_,ty'') -> generalize_structure ty'')
                 in
                 let exp = type_expect env sbody (mk_expected ty'') in
                 (exp, vars)
               end
-              ~post: begin fun (exp,vars) ->
-                generalize_and_check_univars env "method" exp ty_expected vars
-              end
             in
+            check_univars env "method" exp ty_expected vars;
             { exp with exp_type = instance ty }
         | Tvar _ ->
             let exp = type_exp env sbody in
             let exp = {exp with exp_type = newty (Tpoly (exp.exp_type, []))} in
-            unify_exp env exp ty;
+            unify_exp ~sexp env exp ty;
             exp
         | _ -> assert false
       in
       re { exp with exp_extra =
              (Texp_poly cty, loc, sexp.pexp_attributes) :: exp.exp_extra }
-  | Pexp_newtype({txt=name}, sbody) ->
-      let body, ety = type_newtype loc env name (fun env ->
+  | Pexp_newtype(name, sbody) ->
+      let body, ety = type_newtype env name (fun env ->
         let expr = type_exp env sbody in
         expr, expr.exp_type)
       in
@@ -4105,7 +4249,8 @@ and type_expect_
          any new extra node in the typed AST. *)
       rue { body with exp_loc = loc; exp_type = ety;
             exp_extra =
-            (Texp_newtype name, loc, sexp.pexp_attributes) :: body.exp_extra }
+            (Texp_newtype name.txt, loc, sexp.pexp_attributes) :: body.exp_extra
+          }
   | Pexp_pack m ->
       let (p, fl) =
         match get_desc (Ctype.expand_head env (instance ty_expected)) with
@@ -4116,7 +4261,7 @@ and type_expect_
                 < Btype.generic_level
             then
               Location.prerr_warning loc
-                (Warnings.Not_principal "this module packing");
+                (not_principal "this module packing");
             (p, fl)
         | Tvar _ ->
             raise (Error (loc, env, Cannot_infer_signature))
@@ -4158,8 +4303,7 @@ and type_expect_
       in
       let op_path, op_desc, op_type, spat_params, ty_params,
           ty_func_result, ty_result, ty_andops =
-        with_local_level_iter_if_principal
-          ~post:generalize_structure begin fun () ->
+        with_local_level_generalize_structure_if_principal begin fun () ->
           let let_loc = slet.pbop_op.loc in
           let op_path, op_desc = type_binding_op_ident env slet.pbop_op in
           let op_type = instance op_desc.val_type in
@@ -4178,9 +4322,8 @@ and type_expect_
           with Unify err ->
             raise(Error(let_loc, env, Letop_type_clash(slet.pbop_op.txt, err)))
           end;
-          ((op_path, op_desc, op_type, spat_params, ty_params,
-            ty_func_result, ty_result, ty_andops),
-           [ty_andops; ty_params; ty_func_result; ty_result])
+          (op_path, op_desc, op_type, spat_params, ty_params,
+           ty_func_result, ty_result, ty_andops)
         end
       in
       let exp, ands = type_andops env slet.pbop_exp sands ty_andops in
@@ -4282,11 +4425,12 @@ and type_coerce
     in
     let arg, arg_type, gen =
       let lv = get_current_level () in
-      with_local_level begin fun () ->
+      with_local_level_generalize begin fun () ->
           let arg, arg_type = type_without_constraint env in
           arg, arg_type, generalizable lv arg_type
         end
-        ~post:(fun (_, arg_type, _) -> enforce_current_level env arg_type)
+        ~before_generalize:
+         (fun (_, arg_type, _) -> enforce_current_level env arg_type)
     in
     begin match !self_coercion, get_desc ty' with
       | ((path, r) :: _, Tconstr (path', _, _))
@@ -4294,8 +4438,8 @@ and type_coerce
           (* prerr_endline "self coercion"; *)
           r := loc :: !r;
           force ()
-      | _ when free_variables ~env arg_type = []
-            && free_variables ~env ty' = [] ->
+      | _ when closed_type_expr ~env arg_type
+            && closed_type_expr ~env ty' ->
           if not gen && (* first try a single coercion *)
             let snap = snapshot () in
             let ty, _b = enlarge_type env ty' in
@@ -4309,7 +4453,7 @@ and type_coerce
             force (); force' ();
             if not gen && !Clflags.principal then
               Location.prerr_warning loc
-                (Warnings.Not_principal "this ground coercion");
+                (not_principal "this ground coercion");
           with Subtype err ->
             (* prerr_endline "coercion failed"; *)
             raise (Error (loc, env, Not_subtype err))
@@ -4326,14 +4470,13 @@ and type_coerce
       (arg, ty', Texp_coerce (None, cty'))
   | Some sty ->
       let cty, ty, force, cty', ty', force' =
-        with_local_level_iter ~post:generalize_structure begin fun () ->
+        with_local_level_generalize_structure begin fun () ->
           let (cty, ty, force) =
             Typetexp.transl_simple_type_delayed env sty
           and (cty', ty', force') =
             Typetexp.transl_simple_type_delayed env sty'
           in
-          ((cty, ty, force, cty', ty', force'),
-           [ ty; ty' ])
+          (cty, ty, force, cty', ty', force')
         end
       in
       begin try
@@ -4348,10 +4491,9 @@ and type_coerce
 and type_constraint env sty =
   (* Pretend separate = true, 1% slowdown for lablgtk *)
   let cty =
-    with_local_level begin fun () ->
+    with_local_level_generalize_structure begin fun () ->
       Typetexp.transl_simple_type env ~closed:false sty
     end
-    ~post:(fun cty -> generalize_structure cty.ctyp_type)
   in
   cty.ctyp_type, Texp_constraint cty
 
@@ -4386,18 +4528,18 @@ and type_constraint_expect
     nodes for the newtype properly linked.
 *)
 and type_newtype
-  : type a. _ -> _ -> _ -> (Env.t -> a * type_expr) -> a * type_expr =
-  fun loc env name type_body ->
+  : type a. _ -> _ -> (Env.t -> a * type_expr) -> a * type_expr =
+  fun env { txt = name; loc = name_loc } type_body ->
   let ty =
     if Typetexp.valid_tyvar_name name then
       newvar ~name ()
     else
       newvar ()
   in
-  (* Use [with_local_level] just for scoping *)
-  with_local_level begin fun () ->
+  (* Use [with_local_level_generalize] just for scoping *)
+  with_local_level_generalize begin fun () ->
     (* Create a fake abstract type declaration for [name]. *)
-    let decl = new_local_type ~loc Definition in
+    let decl = new_local_type ~loc:name_loc Definition in
     let scope = create_scope () in
     let (id, new_env) = Env.enter_type ~scope name decl env in
 
@@ -4418,6 +4560,7 @@ and type_newtype
     replace ety;
     (result, ety)
   end
+  ~before_generalize:(fun (_,ety) -> enforce_current_level env ety)
 
 and type_ident env ?(recarg=Rejected) lid =
   let (path, desc) = Env.lookup_value ~loc:lid.loc lid.txt env in
@@ -4466,7 +4609,7 @@ and type_binding_op_ident env s =
 and split_function_ty env ty_expected ~arg_label ~first ~in_function =
   let { ty = ty_fun; explanation }, loc = in_function in
   let separate = !Clflags.principal || Env.has_local_constraints env in
-  with_local_level_iter_if separate ~post:generalize_structure begin fun () ->
+  with_local_level_generalize_structure_if separate begin fun () ->
     let ty_arg, ty_res =
       try filter_arrow env (instance ty_expected) arg_label
       with Filter_arrow_failed err ->
@@ -4492,7 +4635,7 @@ and split_function_ty env ty_expected ~arg_label ~first ~in_function =
         type_option tv
       else ty_arg
     in
-    (ty_arg, ty_res), [ ty_arg; ty_res ]
+    (ty_arg, ty_res)
   end
 
 (* Typecheck parameters one at a time followed by the body. Later parameters
@@ -4535,7 +4678,7 @@ and type_function
   | { pparam_desc = Pparam_newtype newtype; pparam_loc = _ } :: rest ->
       (* Check everything else in the scope of (type a). *)
       let (params, body, newtypes, contains_gadt), exp_type =
-        type_newtype loc env newtype.txt (fun env ->
+        type_newtype env newtype (fun env ->
           let exp_type, params, body, newtypes, contains_gadt =
             (* mimic the typing of Pexp_newtype by minting a new type var,
               like [type_exp].
@@ -4589,7 +4732,7 @@ and type_function
           (* We don't make use of [case_data] here so we pass unit. *)
           [ { pattern = pat; has_guard = false; needs_refute = false }, () ]
           ~type_body:begin
-            fun () pat ~ext_env ~ty_expected ~ty_infer:_
+            fun () pat ~when_env:_ ~ext_env ~cont:_ ~ty_expected ~ty_infer:_
               ~contains_gadt:param_contains_gadt ->
               let _, params, body, newtypes, suffix_contains_gadt =
                 type_function ext_env rest body_constraint body
@@ -4685,7 +4828,7 @@ and type_function
                     [type_argument] on the cases, and discard the cases'
                     inferred type in favor of the constrained type. (Function
                     cases aren't inferred, so [type_argument] would just call
-                    [type_expect] straightaway, so we do the same here.)
+                    [type_expect] straight away, so we do the same here.)
                   - [type_without_constraint]: If there is just a coercion and
                     no constraint, call [type_exp] on the cases and surface the
                     cases' inferred type to [type_constraint_expect]. *)
@@ -4724,7 +4867,7 @@ and type_function
 
 and type_label_access env srecord usage lid =
   let record =
-    with_local_level_if_principal ~post:generalize_structure_exp
+    with_local_level_generalize_structure_if_principal
       (fun () -> type_exp ~recarg:Allowed env srecord)
   in
   let ty_exp = record.exp_type in
@@ -4767,7 +4910,9 @@ and type_format loc str env =
           | [ 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_cst cst =
+        mk_exp_loc (Pexp_constant {pconst_desc = cst; pconst_loc = loc})
+      in
       let mk_int n = mk_cst (Pconst_integer (Int.to_string n, None))
       and mk_string str = mk_cst (Pconst_string (str, loc, None))
       and mk_char chr = mk_cst (Pconst_char chr) in
@@ -4993,22 +5138,15 @@ and type_label_exp create env loc ty_expected
           (lid, label, sarg) =
   (* Here also ty_expected may be at generic_level *)
   let separate = !Clflags.principal || Env.has_local_constraints env in
-  (* #4682: we try two type-checking approaches for [arg] using backtracking:
-     - first try: we try with [ty_arg] as expected type;
-     - second try; if that fails, we backtrack and try without
-  *)
-  let (vars, ty_arg, snap, arg) =
-    (* try the first approach *)
-    with_local_level begin fun () ->
+  let is_poly = label_is_poly label in
+  let (vars, arg) =
+    (* raise level to check univars *)
+    with_local_level_generalize_if is_poly begin fun () ->
       let (vars, ty_arg) =
-        with_local_level_iter_if separate begin fun () ->
+        with_local_level_generalize_structure_if separate begin fun () ->
           let (vars, ty_arg, ty_res) =
-            with_local_level_iter_if separate ~post:generalize_structure
-              begin fun () ->
-                let ((_, ty_arg, ty_res) as r) =
-                  instance_label ~fixed:true label in
-                (r, [ty_arg; ty_res])
-              end
+            with_local_level_generalize_structure_if separate
+              (fun () -> instance_label ~fixed:true label)
           in
           begin try
             unify env (instance ty_res) (instance ty_expected)
@@ -5017,9 +5155,8 @@ and type_label_exp create env loc ty_expected
           end;
           (* Instantiate so that we can generalize internal nodes *)
           let ty_arg = instance ty_arg in
-          ((vars, ty_arg), [ty_arg])
+          (vars, ty_arg)
         end
-        ~post:generalize_structure
       in
 
       if label.lbl_private = Private then
@@ -5027,45 +5164,12 @@ and type_label_exp create env loc ty_expected
           raise (Error(loc, env, Private_type ty_expected))
         else
           raise (Error(lid.loc, env, Private_label(lid.txt, ty_expected)));
-      let snap = if vars = [] then None else Some (Btype.snapshot ()) in
-      let arg = type_argument env sarg ty_arg (instance ty_arg) in
-      (vars, ty_arg, snap, arg)
+      (vars, type_argument env sarg ty_arg (instance ty_arg))
     end
-    (* Note: there is no generalization logic here as could be expected,
-       because it is part of the backtracking logic below. *)
-  in
-  let arg =
-    try
-      if (vars = []) then arg
-      else begin
-        (* We detect if the first try failed here,
-           during generalization. *)
-        if maybe_expansive arg then
-          lower_contravariant env arg.exp_type;
-        generalize_and_check_univars env "field value" arg label.lbl_arg vars;
-        {arg with exp_type = instance arg.exp_type}
-      end
-    with first_try_exn when maybe_expansive arg -> try
-      (* backtrack and try the second approach *)
-      Option.iter Btype.backtrack snap;
-      let arg = with_local_level (fun () -> type_exp env sarg)
-          ~post:(fun arg -> lower_contravariant env arg.exp_type)
-      in
-      let arg =
-        with_local_level begin fun () ->
-          let arg = {arg with exp_type = instance arg.exp_type} in
-          unify_exp env arg (instance ty_arg);
-          arg
-        end
-        ~post: begin fun arg ->
-          generalize_and_check_univars env "field value" arg label.lbl_arg vars
-        end
-      in
-      {arg with exp_type = instance arg.exp_type}
-    with Error (_, _, Less_general _) as e -> raise e
-    | _ -> raise first_try_exn
+    ~before_generalize:(fun (_,arg) -> may_lower_contravariant env arg)
   in
-  (lid, label, arg)
+  if is_poly then check_univars env "field value" arg label.lbl_arg vars;
+  (lid, label, {arg with exp_type = instance arg.exp_type})
 
 and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
   (* ty_expected' may be generic *)
@@ -5093,7 +5197,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
       (* apply optional arguments when expected type is "" *)
       (* we must be very careful about not breaking the semantics *)
       let texp =
-        with_local_level_if_principal ~post:generalize_structure_exp
+        with_local_level_generalize_structure_if_principal
           (fun () -> type_exp env sarg)
       in
       let rec make_args args ty_fun =
@@ -5109,7 +5213,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
       let args, ty_fun', simple_res = make_args [] texp.exp_type
       and texp = {texp with exp_type = instance texp.exp_type} in
       if not (simple_res || safe_expect) then begin
-        unify_exp env texp ty_expected;
+        unify_exp ~sexp:sarg env texp ty_expected;
         texp
       end else begin
       let warn = !Clflags.principal &&
@@ -5120,7 +5224,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
           Tarrow(Nolabel,ty_arg,ty_res,_) -> ty_arg, ty_res
         | _ -> assert false
       in
-      unify_exp env {texp with exp_type = ty_fun} ty_expected;
+      unify_exp ~sexp:sarg env {texp with exp_type = ty_fun} ty_expected;
       if args = [] then texp else
       (* eta-expand to avoid side effects *)
       let var_pair name ty =
@@ -5129,7 +5233,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
           { val_type = ty; val_kind = Val_reg;
             val_attributes = [];
             val_loc = Location.none;
-            val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+            val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
           }
         in
         let exp_env = Env.add_value id desc env in
@@ -5165,7 +5269,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
       in
       Location.prerr_warning texp.exp_loc
         (Warnings.Eliminated_optional_arguments
-           (List.map (fun (l, _) -> Printtyp.string_of_label l) args));
+           (List.map (fun (l, _) -> Asttypes.string_of_label l) args));
       if warn then Location.prerr_warning texp.exp_loc
           (Warnings.Non_principal_labels "eliminated optional argument");
       (* let-expand to have side effects *)
@@ -5180,7 +5284,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
   | None ->
       let texp = type_expect ?recarg env sarg
         (mk_expected ?explanation ty_expected') in
-      unify_exp env texp ty_expected;
+      unify_exp ~sexp:sarg env texp ty_expected;
       texp
 
 and type_application env funct sargs =
@@ -5245,7 +5349,7 @@ and type_application env funct sargs =
     let arg () =
       let arg = type_expect env sarg (mk_expected ty_arg) in
       if is_optional lbl then
-        unify_exp env arg (type_option(newvar()));
+        unify_exp ~sexp:sarg env arg (type_option(newvar()));
       arg
     in
     (ty_res, (lbl, Some (arg, Some sarg.pexp_loc)) :: typed_args)
@@ -5262,7 +5366,7 @@ and type_application env funct sargs =
       (Location.prerr_warning
          funct.exp_loc
          (Warnings.Labels_omitted
-            (List.map Printtyp.string_of_label
+            (List.map Asttypes.string_of_label
                       (List.filter ((<>) Nolabel) labels)));
        true)
     end
@@ -5309,7 +5413,7 @@ and type_application env funct sargs =
             (fun () -> type_argument env sarg ty ty0)
           else begin
             may_warn sarg.pexp_loc
-              (Warnings.Not_principal "using an optional argument here");
+              (not_principal "using an optional argument here");
             (fun () -> option_some env (type_argument env sarg
                                           (extract_option_type env ty)
                                           (extract_option_type env ty0)))
@@ -5348,11 +5452,11 @@ and type_application env funct sargs =
             | Some (l', sarg, commuted, remaining_sargs) ->
                 if commuted then begin
                   may_warn sarg.pexp_loc
-                    (Warnings.Not_principal "commuting this argument")
+                    (not_principal "commuting this argument")
                 end;
                 if not optional && is_optional l' then
                   Location.prerr_warning sarg.pexp_loc
-                    (Warnings.Nonoptional_label (Printtyp.string_of_label l));
+                    (Warnings.Nonoptional_label (Asttypes.string_of_label l));
                 remaining_sargs, Some (use_arg sarg l', Some sarg.pexp_loc)
             | None ->
                 sargs,
@@ -5376,22 +5480,19 @@ and type_application env funct sargs =
     (try ignore (filter_arrow env (instance funct.exp_type) Nolabel); true
      with Filter_arrow_failed _ -> false)
   in
-  (* Extra scope to check for non-returning functions *)
-  with_local_level begin fun () ->
-    match sargs with
-    | (* Special case for ignore: avoid discarding warning *)
-      [Nolabel, sarg] when is_ignore funct ->
-        let ty_arg, ty_res =
-          filter_arrow env (instance funct.exp_type) Nolabel in
-        let exp = type_expect env sarg (mk_expected ty_arg) in
-        check_partial_application ~statement:false exp;
-        ([Nolabel, Some exp], ty_res)
-    | _ ->
-        let ty = funct.exp_type in
-        type_args [] ty (instance ty) sargs
-  end
+  match sargs with
+  | (* Special case for ignore: avoid discarding warning *)
+    [Nolabel, sarg] when is_ignore funct ->
+      let ty_arg, ty_res =
+        filter_arrow env (instance funct.exp_type) Nolabel in
+      let exp = type_expect env sarg (mk_expected ty_arg) in
+      check_partial_application ~statement:false exp;
+      ([Nolabel, Some exp], ty_res)
+  | _ ->
+      let ty = funct.exp_type in
+      type_args [] ty (instance ty) sargs
 
-and type_construct env loc lid sarg ty_expected_explained attrs =
+and type_construct env ~sexp lid sarg ty_expected_explained =
   let { ty = ty_expected; explanation } = ty_expected_explained in
   let expected_type =
     match extract_concrete_variant env ty_expected with
@@ -5402,7 +5503,7 @@ and type_construct env loc lid sarg ty_expected_explained attrs =
         let srt = wrong_kind_sort_of_constructor lid.txt in
         let ctx = Expression explanation in
         let error = Wrong_expected_kind(srt, ctx, ty_expected) in
-        raise (Error (loc, env, error))
+        raise (Error (sexp.pexp_loc, env, error))
   in
   let constrs =
     Env.lookup_all_constructors ~loc:lid.loc Env.Positive lid.txt env
@@ -5416,37 +5517,36 @@ and type_construct env loc lid sarg ty_expected_explained attrs =
     match sarg with
       None -> []
     | Some {pexp_desc = Pexp_tuple sel} when
-        constr.cstr_arity > 1 || Builtin_attributes.explicit_arity attrs
+        constr.cstr_arity > 1
+        || Builtin_attributes.explicit_arity sexp.pexp_attributes
       -> sel
     | Some se -> [se] in
   if List.length sargs <> constr.cstr_arity then
-    raise(Error(loc, env, Constructor_arity_mismatch
-                            (lid.txt, constr.cstr_arity, List.length sargs)));
+    raise(Error(sexp.pexp_loc, env,
+                Constructor_arity_mismatch
+                  (lid.txt, constr.cstr_arity, List.length sargs)));
   let separate = !Clflags.principal || Env.has_local_constraints env in
   let ty_args, ty_res, texp =
-    with_local_level_iter_if separate ~post:generalize_structure begin fun () ->
+    with_local_level_generalize_structure_if separate begin fun () ->
       let ty_args, ty_res, texp =
-        with_local_level_if separate begin fun () ->
+        with_local_level_generalize_structure_if separate begin fun () ->
           let (ty_args, ty_res, _) =
             instance_constructor Keep_existentials_flexible constr
           in
           let texp =
             re {
             exp_desc = Texp_construct(lid, constr, []);
-            exp_loc = loc; exp_extra = [];
+            exp_loc = sexp.pexp_loc; exp_extra = [];
             exp_type = ty_res;
-            exp_attributes = attrs;
+            exp_attributes = sexp.pexp_attributes;
             exp_env = env } in
           (ty_args, ty_res, texp)
         end
-        ~post: begin fun (_, ty_res, texp) ->
-          generalize_structure ty_res;
-          with_explanation explanation (fun () ->
-            unify_exp env {texp with exp_type = instance ty_res}
-              (instance ty_expected));
-        end
       in
-      ((ty_args, ty_res, texp), ty_res::ty_args)
+      with_explanation explanation (fun () ->
+        unify_exp ~sexp env {texp with exp_type = instance ty_res}
+          (instance ty_expected));
+      (ty_args, ty_res, texp)
     end
   in
   let ty_args0, ty_res =
@@ -5455,7 +5555,7 @@ and type_construct env loc lid sarg ty_expected_explained attrs =
     | _ -> assert false
   in
   let texp = {texp with exp_type = ty_res} in
-  if not separate then unify_exp env texp (instance ty_expected);
+  if not separate then unify_exp ~sexp env texp (instance ty_expected);
   let recarg =
     match constr.cstr_inlined with
     | None -> Rejected
@@ -5466,7 +5566,7 @@ and type_construct env loc lid sarg ty_expected_explained attrs =
             Pexp_record (_, (Some {pexp_desc = Pexp_ident _}| None))}] ->
         Required
       | _ ->
-        raise (Error(loc, env, Inlined_record_expected))
+        raise (Error(sexp.pexp_loc, env, Inlined_record_expected))
       end
   in
   let args =
@@ -5475,9 +5575,9 @@ and type_construct env loc lid sarg ty_expected_explained attrs =
   if constr.cstr_private = Private then
     begin match constr.cstr_tag with
     | Cstr_extension _ ->
-        raise(Error(loc, env, Private_constructor (constr, ty_res)))
+        raise(Error(sexp.pexp_loc, env, Private_constructor (constr, ty_res)))
     | Cstr_constant _ | Cstr_block _ | Cstr_unboxed ->
-        raise (Error(loc, env, Private_type ty_res));
+        raise (Error(sexp.pexp_loc, env, Private_type ty_res));
     end;
   (* NOTE: shouldn't we call "re" on this final expression? -- AF *)
   { texp with
@@ -5501,24 +5601,24 @@ and type_statement ?explanation env sexp =
     | _ -> false
   in
   (* Raise the current level to detect non-returning functions *)
-  let exp = with_local_level (fun () -> type_exp env sexp) in
-  let subexp = final_subexpression exp in
-  let ty = expand_head env exp.exp_type in
-  if is_Tvar ty
-     && get_level ty > get_current_level ()
-     && not (allow_polymorphic subexp) then
-    Location.prerr_warning
-      subexp.exp_loc
-      Warnings.Nonreturning_statement;
-  if !Clflags.strict_sequence then
-    let expected_ty = instance Predef.type_unit in
-    with_explanation explanation (fun () ->
-      unify_exp env exp expected_ty);
-    exp
-  else begin
-    check_partial_application ~statement:true exp;
-    enforce_current_level env ty;
-    exp
+  with_local_level_generalize (fun () -> type_exp env sexp)
+  ~before_generalize: begin fun exp ->
+    let subexp = final_subexpression exp in
+    let ty = expand_head env exp.exp_type in
+    if is_Tvar ty
+    && get_level ty > get_current_level ()
+    && not (allow_polymorphic subexp) then
+      Location.prerr_warning
+        subexp.exp_loc
+        Warnings.Nonreturning_statement;
+    if !Clflags.strict_sequence then
+      let expected_ty = instance Predef.type_unit in
+      with_explanation explanation (fun () ->
+        unify_exp ~sexp env exp expected_ty)
+    else begin
+      check_partial_application ~statement:true exp;
+      enforce_current_level env ty
+    end
   end
 
 (* Most of the arguments are the same as [type_cases].
@@ -5535,20 +5635,22 @@ and type_statement ?explanation env sexp =
 *)
 and map_half_typed_cases
   : type k ret case_data.
-    ?additional_checks_for_split_cases:((_ * ret) list -> unit)
+    ?additional_checks_for_split_cases:((_ * ret) list -> unit) -> ?conts:_
     -> k pattern_category -> _ -> _ -> _ -> _
     -> (untyped_case * case_data) list
     -> type_body:(
         case_data
         -> k general_pattern (* the typed pattern *)
-        -> ext_env:_ (* environment with module variables / pattern variables *)
+        -> when_env:_ (* environment with module/pattern variables *)
+        -> ext_env:_ (* when_env + continuation var*)
+        -> cont:_
         -> ty_expected:_ (* type to check body in scope of *)
         -> ty_infer:_ (* type to infer for body *)
         -> contains_gadt:_ (* whether the pattern contains a GADT *)
         -> ret)
     -> check_if_total:bool (* if false, assume Partial right away *)
     -> ret list * partial
-  = fun ?additional_checks_for_split_cases
+  = fun ?additional_checks_for_split_cases ?conts
     category env ty_arg ty_res loc caselist ~type_body ~check_if_total ->
   (* ty_arg is _fully_ generalized *)
   let patterns = List.map (fun ((x : untyped_case), _) -> x.pattern) caselist in
@@ -5559,7 +5661,7 @@ and map_half_typed_cases
   let create_inner_level = may_contain_gadts || may_contain_modules in
   let ty_arg =
     if (may_contain_gadts || erase_either) && not !Clflags.principal
-    then correct_levels ty_arg else ty_arg
+    then duplicate_type ty_arg else ty_arg
   in
   let rec is_var spat =
     match spat.ppat_desc with
@@ -5589,24 +5691,29 @@ and map_half_typed_cases
     if erase_either
     then Some false else None
   in
+  let map_conts f conts caselist = match conts with
+    | None -> List.map (fun c -> f c None) caselist
+    | Some conts -> List.map2 f caselist conts
+  in
   let half_typed_cases, ty_res, do_copy_types, ty_arg' =
    (* propagation of the argument *)
-    with_local_level begin fun () ->
+    with_local_level_generalize begin fun () ->
       let pattern_force = ref [] in
       (*  Format.printf "@[%i %i@ %a@]@." lev (get_current_level())
           Printtyp.raw_type_expr ty_arg; *)
       let half_typed_cases =
-        List.map
-        (fun ({ Parmatch.pattern; _ } as untyped_case, case_data) ->
+        map_conts
+        (fun ({ Parmatch.pattern; _ } as untyped_case, case_data) cont ->
           let htc =
-            with_local_level_if_principal begin fun () ->
+            with_local_level_generalize_structure_if_principal begin fun () ->
               let ty_arg =
                 (* propagation of pattern *)
-                with_local_level ~post:generalize_structure
+                with_local_level_generalize_structure
                   (fun () -> instance ?partial:take_partial_instance ty_arg)
               in
               let (pat, ext_env, force, pvs, mvs) =
-                type_pattern category ~lev env pattern ty_arg allow_modules
+                type_pattern ?cont category ~lev env pattern ty_arg
+                  allow_modules
               in
               pattern_force := force @ !pattern_force;
               { typed_pat = pat;
@@ -5619,9 +5726,6 @@ and map_half_typed_cases
                 contains_gadt = contains_gadt (as_comp_pattern category pat);
               }
             end
-            ~post: begin fun htc ->
-              iter_pattern_variables_type generalize_structure htc.pat_vars;
-            end
           in
           (* Ensure that no ambivalent pattern type escapes its branch *)
           check_scope_escape htc.typed_pat.pat_loc env outer_level
@@ -5629,7 +5733,7 @@ and map_half_typed_cases
           let pat = htc.typed_pat in
           {htc with typed_pat = { pat with pat_type = instance pat.pat_type }}
         )
-        caselist in
+        conts caselist in
       let patl =
         List.map (fun { typed_pat; _ } -> typed_pat) half_typed_cases in
       let does_contain_gadt =
@@ -5637,7 +5741,7 @@ and map_half_typed_cases
       in
       let ty_res, do_copy_types =
         if does_contain_gadt && not !Clflags.principal then
-          correct_levels ty_res, Env.make_copy_of_types env
+          duplicate_type ty_res, Env.make_copy_of_types env
         else ty_res, (fun env -> env)
       in
       (* Unify all cases (delayed to keep it order-free) *)
@@ -5663,20 +5767,15 @@ and map_half_typed_cases
       ) half_typed_cases;
       (half_typed_cases, ty_res, do_copy_types, ty_arg')
     end
-    ~post: begin fun (half_typed_cases, _, _, ty_arg') ->
-      generalize ty_arg';
-      List.iter (fun { pat_vars; _ } ->
-        iter_pattern_variables_type generalize pat_vars
-      ) half_typed_cases
-    end
   in
   (* type bodies *)
   let ty_res' = instance ty_res in
+  (* Why is it needed to keep the level of result raised ?  *)
   let result = with_local_level_if_principal ~post:ignore begin fun () ->
-    List.map
+    map_conts
     (fun { typed_pat = pat; branch_env = ext_env;
-            pat_vars = pvs; module_vars = mvs;
-            case_data; contains_gadt; _ }
+           pat_vars = pvs; module_vars = mvs;
+           case_data; contains_gadt; _ } cont
         ->
         let ext_env =
           if contains_gadt then
@@ -5688,21 +5787,24 @@ and map_half_typed_cases
            branch environments by adding the variables (and module variables)
            from the patterns.
         *)
-        let ext_env =
-          add_pattern_variables ext_env pvs
+        let cont_vars, pvs =
+          List.partition (fun pv -> pv.pv_kind = Continuation_var) pvs in
+        let add_pattern_vars = add_pattern_variables
             ~check:(fun s -> Warnings.Unused_var_strict s)
             ~check_as:(fun s -> Warnings.Unused_var s)
         in
-        let ext_env = add_module_variables ext_env mvs in
+        let when_env = add_pattern_vars ext_env pvs in
+        let when_env = add_module_variables when_env mvs in
+        let ext_env = add_pattern_vars when_env cont_vars in
         let ty_expected =
           if contains_gadt && not !Clflags.principal then
             (* Take a generic copy of [ty_res] again to allow propagation of
                 type information from preceding branches *)
-            correct_levels ty_res
+            duplicate_type ty_res
           else ty_res in
-        type_body case_data pat ~ext_env ~ty_expected ~ty_infer:ty_res'
-          ~contains_gadt)
-    half_typed_cases
+        type_body case_data pat ~when_env ~ext_env ~cont ~ty_expected
+          ~ty_infer:ty_res' ~contains_gadt)
+    conts half_typed_cases
   end in
   let do_init = may_contain_gadts || needs_exhaust_check in
   let ty_arg_check =
@@ -5773,11 +5875,11 @@ and map_half_typed_cases
 
 (* Typing of match cases *)
 and type_cases
-    : type k . k pattern_category ->
-           _ -> _ -> _ -> check_if_total:bool -> _ -> Parsetree.case list ->
-           k case list * partial
+    : type k . k pattern_category -> _ -> _ -> _ -> ?conts:_ ->
+               check_if_total:bool -> _ -> Parsetree.case list ->
+               k case list * partial
   = fun category env
-        ty_arg ty_res_explained ~check_if_total loc caselist ->
+        ty_arg ty_res_explained ?conts ~check_if_total loc caselist ->
   let { ty = ty_res; explanation } = ty_res_explained in
   let caselist =
     List.map (fun case -> Parmatch.untyped_case case, case) caselist
@@ -5786,16 +5888,24 @@ and type_cases
      is to typecheck the guards and the cases, and then to check for some
      warnings that can fire in the presence of guards.
   *)
-  map_half_typed_cases category env ty_arg ty_res loc caselist ~check_if_total
+  map_half_typed_cases ?conts category env ty_arg ty_res loc caselist
+    ~check_if_total
     ~type_body:begin
-      fun { pc_guard; pc_rhs } pat ~ext_env ~ty_expected ~ty_infer
-          ~contains_gadt:_ ->
+      fun { pc_guard; pc_rhs } pat ~when_env ~ext_env ~cont ~ty_expected
+        ~ty_infer ~contains_gadt:_ ->
+        let cont = Option.map (fun (id,_) -> id) cont in
         let guard =
           match pc_guard with
           | None -> None
           | Some scond ->
+            (* It is crucial that the continuation is not used in the
+               `when' expression as the extent of the continuation is
+               yet to be determined. We make the continuation
+               inaccessible by typing the `when' expression using the
+               environment `ext_env' which does not bind the
+               continuation variable. *)
             Some
-              (type_expect ext_env scond
+              (type_expect when_env scond
                 (mk_expected ~explanation:When_guard Predef.type_bool))
         in
         let exp =
@@ -5803,6 +5913,7 @@ and type_cases
         in
         {
           c_lhs = pat;
+          c_cont = cont;
           c_guard = guard;
           c_rhs = {exp with exp_type = ty_infer}
         }
@@ -5840,6 +5951,33 @@ and type_function_cases_expect
     cases, partial, ty_fun
   end
 
+and type_effect_cases
+    : type k . k pattern_category -> _ -> _ -> _ -> Parsetree.case list -> _
+               -> k case list
+  = fun category env ty_res_explained loc caselist conts ->
+      let { ty = ty_res; explanation = _ } = ty_res_explained in
+      let _ = newvar () in
+      (* remember original level *)
+      with_local_level begin fun () ->
+        (* Create a locally type abstract type for effect type. *)
+        let new_env, ty_arg, ty_cont =
+          let decl = Ctype.new_local_type ~loc Definition in
+          let scope = create_scope () in
+          let name = Ctype.get_new_abstract_name env "%eff" in
+          let id = Ident.create_scoped ~scope name in
+          let new_env = Env.add_type ~check:false id decl env in
+          let ty_eff = newgenty (Tconstr (Path.Pident id,[],ref Mnil)) in
+          new_env,
+          Predef.type_eff ty_eff,
+          Predef.type_continuation ty_eff ty_res
+        in
+        let conts = List.map (type_continuation_pat env ty_cont) conts in
+        let cases, _ = type_cases category new_env ty_arg
+          ty_res_explained ~conts ~check_if_total:false loc caselist
+        in
+          cases
+        end
+
 (* Typing of let bindings *)
 
 and type_let ?check ?check_strict
@@ -5848,11 +5986,11 @@ and type_let ?check ?check_strict
   let attrs_list = List.map fst spatl in
   let is_recursive = (rec_flag = Recursive) in
 
-  let (pat_list, exp_list, new_env, mvs, _pvs) =
-    with_local_level begin fun () ->
+  let (pat_list, exp_list, new_env, mvs) =
+    with_local_level_generalize begin fun () ->
       if existential_context = At_toplevel then Typetexp.TyVarEnv.reset ();
       let (pat_list, new_env, force, pvs, mvs) =
-        with_local_level_if_principal begin fun () ->
+        with_local_level_generalize_structure_if_principal begin fun () ->
           let nvs = List.map (fun _ -> newvar ()) spatl in
           let (pat_list, _new_env, _force, _pvs, _mvs as res) =
             type_pattern_list
@@ -5882,11 +6020,6 @@ and type_let ?check ?check_strict
             pat_list;
           res
         end
-        ~post: begin fun (pat_list, _, _, pvs, _) ->
-          (* Generalize the structure *)
-          iter_pattern_variables_type generalize_structure pvs;
-          List.iter (fun pat -> generalize_structure pat.pat_type) pat_list
-        end
       in
       (* Note [add_module_variables after checking expressions]
          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -5923,8 +6056,7 @@ and type_let ?check ?check_strict
             match get_desc pat.pat_type with
             | Tpoly (ty, tl) ->
                 let vars, ty' =
-                  with_local_level_if_principal
-                    ~post:(fun (_,ty') -> generalize_structure ty')
+                  with_local_level_generalize_structure_if_principal
                     (fun () -> instance_poly ~keep_names:true ~fixed:true tl ty)
                 in
                 let exp =
@@ -5950,37 +6082,21 @@ and type_let ?check ?check_strict
         )
         pat_list
         (List.map2 (fun (attrs, _) (e, _) -> attrs, e) spatl exp_list);
-      (pat_list, exp_list, new_env, mvs,
-       List.map (fun pv -> { pv with pv_type = instance pv.pv_type}) pvs)
+      (pat_list, exp_list, new_env, mvs)
     end
-    ~post: begin fun (pat_list, exp_list, _, _, pvs) ->
-      List.iter2
-        (fun pat (exp, _) ->
-          if maybe_expansive exp then lower_contravariant env pat.pat_type)
-        pat_list exp_list;
-      iter_pattern_variables_type generalize pvs;
-      List.iter2
-        (fun pat (exp, vars) ->
-          match vars with
-          | None ->
-          (* We generalize expressions even if they are not bound to a variable
-             and do not have an expliclit polymorphic type annotation.  This is
-             not needed in general, however those types may be shown by the
-             interactive toplevel, for example:
-             {[
-               let _ = Array.get;;
-               - : 'a array -> int -> 'a = <fun>
-             ]}
-             so we do it anyway. *)
-              generalize exp.exp_type
-          | Some vars ->
-              if maybe_expansive exp then
-                lower_contravariant env exp.exp_type;
-              generalize_and_check_univars env "definition"
-                exp pat.pat_type vars)
+    ~before_generalize: begin fun (pat_list, exp_list, _, _) ->
+      List.iter2 (fun pat (exp, vars) ->
+        if maybe_expansive exp then begin
+          lower_contravariant env pat.pat_type;
+          if vars <> None then lower_contravariant env exp.exp_type
+        end)
         pat_list exp_list
     end
   in
+  List.iter2
+    (fun pat (exp, vars) ->
+      Option.iter (check_univars env "definition" exp pat.pat_type) vars)
+    pat_list exp_list;
   let l = List.combine pat_list exp_list in
   let l =
     List.map2
@@ -6135,7 +6251,7 @@ and type_andops env sarg sands expected_ty =
     | [] -> type_expect env let_sarg (mk_expected expected_ty), []
     | { pbop_op = sop; pbop_exp = sexp; pbop_loc = loc; _ } :: rest ->
         let op_path, op_desc, op_type, ty_arg, ty_rest, ty_result =
-          with_local_level_iter_if_principal begin fun () ->
+          with_local_level_generalize_structure_if_principal begin fun () ->
             let op_path, op_desc = type_binding_op_ident env sop in
             let op_type = instance op_desc.val_type in
             let ty_arg = newvar () in
@@ -6150,10 +6266,8 @@ and type_andops env sarg sands expected_ty =
             with Unify err ->
               raise(Error(sop.loc, env, Andop_type_clash(sop.txt, err)))
             end;
-            ((op_path, op_desc, op_type, ty_arg, ty_rest, ty_result),
-             [ty_rest; ty_arg; ty_result])
+            (op_path, op_desc, op_type, ty_arg, ty_rest, ty_result)
           end
-          ~post:generalize_structure
         in
         let let_arg, rest = loop env let_sarg rest ty_rest in
         let exp = type_expect env sexp (mk_expected ty_arg) in
@@ -6279,11 +6393,11 @@ let type_let existential_ctx env rec_flag spat_sexp_list =
 
 let type_expression env sexp =
   let exp =
-    with_local_level begin fun () ->
+    with_local_level_generalize begin fun () ->
       Typetexp.TyVarEnv.reset();
       type_exp env sexp
     end
-    ~post:(may_lower_contravariant_then_generalize env)
+    ~before_generalize:(may_lower_contravariant env)
   in
   match sexp.pexp_desc with
     Pexp_ident lid ->
@@ -6303,9 +6417,12 @@ let spellcheck ppf unbound_name valid_names =
 let spellcheck_idents ppf unbound valid_idents =
   spellcheck ppf (Ident.name unbound) (List.map Ident.name valid_idents)
 
-open Format
+open Format_doc
+module Fmt = Format_doc
+module Printtyp = Printtyp.Doc
 
-let longident = Printtyp.longident
+let quoted_longident = Style.as_inline_code Pprintast.Doc.longident
+let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
 
 (* Returns the first diff of the trace *)
 let type_clash_of_trace trace =
@@ -6314,11 +6431,49 @@ let type_clash_of_trace trace =
     | _ -> None
   ))
 
+(** More precise denomination for type errors. Used by messages:
+
+    - [This <denom> ...]
+    - [The <denom> "foo" ...] *)
+let pp_exp_denom ppf pexp =
+  let d = pp_print_string ppf in
+  let d_expression = fprintf ppf "%a expression" Style.inline_code in
+  match pexp.pexp_desc with
+  | Pexp_constant _ -> d "constant"
+  | Pexp_ident _ -> d "value"
+  | Pexp_construct _ | Pexp_variant _ -> d "constructor"
+  | Pexp_field _ -> d "field access"
+  | Pexp_send _ -> d "method call"
+  | Pexp_while _ -> d_expression "while"
+  | Pexp_for _ -> d_expression "for"
+  | Pexp_ifthenelse _ -> d_expression "if-then-else"
+  | Pexp_match _ -> d_expression "match"
+  | Pexp_try _ -> d_expression "try-with"
+  | _ -> d "expression"
+
+(** Implements the "This expression" message, printing the expression if it
+    should be according to {!Parsetree.Doc.nominal_exp}. *)
+let report_this_pexp_has_type denom ppf exp =
+  let denom ppf =
+    match denom, exp with
+    | Some d, _ -> fprintf ppf "%s" d
+    | None, Some exp -> pp_exp_denom ppf exp
+    | None, None -> fprintf ppf "expression"
+  in
+  let nexp = Option.bind exp Pprintast.Doc.nominal_exp in
+  match nexp with
+  | Some nexp ->
+      fprintf ppf "The %t %a has type" denom (Style.as_inline_code pp_doc) nexp
+  | _ -> fprintf ppf "This %t has type" denom
+
+let report_this_texp_has_type denom ppf texp =
+  report_this_pexp_has_type denom ppf (Some (Untypeast.untype_expression texp))
+
 (* Hint on type error on integer literals
    To avoid confusion, it is disabled on float literals
    and when the expected type is `int` *)
 let report_literal_type_constraint expected_type const =
-  let const_str = match const with
+  let const_str = match const.pconst_desc with
     | Pconst_integer (s, _) -> Some s
     | _ -> None
   in
@@ -6333,7 +6488,7 @@ let report_literal_type_constraint expected_type const =
       Some '.'
     else None
   in
-  let pp_const ppf (c,s) = Format.fprintf ppf "%s%c" c s in
+  let pp_const ppf (c,s) = Fmt.fprintf ppf "%s%c" c s in
   match const_str, suffix with
   | Some c, Some s -> [
       Location.msg
@@ -6364,17 +6519,21 @@ let report_partial_application = function
 
 let report_expr_type_clash_hints exp diff =
   match exp with
-  | Some (Pexp_constant const) -> report_literal_type_constraint const diff
-  | Some (Pexp_apply _) -> report_partial_application diff
-  | _ -> []
+  | Some exp -> begin
+      match exp.pexp_desc with
+      | Pexp_constant const -> report_literal_type_constraint const diff
+      | Pexp_apply _ -> report_partial_application diff
+      | _ -> []
+    end
+  | None -> []
 
 let report_pattern_type_clash_hints pat diff =
   match pat with
   | Some (Ppat_constant const) -> report_literal_type_constraint const diff
   | _ -> []
 
-let report_type_expected_explanation expl ppf =
-  let because expl_str = fprintf ppf "@ because it is in %s" expl_str in
+let report_type_expected_explanation expl =
+  let because expl_str = doc_printf "@ because it is in %s" expl_str in
   match expl with
   | If_conditional ->
       because "the condition of an if-statement"
@@ -6397,25 +6556,18 @@ let report_type_expected_explanation expl ppf =
   | When_guard ->
       because "a when-guard"
 
-let report_type_expected_explanation_opt expl ppf =
+let report_type_expected_explanation_opt expl =
   match expl with
-  | None -> ()
-  | Some expl -> report_type_expected_explanation expl ppf
+  | None -> Format_doc.Doc.empty
+  | Some expl -> report_type_expected_explanation expl
 
 let report_unification_error ~loc ?sub env err
     ?type_expected_explanation txt1 txt2 =
   Location.error_of_printer ~loc ?sub (fun ppf () ->
-    Printtyp.report_unification_error ppf env err
+    Errortrace_report.unification ppf env err
       ?type_expected_explanation txt1 txt2
   ) ()
 
-let report_this_function ppf funct =
-  if Typedtree.exp_is_nominal funct then
-    let pexp = Untypeast.untype_expression funct in
-    Format.fprintf ppf "The function %a"
-      (Style.as_inline_code Pprintast.expression) pexp
-  else Format.fprintf ppf "This function"
-
 let report_too_many_arg_error ~funct ~func_ty ~previous_arg_loc
     ~extra_arg_loc ~returns_unit loc =
   let open Location in
@@ -6442,39 +6594,34 @@ let report_too_many_arg_error ~funct ~func_ty ~previous_arg_loc
     msg ~loc:extra_arg_loc "This extra argument is not expected.";
   ] in
   errorf ~loc:app_loc ~sub
-    "@[<v>@[<2>%a has type@ %a@]\
+    "@[<v>@[<2>%a@ %a@]\
      @ It is applied to too many arguments@]"
-    report_this_function funct Printtyp.type_expr func_ty
+    (report_this_texp_has_type (Some "function")) funct
+    Printtyp.type_expr func_ty
+
+let msg = Fmt.doc_printf
 
 let report_error ~loc env = function
   | Constructor_arity_mismatch(lid, expected, provided) ->
       Location.errorf ~loc
        "@[The constructor %a@ expects %i argument(s),@ \
         but is applied here to %i argument(s)@]"
-       (Style.as_inline_code longident) lid expected provided
+       quoted_constr lid expected provided
   | Label_mismatch(lid, err) ->
       report_unification_error ~loc env err
-        (function ppf ->
-           fprintf ppf "The record field %a@ belongs to the type"
-                   (Style.as_inline_code longident) lid)
-        (function ppf ->
-           fprintf ppf "but is mixed here with fields of type")
+        (msg "The record field %a@ belongs to the type" quoted_longident lid)
+        (msg "but is mixed here with fields of type")
   | Pattern_type_clash (err, pat) ->
       let diff = type_clash_of_trace err.trace in
       let sub = report_pattern_type_clash_hints pat diff in
       report_unification_error ~loc ~sub env err
-        (function ppf ->
-          fprintf ppf "This pattern matches values of type")
-        (function ppf ->
-          fprintf ppf "but a pattern was expected which matches values of \
-                       type");
+        (msg "This pattern matches values of type")
+        (msg "but a pattern was expected which matches values of type");
   | Or_pattern_type_clash (id, err) ->
       report_unification_error ~loc env err
-        (function ppf ->
-          fprintf ppf "The variable %a on the left-hand side of this \
+        (msg "The variable %a on the left-hand side of this \
                        or-pattern has type" Style.inline_code (Ident.name id))
-        (function ppf ->
-          fprintf ppf "but on the right-hand side it has type")
+        (msg "but on the right-hand side it has type")
   | Multiply_bound_variable name ->
       Location.errorf ~loc
         "Variable %a is bound several times in this matching"
@@ -6494,10 +6641,8 @@ let report_error ~loc env = function
       report_unification_error ~loc ~sub env err
         ~type_expected_explanation:
           (report_type_expected_explanation_opt explanation)
-        (function ppf ->
-           fprintf ppf "This expression has type")
-        (function ppf ->
-           fprintf ppf "but an expression was expected of type");
+        (msg "%a" (report_this_pexp_has_type None) exp)
+        (msg "but an expression was expected of type");
   | Function_arity_type_clash {
       syntactic_arity; type_constraint; trace = { trace };
     } ->
@@ -6583,7 +6728,7 @@ let report_error ~loc env = function
         print_labels labels
   | Label_not_mutable lid ->
       Location.errorf ~loc "The record field %a is not mutable"
-        (Style.as_inline_code longident) lid
+        quoted_longident lid
   | Wrong_name (eorp, ty_expected, { type_path; kind; name; valid_names; }) ->
       Location.error_of_printer ~loc (fun ppf () ->
         Printtyp.wrap_printing_env ~error:true env (fun () ->
@@ -6596,10 +6741,10 @@ let report_error ~loc env = function
               (Style.as_inline_code Printtyp.type_path) type_path;
           end else begin
             fprintf ppf
-              "@[@[<2>%s type@ %a%t@]@ \
+              "@[@[<2>%s type@ %a%a@]@ \
                There is no %s %a within type %a@]"
               eorp (Style.as_inline_code Printtyp.type_expr) ty
-              (report_type_expected_explanation_opt explanation)
+              pp_doc (report_type_expected_explanation_opt explanation)
               (Datatype_kind.label_name kind)
               Style.inline_code name.txt
               (Style.as_inline_code Printtyp.type_path) type_path;
@@ -6609,19 +6754,19 @@ let report_error ~loc env = function
   | Name_type_mismatch (kind, lid, tp, tpl) ->
       let type_name = Datatype_kind.type_name kind in
       let name = Datatype_kind.label_name kind in
+      let pr = match kind with
+        | Datatype_kind.Record -> quoted_longident
+        | Datatype_kind.Variant -> quoted_constr
+      in
       Location.error_of_printer ~loc (fun ppf () ->
-        Printtyp.report_ambiguous_type_error ppf env tp tpl
-          (function ppf ->
-             fprintf ppf "The %s %a@ belongs to the %s type"
-               name (Style.as_inline_code longident) lid
-              type_name)
-          (function ppf ->
-             fprintf ppf "The %s %a@ belongs to one of the following %s types:"
-               name (Style.as_inline_code longident) lid type_name)
-          (function ppf ->
-             fprintf ppf "but a %s was expected belonging to the %s type"
+        Errortrace_report.ambiguous_type ppf env tp tpl
+          (msg "The %s %a@ belongs to the %s type"
+               name pr lid type_name)
+          (msg "The %s %a@ belongs to one of the following %s types:"
+               name pr lid type_name)
+          (msg "but a %s was expected belonging to the %s type"
                name type_name)
-      ) ()
+        ) ()
   | Invalid_format msg ->
       Location.errorf ~loc "%s" msg
   | Not_an_object (ty, explanation) ->
@@ -6629,7 +6774,7 @@ let report_error ~loc env = function
       fprintf ppf "This expression is not an object;@ \
                    it has type %a"
         (Style.as_inline_code Printtyp.type_expr) ty;
-      report_type_expected_explanation_opt explanation ppf
+      pp_doc ppf @@ report_type_expected_explanation_opt explanation
     ) ()
   | Undefined_method (ty, me, valid_methods) ->
       Location.error_of_printer ~loc (fun ppf () ->
@@ -6651,7 +6796,7 @@ let report_error ~loc env = function
       ) ()
   | Virtual_class cl ->
       Location.errorf ~loc "Cannot instantiate the virtual class %a"
-        (Style.as_inline_code longident) cl
+        quoted_longident cl
   | Unbound_instance_variable (var, valid_vars) ->
       Location.error_of_printer ~loc (fun ppf () ->
         fprintf ppf "Unbound instance variable %a" Style.inline_code var;
@@ -6662,7 +6807,7 @@ let report_error ~loc env = function
         Style.inline_code v
   | Not_subtype err ->
       Location.error_of_printer ~loc (fun ppf () ->
-        Printtyp.Subtype.report_error ppf env err "is not a subtype of"
+        Errortrace_report.subtype ppf env err "is not a subtype of"
       ) ()
   | Outside_class ->
       Location.errorf ~loc
@@ -6673,14 +6818,15 @@ let report_error ~loc env = function
         Style.inline_code v
   | Coercion_failure (ty_exp, err, b) ->
       Location.error_of_printer ~loc (fun ppf () ->
-        Printtyp.report_unification_error ppf env err
-          (function ppf ->
-             let ty_exp = Printtyp.prepare_expansion ty_exp in
-             fprintf ppf "This expression cannot be coerced to type@;<1 2>%a;@ \
-                          it has type"
-             (Style.as_inline_code @@ Printtyp.type_expansion Type) ty_exp)
-          (function ppf ->
-             fprintf ppf "but is here used with type");
+          let intro =
+            let ty_exp = Out_type.prepare_expansion ty_exp in
+            doc_printf "This expression cannot be coerced to type@;<1 2>%a;@ \
+                        it has type"
+              (Style.as_inline_code @@ Printtyp.type_expansion Type) ty_exp
+          in
+        Errortrace_report.unification ppf env err
+          intro
+          (Fmt.doc_printf "but is here used with type");
         if b then
           fprintf ppf
             ".@.@[<hov>This simple coercion was not fully general.@ \
@@ -6691,15 +6837,15 @@ let report_error ~loc env = function
   | Not_a_function (ty, explanation) ->
       Location.errorf ~loc
         "This expression should not be a function,@ \
-         the expected type is@ %a%t"
+         the expected type is@ %a%a"
         (Style.as_inline_code Printtyp.type_expr) ty
-        (report_type_expected_explanation_opt explanation)
+        pp_doc (report_type_expected_explanation_opt explanation)
   | Too_many_arguments (ty, explanation) ->
       Location.errorf ~loc
         "This function expects too many arguments,@ \
-         it should have type@ %a%t"
+         it should have type@ %a%a"
         (Style.as_inline_code Printtyp.type_expr) ty
-        (report_type_expected_explanation_opt explanation)
+        pp_doc (report_type_expected_explanation_opt explanation)
   | Abstract_wrong_label {got; expected; expected_type; explanation} ->
       let label ~long ppf = function
         | Nolabel -> fprintf ppf "unlabeled"
@@ -6714,10 +6860,10 @@ let report_error ~loc env = function
         | _                       -> false
       in
       Location.errorf ~loc
-        "@[<v>@[<2>This function should have type@ %a%t@]@,\
+        "@[<v>@[<2>This function should have type@ %a%a@]@,\
          @[but its first argument is %a@ instead of %s%a@]@]"
         (Style.as_inline_code Printtyp.type_expr) expected_type
-        (report_type_expected_explanation_opt explanation)
+        pp_doc (report_type_expected_explanation_opt explanation)
         (label ~long:true) got
         (if second_long then "being " else "")
         (label ~long:second_long) expected
@@ -6733,7 +6879,7 @@ let report_error ~loc env = function
         (Style.as_inline_code Printtyp.type_expr) ty
   | Private_label (lid, ty) ->
       Location.errorf ~loc "Cannot assign field %a of the private type %a"
-        (Style.as_inline_code longident) lid
+        quoted_longident lid
         (Style.as_inline_code Printtyp.type_expr) ty
   | Private_constructor (constr, ty) ->
       Location.errorf ~loc
@@ -6742,7 +6888,7 @@ let report_error ~loc env = function
         (Style.as_inline_code Printtyp.type_expr) ty
   | Not_a_polymorphic_variant_type lid ->
       Location.errorf ~loc "The type %a@ is not a variant type"
-        (Style.as_inline_code longident) lid
+        quoted_longident lid
   | Incoherent_label_order ->
       Location.errorf ~loc
         "This function is applied to arguments@ \
@@ -6750,8 +6896,8 @@ let report_error ~loc env = function
         This is only allowed when the real type is known."
   | Less_general (kind, err) ->
       report_unification_error ~loc env err
-        (fun ppf -> fprintf ppf "This %s has type" kind)
-        (fun ppf -> fprintf ppf "which is less general than")
+        (Fmt.doc_printf "This %s has type" kind)
+        (Fmt.doc_printf "which is less general than")
   | Modules_not_allowed ->
       Location.errorf ~loc "Modules are not allowed in this pattern."
   | Cannot_infer_signature ->
@@ -6803,6 +6949,12 @@ let report_error ~loc env = function
       Location.errorf ~loc
         "@[Mixing value and exception patterns under when-guards is not \
          supported.@]"
+  | Effect_pattern_below_toplevel ->
+      Location.errorf ~loc
+        "@[Effect patterns must be at the top level of a match case.@]"
+  | Invalid_continuation_pattern ->
+      Location.errorf ~loc
+        "@[Invalid continuation pattern: only variables and _ are allowed .@]"
   | Inlined_record_escape ->
       Location.errorf ~loc
         "@[This form is not allowed as the type of the inlined record could \
@@ -6815,7 +6967,7 @@ let report_error ~loc env = function
         "@[%s@ %s@ @[%a@]@]"
         "This match case could not be refuted."
         "Here is an example of a value that would reach it:"
-        (Style.as_inline_code Printpat.pretty_val) pat
+        (Style.as_inline_code Printpat.top_pretty) pat
   | Invalid_extension_constructor_payload ->
       Location.errorf ~loc
         "Invalid %a payload, a constructor is expected."
@@ -6845,22 +6997,16 @@ let report_error ~loc env = function
         "This kind of recursive class expression is not allowed"
   | Letop_type_clash(name, err) ->
       report_unification_error ~loc env err
-        (function ppf ->
-          fprintf ppf "The operator %a has type" Style.inline_code name)
-        (function ppf ->
-          fprintf ppf "but it was expected to have type")
+        (msg "The operator %a has type" Style.inline_code name)
+        (msg "but it was expected to have type")
   | Andop_type_clash(name, err) ->
       report_unification_error ~loc env err
-        (function ppf ->
-          fprintf ppf "The operator %a has type" Style.inline_code name)
-        (function ppf ->
-          fprintf ppf "but it was expected to have type")
+        (msg "The operator %a has type" Style.inline_code name)
+        (msg "but it was expected to have type")
   | Bindings_type_clash(err) ->
       report_unification_error ~loc env err
-        (function ppf ->
-          fprintf ppf "These bindings have type")
-        (function ppf ->
-          fprintf ppf "but bindings were expected of type")
+        (Fmt.doc_printf "These bindings have type")
+        (Fmt.doc_printf  "but bindings were expected of type")
   | Unbound_existential (ids, ty) ->
       let pp_ident ppf id = pp_print_string ppf (Ident.name id) in
       let pp_type ppf (ids,ty)=
@@ -6872,6 +7018,20 @@ let report_error ~loc env = function
         "@[<2>%s:@ %a@]"
         "This type does not bind all existentials in the constructor"
         (Style.as_inline_code pp_type) (ids, ty)
+  | Bind_existential (reason, id, ty) ->
+      let reason1, reason2 = match reason with
+      | Bind_already_bound -> "the name", "that is already bound"
+      | Bind_not_in_scope -> "the name", "that was defined before"
+      | Bind_non_locally_abstract -> "the type",
+          "that is not a locally abstract type"
+      in
+      Location.errorf ~loc
+        "@[<hov0>The local name@ %a@ %s@ %s.@ %s@ %s@ %a@ %s.@]"
+        (Style.as_inline_code Printtyp.ident) id
+        "can only be given to an existential variable"
+        "introduced by this GADT constructor"
+        "The type annotation tries to bind it to"
+        reason1 (Style.as_inline_code Printtyp.type_expr) ty reason2
   | Missing_type_constraint ->
       Location.errorf ~loc
         "@[%s@ %s@]"
@@ -6893,9 +7053,9 @@ let report_error ~loc env = function
       in
       Location.errorf ~loc
         "This %s should not be a %s,@ \
-         the expected type is@ %a%t"
+         the expected type is@ %a%a"
         ctx sort (Style.as_inline_code Printtyp.type_expr) ty
-        (report_type_expected_explanation_opt explanation)
+        pp_doc (report_type_expected_explanation_opt explanation)
   | Expr_not_a_record_type ty ->
       Location.errorf ~loc
         "This expression has type %a@ \

diff --git a/typing/typecore.mli b/typing/typecore.mli
index 072acd3f6bb76e8709b0db781594af1bb51adad5..1b89ddd68ef602b1164206f8da752648428bad91 100644 (file)
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -49,12 +49,17 @@ type type_expected = private {
 }
 
 (* Variables in patterns *)
+type pattern_variable_kind =
+  | Std_var
+  | As_var
+  | Continuation_var
+
 type pattern_variable =
   {
     pv_id: Ident.t;
     pv_type: type_expr;
     pv_loc: Location.t;
-    pv_as_var: bool;
+    pv_kind: pattern_variable_kind;
     pv_attributes: Typedtree.attributes;
     pv_uid : Uid.t;
   }
@@ -134,7 +139,6 @@ val option_some: Env.t -> Typedtree.expression -> Typedtree.expression
 val option_none: Env.t -> type_expr -> Location.t -> Typedtree.expression
 val extract_option_type: Env.t -> type_expr -> type_expr
 val generalizable: int -> type_expr -> bool
-val generalize_structure_exp: Typedtree.expression -> unit
 val reset_delayed_checks: unit -> unit
 val force_delayed_checks: unit -> unit
 
@@ -143,6 +147,11 @@ val name_cases : string -> Typedtree.value Typedtree.case list -> Ident.t
 
 val self_coercion : (Path.t * Location.t list ref) list ref
 
+type existential_binding =
+  | Bind_already_bound
+  | Bind_not_in_scope
+  | Bind_non_locally_abstract
+
 type error =
   | Constructor_arity_mismatch of Longident.t * int * int
   | Label_mismatch of Longident.t * Errortrace.unification_error
@@ -154,7 +163,7 @@ type error =
   | Orpat_vars of Ident.t * Ident.t list
   | Expr_type_clash of
       Errortrace.unification_error * type_forcing_context option
-      * Parsetree.expression_desc option
+      * Parsetree.expression option
   | Function_arity_type_clash of
       { syntactic_arity :  int;
         type_constraint : type_expr;
@@ -210,6 +219,8 @@ type error =
   | No_value_clauses
   | Exception_pattern_disallowed
   | Mixed_value_and_exception_patterns_under_guard
+  | Effect_pattern_below_toplevel
+  | Invalid_continuation_pattern
   | Inlined_record_escape
   | Inlined_record_expected
   | Unrefuted_pattern of Typedtree.pattern
@@ -224,6 +235,7 @@ type error =
   | Andop_type_clash of string * Errortrace.unification_error
   | Bindings_type_clash of Errortrace.unification_error
   | Unbound_existential of Ident.t list * type_expr
+  | Bind_existential of existential_binding * Ident.t * type_expr
   | Missing_type_constraint
   | Wrong_expected_kind of wrong_kind_sort * wrong_kind_context * type_expr
   | Expr_not_a_record_type of type_expr

diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 2db34361d0958659ff5205af86a623f473a756ce..60bc6b937143689fa43d39495b62a74afc294f20 100644 (file)
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -119,7 +119,7 @@ let enter_type ?abstract_abbrevs rec_flag env sdecl (id, uid) =
   let abstract_source, type_manifest =
     match sdecl.ptype_manifest, abstract_abbrevs with
     | None, _             -> Definition, None
-    | Some _, None        -> Definition, Some (Btype.newgenvar ())
+    | Some _, None        -> Definition, Some (Ctype.newvar ())
     | Some _, Some reason -> reason, None
   in
   let decl =
@@ -231,7 +231,7 @@ let transl_labels env univars closed lbls =
          let cty = transl_simple_type env ?univars ~closed arg in
          {ld_id = Ident.create_local name.txt;
           ld_name = name;
-          ld_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+          ld_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
           ld_mutable = mut;
           ld_type = cty; ld_loc = loc; ld_attributes = attrs}
       )
@@ -276,8 +276,8 @@ let make_constructor env loc type_path type_params svars sargs sret_type =
       (* narrow and widen are now invoked through wrap_type_variable_scope *)
       TyVarEnv.with_local_scope begin fun () ->
       let closed = svars <> [] in
-      let targs, tret_type, args, ret_type, _univars =
-        Ctype.with_local_level_if closed begin fun () ->
+      let targs, tret_type, args, ret_type, univars =
+        Ctype.with_local_level_generalize_if closed begin fun () ->
           TyVarEnv.reset ();
           let univar_list =
             TyVarEnv.make_poly_univars (List.map (fun v -> v.txt) svars) in
@@ -306,15 +306,13 @@ let make_constructor env loc type_path type_params svars sargs sret_type =
           end;
           (targs, tret_type, args, ret_type, univar_list)
         end
-        ~post: begin fun (_, _, args, ret_type, univars) ->
-          Btype.iter_type_expr_cstr_args Ctype.generalize args;
-          Ctype.generalize ret_type;
-          let _vars = TyVarEnv.instance_poly_univars env loc univars in
-          let set_level t = Ctype.enforce_current_level env t in
-          Btype.iter_type_expr_cstr_args set_level args;
-          set_level ret_type;
-        end
       in
+      if closed then begin
+        ignore (TyVarEnv.instance_poly_univars env loc univars);
+        let set_level t = Ctype.enforce_current_level env t in
+        Btype.iter_type_expr_cstr_args set_level args;
+        set_level ret_type
+      end;
       targs, Some tret_type, args, Some ret_type
       end
 
@@ -341,7 +339,6 @@ let shape_map_cstrs =
 
 let transl_declaration env sdecl (id, uid) =
   (* Bind type parameters *)
-  Ctype.with_local_level begin fun () ->
   TyVarEnv.reset();
   let tparams = make_params env sdecl.ptype_params in
   let params = List.map (fun (cty, _) -> cty.ctyp_type) tparams in
@@ -425,7 +422,7 @@ let transl_declaration env sdecl (id, uid) =
           let tcstr =
             { cd_id = name;
               cd_name = scstr.pcd_name;
-              cd_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+              cd_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
               cd_vars = scstr.pcd_vars;
               cd_args = targs;
               cd_res = tret_type;
@@ -460,6 +457,7 @@ let transl_declaration env sdecl (id, uid) =
           Ttype_record lbls, Type_record(lbls', rep)
       | Ptype_open -> Ttype_open, Type_open
       in
+  begin
     let (tman, man) = match sdecl.ptype_manifest with
         None -> None, None
       | Some sty ->
@@ -526,16 +524,6 @@ let transl_declaration env sdecl (id, uid) =
     decl, typ_shape
   end
 
-(* Generalize a type declaration *)
-
-let generalize_decl decl =
-  List.iter Ctype.generalize decl.type_params;
-  Btype.iter_type_expr_kind Ctype.generalize decl.type_kind;
-  begin match decl.type_manifest with
-  | None    -> ()
-  | Some ty -> Ctype.generalize ty
-  end
-
 (* Check that all constraints are enforced *)
 
 module TypeSet = Btype.TypeSet
@@ -659,13 +647,21 @@ let check_coherence env loc dpath decl =
                 | exception Ctype.Equality err ->
                     Some (Includecore.Constraint err)
                 | () ->
+                    let subst =
+                      Subst.Unsafe.add_type_path dpath path Subst.identity in
+                    let decl =
+                      match Subst.Unsafe.type_declaration subst decl with
+                      | Ok decl -> decl
+                      | Error (Fcm_type_substituted_away _) ->
+                           (* no module type substitution in [subst] *)
+                          assert false
+                    in
                     Includecore.type_declarations ~loc ~equality:true env
                       ~mark:true
                       (Path.last path)
                       decl'
                       dpath
-                      (Subst.type_declaration
-                         (Subst.add_type_path dpath path Subst.identity) decl)
+                      decl
               end
             in
             if err <> None then
@@ -903,11 +899,8 @@ let check_well_founded_decl  ~abs_env env loc path decl to_check =
   let open Btype in
   (* We iterate on all subexpressions of the declaration to check
      "in depth" that no ill-founded type exists. *)
-  let it =
-    let checked =
-      (* [checked] remembers the types that the iterator already
-         checked, to avoid looping on cyclic types. *)
-      ref TypeSet.empty in
+  with_type_mark begin fun mark ->
+    let super = type_iterators mark in
     let visited =
       (* [visited] remembers the inner visits performed by
          [check_well_founded] on each type expression reachable from
@@ -915,14 +908,14 @@ let check_well_founded_decl  ~abs_env env loc path decl to_check =
          [check_well_founded] work when invoked on two parts of the
          type declaration that have common subexpressions. *)
       ref TypeMap.empty in
-    {type_iterators with it_type_expr =
-     (fun self ty ->
-       if TypeSet.mem ty !checked then () else begin
-         check_well_founded  ~abs_env env loc path to_check visited ty;
-         checked := TypeSet.add ty !checked;
-         self.it_do_type_expr self ty
-       end)} in
-  it.it_type_declaration it (Ctype.generic_instance_declaration decl)
+    let it =
+      {super with it_do_type_expr =
+       (fun self ty ->
+         check_well_founded ~abs_env env loc path to_check visited ty;
+         super.it_do_type_expr self ty
+       )} in
+    it.it_type_declaration it (Ctype.generic_instance_declaration decl)
+  end
 
 (* Check for non-regular abbreviations; an abbreviation
    [type 'a t = ...] is non-regular if the expansion of [...]
@@ -1043,10 +1036,10 @@ let name_recursion sdecl id decl =
   | { type_kind = Type_abstract _;
       type_manifest = Some ty;
       type_private = Private; } when is_fixed_type sdecl ->
-    let ty' = newty2 ~level:(get_level ty) (get_desc ty) in
+    let ty' = Btype.newty2 ~level:(get_level ty) (get_desc ty) in
     if Ctype.deep_occur ty ty' then
       let td = Tconstr(Path.Pident id, decl.type_params, ref Mnil) in
-      link_type ty (newty2 ~level:(get_level ty) td);
+      link_type ty (Btype.newty2 ~level:(get_level ty) td);
       {decl with type_manifest = Some ty'}
     else decl
   | _ -> decl
@@ -1069,6 +1062,23 @@ let check_redefined_unit (td: Parsetree.type_declaration) =
   | _ ->
       ()
 
+(* Update a temporary definition to share recursion *)
+let update_type temp_env env id loc =
+  let path = Path.Pident id in
+  let decl = Env.find_type path temp_env in
+  match decl.type_manifest with None -> ()
+  | Some ty ->
+      (* Since this function is called after generalizing declarations,
+         ty is at the generic level.  Since we need to keep possible
+         sharings in recursive type definitions, unify without instantiating,
+         but generalize again after unification. *)
+      Ctype.with_local_level_generalize begin fun () ->
+        let params = List.map (fun _ -> Ctype.newvar ()) decl.type_params in
+        try Ctype.unify env (Ctype.newconstr path params) ty
+        with Ctype.Unify err ->
+          raise (Error(loc, Type_clash (env, err)))
+      end
+
 let add_types_to_env decls shapes env =
   List.fold_right2
     (fun (id, decl) shape env ->
@@ -1101,14 +1111,14 @@ let transl_type_decl env rec_flag sdecl_list =
   let ids_list =
     List.map (fun sdecl ->
       Ident.create_scoped ~scope sdecl.ptype_name.txt,
-      Uid.mk ~current_unit:(Env.get_unit_name ())
+      Uid.mk ~current_unit:(Env.get_current_unit ())
     ) sdecl_list
   in
   (* Translate declarations, using a temporary environment where abbreviations
      expand to a generic type variable. After that, we check the coherence of
      the translated declarations in the resulting new environment. *)
-  let tdecls, decls, shapes, new_env =
-    Ctype.with_local_level_iter ~post:generalize_decl begin fun () ->
+  let tdecls, decls, shapes, temp_env, new_env =
+    Ctype.with_local_level_generalize begin fun () ->
       (* Enter types. *)
       let temp_env =
         List.fold_left2 (enter_type rec_flag) env sdecl_list ids_list in
@@ -1154,7 +1164,7 @@ let transl_type_decl env rec_flag sdecl_list =
       check_duplicates sdecl_list;
       (* Build the final env. *)
       let new_env = add_types_to_env decls shapes env in
-      ((tdecls, decls, shapes, new_env), List.map snd decls)
+      (tdecls, decls, shapes, temp_env, new_env)
     end
   in
   (* Check for ill-formed abbrevs *)
@@ -1184,6 +1194,15 @@ let transl_type_decl env rec_flag sdecl_list =
   List.iter (fun (tdecl, _shape) ->
     check_abbrev_regularity ~abs_env new_env id_loc_list to_check tdecl)
     tdecls;
+  (* Update temporary definitions (for well-founded recursive types) *)
+  begin match rec_flag with
+  | Asttypes.Nonrecursive -> ()
+  | Asttypes.Recursive ->
+      List.iter2
+        (fun (id, _) sdecl ->
+          update_type temp_env new_env id sdecl.ptype_loc)
+        ids_list sdecl_list
+  end;
   (* Check that all type variables are closed *)
   List.iter2
     (fun sdecl (tdecl, _shape) ->
@@ -1330,7 +1349,7 @@ let transl_extension_constructor ~scope env type_path type_params
       ext_private = priv;
       Types.ext_loc = sext.pext_loc;
       Types.ext_attributes = sext.pext_attributes;
-      ext_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+      ext_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
     }
   in
   let ext_cstrs =
@@ -1410,7 +1429,7 @@ let transl_type_extension extend env loc styext =
     (* Note: it would be incorrect to call [create_scope] *after*
        [TyVarEnv.reset] or after [with_local_level] (see #10010). *)
     let scope = Ctype.create_scope () in
-    Ctype.with_local_level begin fun () ->
+    Ctype.with_local_level_generalize begin fun () ->
       TyVarEnv.reset();
       let ttype_params = make_params env styext.ptyext_params in
       let type_params = List.map (fun (cty, _) -> cty.ctyp_type) ttype_params in
@@ -1424,15 +1443,6 @@ let transl_type_extension extend env loc styext =
       in
       (ttype_params, type_params, constructors)
     end
-    ~post: begin fun (_, type_params, constructors) ->
-      (* Generalize types *)
-      List.iter Ctype.generalize type_params;
-      List.iter
-        (fun (ext, _shape) ->
-          Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args;
-          Option.iter Ctype.generalize ext.ext_type.ext_ret_type)
-        constructors;
-    end
   in
   (* Check that all type variables are closed *)
   List.iter
@@ -1482,15 +1492,11 @@ let transl_type_extension extend env loc styext =
 let transl_exception env sext =
   let ext, shape =
     let scope = Ctype.create_scope () in
-    Ctype.with_local_level
+    Ctype.with_local_level_generalize
       (fun () ->
         TyVarEnv.reset();
         transl_extension_constructor ~scope env
           Predef.path_exn [] [] Asttypes.Public sext)
-      ~post: begin fun (ext, _shape) ->
-        Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args;
-        Option.iter Ctype.generalize ext.ext_type.ext_ret_type;
-      end
   in
   (* Check that all type variables are closed *)
   begin match Ctype.closed_extension_constructor ext.ext_type with
@@ -1629,7 +1635,7 @@ let transl_value_decl env loc valdecl =
     [] when Env.is_in_signature env ->
       { val_type = ty; val_kind = Val_reg; Types.val_loc = loc;
         val_attributes = valdecl.pval_attributes;
-        val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+        val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
       }
   | [] ->
       raise (Error(valdecl.pval_loc, Val_in_structure))
@@ -1659,7 +1665,7 @@ let transl_value_decl env loc valdecl =
       check_unboxable env loc ty;
       { val_type = ty; val_kind = Val_prim prim; Types.val_loc = loc;
         val_attributes = valdecl.pval_attributes;
-        val_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+        val_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
       }
   in
   let (id, newenv) =
@@ -1697,7 +1703,7 @@ let transl_value_decl env loc valdecl =
 let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env
     sdecl =
   Env.mark_type_used sig_decl.type_uid;
-  Ctype.with_local_level begin fun () ->
+  Ctype.with_local_level_generalize begin fun () ->
   TyVarEnv.reset();
   (* In the first part of this function, we typecheck the syntactic
      declaration [sdecl] in the outer environment [outer_env]. *)
@@ -1775,7 +1781,7 @@ let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env
       type_attributes = sdecl.ptype_attributes;
       type_immediate = Unknown;
       type_unboxed_default;
-      type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+      type_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
     }
   in
   Option.iter (fun p -> set_private_row env sdecl.ptype_loc p new_sig_decl)
@@ -1832,7 +1838,6 @@ let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env
     typ_attributes = sdecl.ptype_attributes;
   }
   end
-  ~post:(fun ttyp -> generalize_decl ttyp.typ_type)
 
 (* A simplified version of [transl_with_constraint], for the case of packages.
    Package constraints are much simpler than normal with type constraints (e.g.,
@@ -1852,7 +1857,7 @@ let transl_package_constraint ~loc env ty =
       type_attributes = [];
       type_immediate = Unknown;
       type_unboxed_default = false;
-      type_uid = Uid.mk ~current_unit:(Env.get_unit_name ())
+      type_uid = Uid.mk ~current_unit:(Env.get_current_unit ())
     }
   in
   let new_type_immediate =
@@ -1866,7 +1871,7 @@ let transl_package_constraint ~loc env ty =
 let abstract_type_decl ~injective arity =
   let rec make_params n =
     if n <= 0 then [] else Ctype.newvar() :: make_params (n-1) in
-  Ctype.with_local_level ~post:generalize_decl begin fun () ->
+  Ctype.with_local_level_generalize begin fun () ->
     { type_params = make_params arity;
       type_arity = arity;
       type_kind = Type_abstract Definition;
@@ -1909,25 +1914,26 @@ let check_recmod_typedecl env loc recmod_ids path decl =
 
 (**** Error report ****)
 
-open Format
+open Format_doc
 module Style = Misc.Style
+module Printtyp = Printtyp.Doc
 
 let explain_unbound_gen ppf tv tl typ kwd pr =
   try
     let ti = List.find (fun ti -> Ctype.deep_occur tv (typ ti)) tl in
     let ty0 = (* Hack to force aliasing when needed *)
       Btype.newgenty (Tobject(tv, ref None)) in
-    Printtyp.prepare_for_printing [typ ti; ty0];
+    Out_type.prepare_for_printing [typ ti; ty0];
     fprintf ppf
       ".@ @[<hov2>In %s@ %a@;<1 -2>the variable %a is unbound@]"
       kwd (Style.as_inline_code pr) ti
-      (Style.as_inline_code Printtyp.prepared_type_expr) tv
+      (Style.as_inline_code Out_type.prepared_type_expr) tv
   with Not_found -> ()
 
 let explain_unbound ppf tv tl typ kwd lab =
   explain_unbound_gen ppf tv tl typ kwd
     (fun ppf ti ->
-       fprintf ppf "%s%a" (lab ti) Printtyp.prepared_type_expr (typ ti)
+       fprintf ppf "%s%a" (lab ti) Out_type.prepared_type_expr (typ ti)
     )
 
 let explain_unbound_single ppf tv ty =
@@ -1969,7 +1975,7 @@ module Reaching_path = struct
       | [] -> []
     in simplify path
 
-  (* See Printtyp.add_type_to_preparation.
+  (* See Out_type.add_type_to_preparation.
 
      Note: it is better to call this after [simplify], otherwise some
      type variable names may be used for types that are removed
@@ -1978,29 +1984,33 @@ module Reaching_path = struct
   let add_to_preparation path =
     List.iter (function
       | Contains (ty1, ty2) | Expands_to (ty1, ty2) ->
-          List.iter Printtyp.add_type_to_preparation [ty1; ty2]
+          List.iter Out_type.add_type_to_preparation [ty1; ty2]
     ) path
 
+  module Fmt = Format_doc
+
   let pp ppf reaching_path =
     let pp_step ppf = function
       | Expands_to (ty, body) ->
-          Format.fprintf ppf "%a = %a"
-            (Style.as_inline_code Printtyp.prepared_type_expr) ty
-            (Style.as_inline_code Printtyp.prepared_type_expr) body
+          Fmt.fprintf ppf "%a = %a"
+            (Style.as_inline_code Out_type.prepared_type_expr) ty
+            (Style.as_inline_code Out_type.prepared_type_expr) body
       | Contains (outer, inner) ->
-          Format.fprintf ppf "%a contains %a"
-            (Style.as_inline_code Printtyp.prepared_type_expr) outer
-            (Style.as_inline_code Printtyp.prepared_type_expr) inner
+          Fmt.fprintf ppf "%a contains %a"
+            (Style.as_inline_code Out_type.prepared_type_expr) outer
+            (Style.as_inline_code Out_type.prepared_type_expr) inner
     in
-    let comma ppf () = Format.fprintf ppf ",@ " in
-    Format.(pp_print_list ~pp_sep:comma pp_step) ppf reaching_path
+    Fmt.(pp_print_list ~pp_sep:comma) pp_step ppf reaching_path
 
   let pp_colon ppf path =
-  Format.fprintf ppf ":@;<1 2>@[<v>%a@]"
-    pp path
+    Fmt.fprintf ppf ":@;<1 2>@[<v>%a@]" pp path
 end
 
-let report_error ppf = function
+let quoted_out_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty
+let quoted_type ppf ty = Style.as_inline_code Printtyp.type_expr ppf ty
+let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
+
+let report_error_doc ppf = function
   | Repeated_parameter ->
       fprintf ppf "A type parameter occurs several times"
   | Duplicate_constructor s ->
@@ -2014,7 +2024,7 @@ let report_error ppf = function
   | Recursive_abbrev (s, env, reaching_path) ->
       let reaching_path = Reaching_path.simplify reaching_path in
       Printtyp.wrap_printing_env ~error:true env @@ fun () ->
-      Printtyp.reset ();
+      Out_type.reset ();
       Reaching_path.add_to_preparation reaching_path;
       fprintf ppf "@[<v>The type abbreviation %a is cyclic%a@]"
         Style.inline_code s
@@ -2022,7 +2032,7 @@ let report_error ppf = function
   | Cycle_in_def (s, env, reaching_path) ->
       let reaching_path = Reaching_path.simplify reaching_path in
       Printtyp.wrap_printing_env ~error:true env @@ fun () ->
-      Printtyp.reset ();
+      Out_type.reset ();
       Reaching_path.add_to_preparation reaching_path;
       fprintf ppf "@[<v>The definition of %a contains a cycle%a@]"
         Style.inline_code s
@@ -2030,24 +2040,24 @@ let report_error ppf = function
   | Definition_mismatch (ty, _env, None) ->
       fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]@]"
         "This variant or record definition" "does not match that of type"
-        (Style.as_inline_code Printtyp.type_expr) ty
+        quoted_type ty
   | Definition_mismatch (ty, env, Some err) ->
       fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]%a@]"
         "This variant or record definition" "does not match that of type"
-        (Style.as_inline_code Printtyp.type_expr) ty
+        quoted_type ty
         (Includecore.report_type_mismatch
            "the original" "this" "definition" env)
         err
   | Constraint_failed (env, err) ->
+      let msg = Format_doc.Doc.msg in
       fprintf ppf "@[<v>Constraints are not satisfied in this type.@ ";
-      Printtyp.report_unification_error ppf env err
-        (fun ppf -> fprintf ppf "Type")
-        (fun ppf -> fprintf ppf "should be an instance of");
+      Errortrace_report.unification ppf env err
+        (msg "Type")
+        (msg "should be an instance of");
       fprintf ppf "@]"
   | Non_regular { definition; used_as; defined_as; reaching_path } ->
       let reaching_path = Reaching_path.simplify reaching_path in
-      let pp_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty in
-      Printtyp.prepare_for_printing [used_as; defined_as];
+      Out_type.prepare_for_printing [used_as; defined_as];
       Reaching_path.add_to_preparation reaching_path;
       fprintf ppf
         "@[<hv>This recursive type is not regular.@ \
@@ -2056,8 +2066,8 @@ let report_error ppf = function
          All uses need to match the definition for the recursive type \
          to be regular.@]"
         Style.inline_code (Path.name definition)
-        pp_type (Printtyp.tree_of_typexp Type defined_as)
-        pp_type (Printtyp.tree_of_typexp Type used_as)
+        quoted_out_type (Out_type.tree_of_typexp Type defined_as)
+        quoted_out_type (Out_type.tree_of_typexp Type used_as)
         (fun pp ->
            let is_expansion = function Expands_to _ -> true | _ -> false in
            if List.exists is_expansion reaching_path then
@@ -2065,17 +2075,17 @@ let report_error ppf = function
              Reaching_path.pp_colon reaching_path
            else fprintf pp ".@ ")
   | Inconsistent_constraint (env, err) ->
+      let msg = Format_doc.Doc.msg in
       fprintf ppf "@[<v>The type constraints are not consistent.@ ";
-      Printtyp.report_unification_error ppf env err
-        (fun ppf -> fprintf ppf "Type")
-        (fun ppf -> fprintf ppf "is not compatible with type");
+      Errortrace_report.unification ppf env err
+        (msg "Type")
+        (msg "is not compatible with type");
       fprintf ppf "@]"
   | Type_clash (env, err) ->
-      Printtyp.report_unification_error ppf env err
-        (function ppf ->
-           fprintf ppf "This type constructor expands to type")
-        (function ppf ->
-           fprintf ppf "but is used here with type")
+      let msg = Format_doc.Doc.msg in
+      Errortrace_report.unification ppf env err
+        (msg "This type constructor expands to type")
+        (msg "but is used here with type")
   | Null_arity_external ->
       fprintf ppf "External identifiers must be functions"
   | Missing_native_external ->
@@ -2124,24 +2134,23 @@ let report_error ppf = function
            "the type" "this extension" "definition" env)
         err
   | Rebind_wrong_type (lid, env, err) ->
-      Printtyp.report_unification_error ppf env err
-        (function ppf ->
-           fprintf ppf "The constructor %a@ has type"
-             (Style.as_inline_code Printtyp.longident) lid)
-        (function ppf ->
-           fprintf ppf "but was expected to be of type")
+      let msg = Format_doc.doc_printf in
+      Errortrace_report.unification ppf env err
+        (msg "The constructor %a@ has type"
+             quoted_constr lid)
+        (msg "but was expected to be of type")
   | Rebind_mismatch (lid, p, p') ->
       fprintf ppf
         "@[%s@ %a@ %s@ %a@ %s@ %s@ %a@]"
         "The constructor"
-        (Style.as_inline_code Printtyp.longident) lid
+        quoted_constr lid
         "extends type" Style.inline_code (Path.name p)
         "whose declaration does not match"
         "the declaration of type" Style.inline_code (Path.name p')
   | Rebind_private lid ->
       fprintf ppf "@[%s@ %a@ %s@]"
         "The constructor"
-        (Style.as_inline_code Printtyp.longident) lid
+        quoted_constr lid
         "is private"
   | Variance (Typedecl_variance.Bad_variance (n, v1, v2)) ->
       let variance (p,n,i) =
@@ -2154,44 +2163,44 @@ let report_error ppf = function
       in
       (match n with
        | Variance_variable_error { error; variable; context } ->
-           Printtyp.prepare_for_printing [ variable ];
+           Out_type.prepare_for_printing [ variable ];
            begin match context with
            | Type_declaration (id, decl) ->
-               Printtyp.add_type_declaration_to_preparation id decl;
+               Out_type.add_type_declaration_to_preparation id decl;
                fprintf ppf "@[<v>%s@;<1 2>%a@;"
                  "In the definition"
-                 (Style.as_inline_code @@ Printtyp.prepared_type_declaration id)
+                 (Style.as_inline_code @@ Out_type.prepared_type_declaration id)
                  decl
            | Gadt_constructor c ->
-               Printtyp.add_constructor_to_preparation c;
+               Out_type.add_constructor_to_preparation c;
                fprintf ppf "@[<v>%s@;<1 2>%a@;"
                  "In the GADT constructor"
-                 (Style.as_inline_code Printtyp.prepared_constructor)
+                 (Style.as_inline_code Out_type.prepared_constructor)
                  c
            | Extension_constructor (id, e) ->
-               Printtyp.add_extension_constructor_to_preparation e;
+               Out_type.add_extension_constructor_to_preparation e;
                fprintf ppf "@[<v>%s@;<1 2>%a@;"
                  "In the extension constructor"
-                 (Printtyp.prepared_extension_constructor id)
+                 (Out_type.prepared_extension_constructor id)
                  e
            end;
            begin match error with
            | Variance_not_reflected ->
                fprintf ppf "@[%s@ %a@ %s@ %s@ It"
                  "the type variable"
-                 (Style.as_inline_code Printtyp.prepared_type_expr) variable
+                 (Style.as_inline_code Out_type.prepared_type_expr) variable
                  "has a variance that"
                  "is not reflected by its occurrence in type parameters."
            | No_variable ->
                fprintf ppf "@[%s@ %a@ %s@ %s@]@]"
                  "the type variable"
-                 (Style.as_inline_code Printtyp.prepared_type_expr) variable
+                 (Style.as_inline_code Out_type.prepared_type_expr) variable
                  "cannot be deduced"
                  "from the type parameters."
            | Variance_not_deducible ->
                fprintf ppf "@[%s@ %a@ %s@ %s@ It"
                  "the type variable"
-                 (Style.as_inline_code Printtyp.prepared_type_expr) variable
+                 (Style.as_inline_code Out_type.prepared_type_expr) variable
                  "has a variance that"
                  "cannot be deduced from the type parameters."
            end
@@ -2259,7 +2268,7 @@ let report_error ppf = function
             fprintf ppf "an unnamed existential variable"
         | Some str ->
             fprintf ppf "the existential variable %a"
-              (Style.as_inline_code Pprintast.tyvar) str in
+              (Style.as_inline_code Pprintast.Doc.tyvar) str in
       fprintf ppf "@[This type cannot be unboxed because@ \
                    it might contain both float and non-float values,@ \
                    depending on the instantiation of %a.@ \
@@ -2274,7 +2283,7 @@ let report_error ppf = function
         Style.inline_code "nonrec"
   | Invalid_private_row_declaration ty ->
       let pp_private ppf ty = fprintf ppf "private %a" Printtyp.type_expr ty in
-      Format.fprintf ppf
+      fprintf ppf
         "@[<hv>This private row type declaration is invalid.@ \
          The type expression on the right-hand side reduces to@;<1 2>%a@ \
          which does not have a free row type variable.@]@,\
@@ -2288,7 +2297,9 @@ let () =
   Location.register_error_of_exn
     (function
       | Error (loc, err) ->
-        Some (Location.error_of_printer ~loc report_error err)
+        Some (Location.error_of_printer ~loc report_error_doc err)
       | _ ->
         None
     )
+
+let report_error = Format_doc.compat report_error_doc

diff --git a/typing/typedecl.mli b/typing/typedecl.mli
index 52a3197f74c046404640a1d3d454f20c3064da5a..38c00487ed1082f6b234ccf6228bf7760c177ce1 100644 (file)
--- a/typing/typedecl.mli
+++ b/typing/typedecl.mli
@@ -16,8 +16,6 @@
 (* Typing of type definitions and primitive definitions *)
 
 open Types
-open Format
-
 val transl_type_decl:
     Env.t -> Asttypes.rec_flag -> Parsetree.type_declaration list ->
     Typedtree.type_declaration list * Env.t * Shape.t list
@@ -111,4 +109,5 @@ type error =
 
 exception Error of Location.t * error
 
-val report_error: formatter -> error -> unit
+val report_error: error Format_doc.format_printer
+val report_error_doc: error Format_doc.printer

diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index e2978ba03f061056fa765d123d22b174decab2cc..ff0060e13514c710ba16f82bc7feca14815cd305 100644 (file)
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -104,8 +104,8 @@ and expression_desc =
   | Texp_let of rec_flag * value_binding list * expression
   | Texp_function of function_param list * function_body
   | Texp_apply of expression * (arg_label * expression option) list
-  | Texp_match of expression * computation case list * partial
-  | Texp_try of expression * value case list
+  | Texp_match of expression * computation case list * value case list * partial
+  | Texp_try of expression * value case list * value case list
   | Texp_tuple of expression list
   | Texp_construct of
       Longident.t loc * constructor_description * expression list
@@ -157,6 +157,7 @@ and meth =
 and 'k case =
     {
      c_lhs: 'k general_pattern;
+     c_cont: Ident.t option;
      c_guard: expression option;
      c_rhs: expression;
     }
@@ -892,19 +893,3 @@ let split_pattern pat =
         combine_opts (into cpat) exns1 exns2
   in
   split_pattern pat
-
-(* Expressions are considered nominal if they can be used as the subject of a
-   sentence or action. In practice, we consider that an expression is nominal
-   if they satisfy one of:
-   - Similar to an identifier: words separated by '.' or '#'.
-   - Do not contain spaces when printed.
-  *)
-let rec exp_is_nominal exp =
-  match exp.exp_desc with
-  | _ when exp.exp_attributes <> [] -> false
-  | Texp_ident _ | Texp_instvar _ | Texp_constant _
-  | Texp_variant (_, None)
-  | Texp_construct (_, _, []) ->
-      true
-  | Texp_field (parent, _, _) | Texp_send (parent, _) -> exp_is_nominal parent
-  | _ -> false

diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index 5f042f0e22e2d4011180a30fc54219b19ba945fb..7dd2ed7a8df0c285fbe330d42d94956aafa923d9 100644 (file)
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -211,17 +211,22 @@ and expression_desc =
                          (Labelled "y", Some (Texp_constant Const_int 3))
                         ])
          *)
-  | Texp_match of expression * computation case list * partial
+  | Texp_match of expression * computation case list * value case list * partial
         (** match E0 with
             | P1 -> E1
             | P2 | exception P3 -> E2
             | exception P4 -> E3
+            | effect P4 k -> E4
 
             [Texp_match (E0, [(P1, E1); (P2 | exception P3, E2);
-                              (exception P4, E3)], _)]
+                              (exception P4, E3)], [(P4, E4)],  _)]
          *)
-  | Texp_try of expression * value case list
-        (** try E with P1 -> E1 | ... | PN -> EN *)
+  | Texp_try of expression * value case list * value case list
+         (** try E with
+            | P1 -> E1
+            | effect P2 k -> E2
+            [Texp_try (E, [(P1, E1)], [(P2, E2)])]
+          *)
   | Texp_tuple of expression list
         (** (E1, ..., EN) *)
   | Texp_construct of
@@ -290,6 +295,7 @@ and meth =
 and 'k case =
     {
      c_lhs: 'k general_pattern;
+     c_cont: Ident.t option;
      c_guard: expression option;
      c_rhs: expression;
     }
@@ -913,7 +919,3 @@ val pat_bound_idents_full:
 (** Splits an or pattern into its value (left) and exception (right) parts. *)
 val split_pattern:
   computation general_pattern -> pattern option * pattern option
-
-(** Whether an expression looks nice as the subject of a sentence in a error
-    message. *)
-val exp_is_nominal : expression -> bool

diff --git a/typing/typemod.ml b/typing/typemod.ml
index 486fcdcffc47e0766f5be0d36978b4f9a9d94dc4..0ff6c75bcf6eb26ef982b8d212f4ea77c6c9b2a3 100644 (file)
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -19,7 +19,7 @@ open Path
 open Asttypes
 open Parsetree
 open Types
-open Format
+open Format_doc
 
 module Style = Misc.Style
 
@@ -76,8 +76,9 @@ type error =
   | Badly_formed_signature of string * Typedecl.error
   | Cannot_hide_id of hiding_error
   | Invalid_type_subst_rhs
-  | Unpackable_local_modtype_subst of Path.t
+  | Non_packable_local_modtype_subst of Path.t
   | With_cannot_remove_packed_modtype of Path.t * module_type
+  | Cannot_alias of Path.t
 
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
@@ -231,7 +232,7 @@ let check_type_decl env sg loc id row_id newdecl decl =
     | Some fresh_row_id -> Env.add_type ~check:false fresh_row_id newdecl env
   in
   let env = Env.add_signature sg env in
-  Includemod.type_declarations ~mark:Mark_both ~loc env fresh_id newdecl decl;
+  Includemod.type_declarations ~mark:true ~loc env fresh_id newdecl decl;
   Typedecl.check_coherence env loc path newdecl
 
 let make_variance p n i =
@@ -264,9 +265,8 @@ let path_is_strict_prefix =
        Ident.same ident1 ident2
        && list_is_strict_prefix l1 ~prefix:l2
 
-let iterator_with_env env =
+let iterator_with_env super env =
   let env = ref (lazy env) in
-  let super = Btype.type_iterators in
   env, { super with
     Btype.it_signature = (fun self sg ->
       (* add all items to the env before recursing down, to handle recursive
@@ -344,22 +344,9 @@ let check_usage_of_path_of_substituted_item paths ~loc ~lid env super =
       );
     }
 
-(* When doing a module type destructive substitution [with module type T = RHS]
-   where RHS is not a module type path, we need to check that the module type
-   T was not used as a path for a packed module
-*)
-let check_usage_of_module_types ~error ~paths ~loc env super =
-  let it_do_type_expr it ty = match get_desc ty with
-    | Tpackage (p, _) ->
-       begin match List.find_opt (Path.same p) paths with
-       | Some p -> raise (Error(loc,Lazy.force !env,error p))
-       | _ -> super.Btype.it_do_type_expr it ty
-       end
-    | _ -> super.Btype.it_do_type_expr it ty in
-  { super with Btype.it_do_type_expr }
-
-let do_check_after_substitution env ~loc ~lid paths unpackable_modtype sg =
-  let env, iterator = iterator_with_env env in
+let do_check_after_substitution env ~loc ~lid paths sg =
+  with_type_mark begin fun mark ->
+  let env, iterator = iterator_with_env (Btype.type_iterators mark) env in
   let last, rest = match List.rev paths with
     | [] -> assert false
     | last :: rest -> last, rest
@@ -372,19 +359,13 @@ let do_check_after_substitution env ~loc ~lid paths unpackable_modtype sg =
     | _ :: _ ->
         check_usage_of_path_of_substituted_item rest ~loc ~lid env iterator
   in
-  let iterator = match unpackable_modtype with
-    | None -> iterator
-    | Some mty ->
-       let error p = With_cannot_remove_packed_modtype(p,mty) in
-       check_usage_of_module_types ~error ~paths ~loc env iterator
-  in
-  iterator.Btype.it_signature iterator sg;
-  Btype.(unmark_iterators.it_signature unmark_iterators) sg
+  iterator.Btype.it_signature iterator sg
+  end
 
-let check_usage_after_substitution env ~loc ~lid paths unpackable_modtype sg =
-  match paths, unpackable_modtype with
-  | [_], None -> ()
-  | _ -> do_check_after_substitution env ~loc ~lid paths unpackable_modtype sg
+let check_usage_after_substitution env ~loc ~lid paths sg =
+  match paths with
+  | [_] -> ()
+  | _ -> do_check_after_substitution env ~loc ~lid paths sg
 
 (* After substitution one also needs to re-check the well-foundedness
    of type declarations in recursive modules *)
@@ -413,9 +394,9 @@ let check_well_formed_module env loc context mty =
       | _ :: rem ->
           check_signature env rem
     in
-    let env, super = iterator_with_env env in
+    let env, super =
+      iterator_with_env Btype.type_iterators_without_type_expr env in
     { super with
-      it_type_expr = (fun _self _ty -> ());
       it_signature = (fun self sg ->
         let env_before = !env in
         let env = lazy (Env.add_signature sg (Lazy.force env_before)) in
@@ -479,7 +460,6 @@ let merge_constraint initial_env loc sg lid constr =
     | With_typesubst _ | With_modsubst _ | With_modtypesubst _  -> true
   in
   let real_ids = ref [] in
-  let unpackable_modtype = ref None in
   let split_row_id s ghosts =
     let srow = s ^ "#row" in
     let rec split before = function
@@ -490,6 +470,17 @@ let merge_constraint initial_env loc sg lid constr =
     in
     split [] ghosts
   in
+  let unsafe_signature_subst sub sg =
+    (* This signature will not be used directly, it will always be freshened
+       by the caller. So what we do with the scope doesn't really matter. But
+       making it local makes it unlikely that we will ever use the result of
+       this function unfreshened without issue. *)
+    match Subst.Unsafe.signature Make_local sub sg with
+    | Ok x -> x
+    | Error (Fcm_type_substituted_away (p,mty)) ->
+        let error = With_cannot_remove_packed_modtype(p,mty) in
+        raise (Error(loc,initial_env,error))
+  in
   let rec patch_item constr namelist outer_sig_env sg_for_env ~ghosts item =
     let return ?(ghosts=ghosts) ~replace_by info =
       Some (info, {Signature_group.ghosts; replace_by})
@@ -527,7 +518,7 @@ let merge_constraint initial_env loc sg lid constr =
             type_attributes = [];
             type_immediate = Unknown;
             type_unboxed_default = false;
-            type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+            type_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
           }
         and id_row = Ident.create_local (s^"#row") in
         let initial_env =
@@ -599,7 +590,7 @@ let merge_constraint initial_env loc sg lid constr =
         if not destructive_substitution then
           let mtd': modtype_declaration =
             {
-              mtd_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+              mtd_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
               mtd_type = Some mty.mty_type;
               mtd_attributes = [];
               mtd_loc = loc;
@@ -611,10 +602,6 @@ let merge_constraint initial_env loc sg lid constr =
         else begin
           let path = Pident id in
           real_ids := [path];
-          begin match mty.mty_type with
-          | Mty_ident _ -> ()
-          | mty -> unpackable_modtype := Some mty
-          end;
           return ~replace_by:None
             (Pident id, lid, Some (Twith_modtypesubst mty))
         end
@@ -626,7 +613,7 @@ let merge_constraint initial_env loc sg lid constr =
         let mty = Mtype.scrape_for_type_of ~remove_aliases sig_env mty in
         let md'' = { md' with md_type = mty } in
         let newmd = Mtype.strengthen_decl ~aliasable:false sig_env md'' path in
-        ignore(Includemod.modtypes  ~mark:Mark_both ~loc sig_env
+        ignore(Includemod.modtypes  ~mark:true ~loc sig_env
                  newmd.md_type md.md_type);
         return
           ~replace_by:(Some(Sig_module(id, pres, newmd, rs, priv)))
@@ -636,7 +623,7 @@ let merge_constraint initial_env loc sg lid constr =
         let sig_env = Env.add_signature sg_for_env outer_sig_env in
         let aliasable = not (Env.is_functor_arg path sig_env) in
         ignore
-          (Includemod.strengthened_module_decl ~loc ~mark:Mark_both
+          (Includemod.strengthened_module_decl ~loc ~mark:true
              ~aliasable sig_env md' path md);
         real_ids := [Pident id];
         return ~replace_by:None
@@ -671,8 +658,7 @@ let merge_constraint initial_env loc sg lid constr =
     let names = Longident.flatten lid.txt in
     let (tcstr, sg) = merge_signature initial_env sg names in
     if destructive_substitution then
-      check_usage_after_substitution ~loc ~lid initial_env !real_ids
-        !unpackable_modtype sg;
+      check_usage_after_substitution ~loc ~lid initial_env !real_ids sg;
     let sg =
     match tcstr with
     | (_, _, Some (Twith_typesubst tdecl)) ->
@@ -688,37 +674,32 @@ let merge_constraint initial_env loc sg lid constr =
               try Env.find_type_by_name lid.txt initial_env
               with Not_found -> assert false
             in
-            fun s path -> Subst.add_type_path path replacement s
+            fun s path -> Subst.Unsafe.add_type_path path replacement s
          | None ->
             let body = Option.get tdecl.typ_type.type_manifest in
             let params = tdecl.typ_type.type_params in
             if params_are_constrained params
             then raise(Error(loc, initial_env,
                              With_cannot_remove_constrained_type));
-            fun s path -> Subst.add_type_function path ~params ~body s
+            fun s path -> Subst.Unsafe.add_type_function path ~params ~body s
        in
        let sub = Subst.change_locs Subst.identity loc in
        let sub = List.fold_left how_to_extend_subst sub !real_ids in
-       (* This signature will not be used directly, it will always be freshened
-          by the caller. So what we do with the scope doesn't really matter. But
-          making it local makes it unlikely that we will ever use the result of
-          this function unfreshened without issue. *)
-       Subst.signature Make_local sub sg
+       unsafe_signature_subst sub sg
     | (_, _, Some (Twith_modsubst (real_path, _))) ->
        let sub = Subst.change_locs Subst.identity loc in
        let sub =
          List.fold_left
-           (fun s path -> Subst.add_module_path path real_path s)
+           (fun s path -> Subst.Unsafe.add_module_path path real_path s)
            sub
            !real_ids
        in
-       (* See explanation in the [Twith_typesubst] case above. *)
-       Subst.signature Make_local sub sg
+       unsafe_signature_subst sub sg
     | (_, _, Some (Twith_modtypesubst tmty)) ->
-        let add s p = Subst.add_modtype_path p tmty.mty_type s in
+        let add s p = Subst.Unsafe.add_modtype_path p tmty.mty_type s in
         let sub = Subst.change_locs Subst.identity loc in
         let sub = List.fold_left add sub !real_ids in
-        Subst.signature Make_local sub sg
+        unsafe_signature_subst sub sg
     | _ ->
        sg
     in
@@ -987,8 +968,7 @@ module Signature_names : sig
     | `Exported
     | `From_open
     | `Shadowable of shadowable
-    | `Substituted_away of Subst.t
-    | `Unpackable_modtype_substituted_away of Ident.t * Subst.t
+    | `Substituted_away of Subst.Unsafe.t
   ]
 
   val create : unit -> t
@@ -1024,8 +1004,7 @@ end = struct
 
   type info = [
     | `From_open
-    | `Substituted_away of Subst.t
-    | `Unpackable_modtype_substituted_away of Ident.t * Subst.t
+    | `Substituted_away of Subst.Unsafe.t
     | bound_info
   ]
 
@@ -1034,9 +1013,8 @@ end = struct
     | Shadowed_by of Ident.t * Location.t
 
   type to_be_removed = {
-    mutable subst: Subst.t;
+    mutable subst: Subst.Unsafe.t;
     mutable hide: (Sig_component_kind.t * Location.t * hide_reason) Ident.Map.t;
-    mutable unpackable_modtypes: Ident.Set.t;
   }
 
   type names_infos = (string, bound_info) Hashtbl.t
@@ -1071,7 +1049,6 @@ end = struct
     to_be_removed = {
       subst = Subst.identity;
       hide = Ident.Map.empty;
-      unpackable_modtypes = Ident.Set.empty;
     };
   }
 
@@ -1086,15 +1063,20 @@ end = struct
     | Class -> names.classes
     | Class_type -> names.class_types
 
+  let check_unsafe_subst loc env: _ result -> _ = function
+    | Ok x -> x
+    | Error (Subst.Unsafe.Fcm_type_substituted_away (p,_)) ->
+        raise (Error (loc, env, Non_packable_local_modtype_subst p))
+
   let check cl t loc id (info : info) =
     let to_be_removed = t.to_be_removed in
     match info with
     | `Substituted_away s ->
-        to_be_removed.subst <- Subst.compose s to_be_removed.subst;
-    | `Unpackable_modtype_substituted_away (id,s) ->
-        to_be_removed.subst <- Subst.compose s to_be_removed.subst;
-        to_be_removed.unpackable_modtypes <-
-          Ident.Set.add id to_be_removed.unpackable_modtypes
+        let subst =
+          check_unsafe_subst loc Env.empty @@
+          Subst.Unsafe.compose s to_be_removed.subst
+        in
+        to_be_removed.subst <- subst;
     | `From_open ->
         to_be_removed.hide <-
           Ident.Map.add id (cl, loc, From_open) to_be_removed.hide
@@ -1164,31 +1146,6 @@ end = struct
        thus never appear in includes *)
      List.iter (check ?info names loc) (Signature_group.rec_items item.group)
 
-  (*
-    Before applying local module type substitutions where the
-    right-hand side is not a path, we need to check that those module types
-    where never used to pack modules. For instance
-    {[
-    module type T := sig end
-    val x: (module T)
-    ]}
-    should raise an error.
-  *)
-  let check_unpackable_modtypes ~loc ~env to_remove component =
-    if not (Ident.Set.is_empty to_remove.unpackable_modtypes) then begin
-      let iterator =
-        let error p = Unpackable_local_modtype_subst p in
-        let paths =
-          List.map (fun id -> Pident id)
-            (Ident.Set.elements to_remove.unpackable_modtypes)
-        in
-        check_usage_of_module_types ~loc ~error ~paths
-          (ref (lazy env)) Btype.type_iterators
-      in
-      iterator.Btype.it_signature_item iterator component;
-      Btype.(unmark_iterators.it_signature_item unmark_iterators) component
-    end
-
   (* We usually require name uniqueness of signature components (e.g. types,
      modules, etc), however in some situation reusing the name is allowed: if
      the component is a value or an extension, or if the name is introduced by
@@ -1199,7 +1156,6 @@ end = struct
      If some reference cannot be removed, then we error out with
      [Cannot_hide_id].
   *)
-
   let simplify env t sg =
     let to_remove = t.to_be_removed in
     let ids_to_remove =
@@ -1229,10 +1185,8 @@ end = struct
           if to_remove.subst == Subst.identity then
             component
           else
-            begin
-              check_unpackable_modtypes ~loc:user_loc ~env to_remove component;
-              Subst.signature_item Keep to_remove.subst component
-            end
+            check_unsafe_subst user_loc env @@
+            Subst.Unsafe.signature_item Keep to_remove.subst component
         in
         let component =
           match ids_to_remove with
@@ -1347,7 +1301,7 @@ and transl_modtype_aux env smty =
                   { md_type = arg.mty_type;
                     md_attributes = [];
                     md_loc = param.loc;
-                    md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+                    md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
                   }
                 in
                 Env.enter_module_declaration ~scope ~arg:true name Mp_present
@@ -1403,7 +1357,7 @@ and transl_with ~loc env remove_aliases (rev_tcstrs,sg) constr =
 
 
 
-and transl_signature ?(toplevel = false) env sg =
+and transl_signature env sg =
   let names = Signature_names.create () in
   let rec transl_sig env sg =
     match sg with
@@ -1450,7 +1404,7 @@ and transl_signature ?(toplevel = false) env sg =
               then raise(Error(loc, env, With_cannot_remove_constrained_type));
               let info =
                   let subst =
-                    Subst.add_type_function (Pident td.typ_id)
+                    Subst.Unsafe.add_type_function (Pident td.typ_id)
                       ~params
                       ~body:(Option.get td.typ_type.type_manifest)
                       Subst.identity
@@ -1499,14 +1453,17 @@ and transl_signature ?(toplevel = false) env sg =
             in
             let pres =
               match tmty.mty_type with
-              | Mty_alias _ -> Mp_absent
+              | Mty_alias p ->
+                  if Env.is_functor_arg p env then
+                    raise (Error (pmd.pmd_loc, env, Cannot_alias p));
+                  Mp_absent
               | _ -> Mp_present
             in
             let md = {
               md_type=tmty.mty_type;
               md_attributes=pmd.pmd_attributes;
               md_loc=pmd.pmd_loc;
-              md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+              md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
             }
             in
             let id, newenv =
@@ -1543,7 +1500,7 @@ and transl_signature ?(toplevel = false) env sg =
                 { md_type = Mty_alias path;
                   md_attributes = pms.pms_attributes;
                   md_loc = pms.pms_loc;
-                  md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+                  md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
                 }
             in
             let pres =
@@ -1607,10 +1564,9 @@ and transl_signature ?(toplevel = false) env sg =
                     (* parsetree invariant, see Ast_invariants *)
                     assert false
               in
-              let subst = Subst.add_modtype mtd.mtd_id mty Subst.identity in
-              match mty with
-              | Mty_ident _ -> `Substituted_away subst
-              | _ -> `Unpackable_modtype_substituted_away (mtd.mtd_id,subst)
+              let subst =
+                Subst.Unsafe.add_modtype mtd.mtd_id mty Subst.identity in
+              `Substituted_away subst
             in
             Signature_names.check_modtype ~info names pmtd.pmtd_loc mtd.mtd_id;
             let (trem, rem, final_env) = transl_sig newenv srem in
@@ -1702,8 +1658,6 @@ and transl_signature ?(toplevel = false) env sg =
             typedtree, sg, final_env
         | Psig_attribute x ->
             Builtin_attributes.warning_attribute x;
-            if toplevel || not (Warnings.is_active (Misplaced_attribute ""))
-            then Builtin_attributes.mark_alert_used x;
             let (trem,rem, final_env) = transl_sig env srem in
             mksig (Tsig_attribute x) env loc :: trem, rem, final_env
         | Psig_extension (ext, _attrs) ->
@@ -1736,7 +1690,7 @@ and transl_modtype_decl_aux env
      Types.mtd_type=Option.map (fun t -> t.mty_type) tmty;
      mtd_attributes=pmtd_attributes;
      mtd_loc=pmtd_loc;
-     mtd_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+     mtd_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
     }
   in
   let scope = Ctype.create_scope () in
@@ -1795,7 +1749,7 @@ and transl_recmodule_modtypes env sdecls =
   let init =
     List.map2
       (fun id pmd ->
-         let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+         let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
          let md =
            { md_type = approx_modtype approx_env pmd.pmd_type;
              md_loc = pmd.pmd_loc;
@@ -2022,7 +1976,7 @@ let check_recmodule_inclusion env bindings =
         let coercion, shape =
           try
             Includemod.modtypes_with_shape ~shape
-              ~loc:modl.mod_loc ~mark:Mark_both
+              ~loc:modl.mod_loc ~mark:true
               env mty_actual' mty_decl'
           with Includemod.Error msg ->
             raise(Error(modl.mod_loc, env, Not_included msg)) in
@@ -2090,32 +2044,39 @@ and package_constraints env loc mty constrs =
   end
 
 let modtype_of_package env loc p fl =
-  (* We call Ctype.correct_levels to ensure that the types being added to the
+  (* We call Ctype.duplicate_type to ensure that the types being added to the
      module type are at generic_level. *)
   let mty =
     package_constraints env loc (Mty_ident p)
-      (List.map (fun (n, t) -> Longident.flatten n, Ctype.correct_levels t) fl)
+      (List.map (fun (n, t) -> Longident.flatten n, Ctype.duplicate_type t) fl)
   in
   Subst.modtype Keep Subst.identity mty
 
 let package_subtype env p1 fl1 p2 fl2 =
   let mkmty p fl =
     let fl =
-      List.filter (fun (_n,t) -> Ctype.free_variables t = []) fl in
+      List.filter (fun (_n,t) -> Ctype.closed_type_expr t) fl in
     modtype_of_package env Location.none p fl
   in
   match mkmty p1 fl1, mkmty p2 fl2 with
-  | exception Error(_, _, Cannot_scrape_package_type _) -> false
+  | exception Error(_, _, Cannot_scrape_package_type r) ->
+      Result.Error (Errortrace.Package_cannot_scrape r)
   | mty1, mty2 ->
     let loc = Location.none in
-    match Includemod.modtypes ~loc ~mark:Mark_both env mty1 mty2 with
-    | Tcoerce_none -> true
-    | _ | exception Includemod.Error _ -> false
+    match Includemod.modtypes ~loc ~mark:true env mty1 mty2 with
+    | Tcoerce_none -> Ok ()
+    | c ->
+        let msg =
+          Includemod_errorprinter.coercion_in_package_subtype env mty1 c
+        in
+        Result.Error (Errortrace.Package_coercion msg)
+    | exception Includemod.Error e ->
+        let msg = doc_printf "%a" Includemod_errorprinter.err_msgs e in
+        Result.Error (Errortrace.Package_inclusion msg)
 
 let () = Ctype.package_subtype := package_subtype
 
 let wrap_constraint_package env mark arg mty explicit =
-  let mark = if mark then Includemod.Mark_both else Includemod.Mark_neither in
   let mty1 = Subst.modtype Keep Subst.identity arg.mod_type in
   let mty2 = Subst.modtype Keep Subst.identity mty in
   let coercion =
@@ -2131,7 +2092,6 @@ let wrap_constraint_package env mark arg mty explicit =
 
 let wrap_constraint_with_shape env mark arg mty
   shape explicit =
-  let mark = if mark then Includemod.Mark_both else Includemod.Mark_neither in
   let coercion, shape =
     try
       Includemod.modtypes_with_shape ~shape ~loc:arg.mod_loc env ~mark
@@ -2172,6 +2132,8 @@ let simplify_app_summary app_view = match app_view.arg with
     | false, Some p -> Includemod.Error.Named p, mty
     | false, None   -> Includemod.Error.Anonymous, mty
 
+let not_principal msg = Warnings.Not_principal (Format_doc.Doc.msg msg)
+
 let rec type_module ?(alias=false) sttn funct_body anchor env smod =
   Builtin_attributes.warning_scope smod.pmod_attributes
     (fun () -> type_module_aux ~alias sttn funct_body anchor env smod)
@@ -2243,7 +2205,7 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
             match param.txt with
             | None -> None, env, Shape.for_unnamed_functor_param
             | Some name ->
-              let md_uid =  Uid.mk ~current_unit:(Env.get_unit_name ()) in
+              let md_uid =  Uid.mk ~current_unit:(Env.get_current_unit ()) in
               let arg_md =
                 { md_type = mty.mty_type;
                   md_attributes = [];
@@ -2284,21 +2246,21 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
       final_shape
   | Pmod_unpack sexp ->
       let exp =
-        Ctype.with_local_level_if_principal
+        Ctype.with_local_level_generalize_structure_if_principal
           (fun () -> Typecore.type_exp env sexp)
-          ~post:Typecore.generalize_structure_exp
       in
       let mty =
         match get_desc (Ctype.expand_head env exp.exp_type) with
           Tpackage (p, fl) ->
-            if List.exists (fun (_n, t) -> Ctype.free_variables t <> []) fl then
+            if List.exists (fun (_n, t) -> not (Ctype.closed_type_expr t)) fl
+            then
               raise (Error (smod.pmod_loc, env,
                             Incomplete_packed_module exp.exp_type));
             if !Clflags.principal &&
               not (Typecore.generalizable (Btype.generic_level-1) exp.exp_type)
             then
               Location.prerr_warning smod.pmod_loc
-                (Warnings.Not_principal "this module unpacking");
+                (not_principal "this module unpacking");
             modtype_of_package env smod.pmod_loc p fl
         | Tvar _ ->
             raise (Typecore.Error
@@ -2398,8 +2360,8 @@ and type_one_application ~ctx:(apply_loc,sfunct,md_f,args)
       | { loc = app_loc; attributes = app_attributes;
           arg = Some { shape = arg_shape; path = arg_path; arg } } ->
       let coercion =
-        try Includemod.modtypes
-              ~loc:arg.mod_loc ~mark:Mark_both env arg.mod_type mty_param
+        try Includemod.modtypes ~loc:arg.mod_loc ~mark:true env
+              arg.mod_type mty_param
         with Includemod.Error _ -> apply_error ()
       in
       let mty_appl =
@@ -2428,8 +2390,8 @@ and type_one_application ~ctx:(apply_loc,sfunct,md_f,args)
                     raise (Error(app_loc, env, error))
             in
             begin match
-              Includemod.modtypes
-                ~loc:app_loc ~mark:Mark_neither env mty_res nondep_mty
+              Includemod.modtypes ~loc:app_loc ~mark:false env
+                mty_res nondep_mty
             with
             | Tcoerce_none -> ()
             | _ ->
@@ -2637,7 +2599,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr =
           | Mty_alias _ -> Mp_absent
           | _ -> Mp_present
         in
-        let md_uid = Uid.mk ~current_unit:(Env.get_unit_name ()) in
+        let md_uid = Uid.mk ~current_unit:(Env.get_current_unit ()) in
         let md =
           { md_type = enrich_module_type anchor name.txt modl.mod_type env;
             md_attributes = attrs;
@@ -2714,6 +2676,8 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr =
                let mty' =
                  enrich_module_type anchor name.txt modl.mod_type newenv
                in
+               Includemod.modtypes_consistency ~loc:modl.mod_loc newenv
+                mty' mty.mty_type;
                (id, name, mty, modl, mty', attrs, loc, shape, uid))
             decls sbind in
         let newenv = (* allow aliasing recursive modules from outside *)
@@ -2854,8 +2818,6 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr =
         raise (Error_forward (Builtin_attributes.error_of_extension ext))
     | Pstr_attribute x ->
         Builtin_attributes.warning_attribute x;
-        if toplevel || not (Warnings.is_active (Misplaced_attribute "")) then
-          Builtin_attributes.mark_alert_used x;
         Tstr_attribute x, [], shape_map, env
   in
   let rec type_struct env shape_map sstr =
@@ -3087,7 +3049,7 @@ let type_implementation target initial_env ast =
         Typecore.force_delayed_checks ();
         let shape = Shape_reduce.local_reduce Env.empty shape in
         Printtyp.wrap_printing_env ~error:false initial_env
-          (fun () -> fprintf std_formatter "%a@."
+          Format.(fun () -> fprintf std_formatter "%a@."
               (Printtyp.printed_signature @@ Unit_info.source_file target)
               simple_sg
           );
@@ -3111,7 +3073,7 @@ let type_implementation target initial_env ast =
           in
           let dclsig = Env.read_signature compiled_intf_file in
           let coercion, shape =
-            Includemod.compunit initial_env ~mark:Mark_positive
+            Includemod.compunit initial_env ~mark:true
               sourcefile sg source_intf
               dclsig shape
           in
@@ -3132,7 +3094,7 @@ let type_implementation target initial_env ast =
             (Location.in_file (Unit_info.source_file target))
             Warnings.Missing_mli;
           let coercion, shape =
-            Includemod.compunit initial_env ~mark:Mark_positive
+            Includemod.compunit initial_env ~mark:true
               sourcefile sg "(inferred signature)" simple_sg shape
           in
           check_nongen_signature finalenv simple_sg;
@@ -3143,8 +3105,8 @@ let type_implementation target initial_env ast =
              declarations like "let x = true;; let x = 1;;", because in this
              case, the inferred signature contains only the last declaration. *)
           let shape = Shape_reduce.local_reduce Env.empty shape in
+          let alerts = Builtin_attributes.alerts_of_str ~mark:true ast in
           if not !Clflags.dont_write_files then begin
-            let alerts = Builtin_attributes.alerts_of_str ast in
             let cmi =
               Env.save_signature ~alerts simple_sg (Unit_info.cmi target)
             in
@@ -3172,10 +3134,7 @@ let save_signature target tsg initial_env cmi =
     (Cmt_format.Interface tsg) initial_env (Some cmi) None
 
 let type_interface env ast =
-  transl_signature ~toplevel:true env ast
-
-let transl_signature env ast =
-  transl_signature ~toplevel:false env ast
+  transl_signature env ast
 
 (* "Packaging" of several compilation units into one unit
    having them as sub-modules.  *)
@@ -3204,7 +3163,7 @@ let package_signatures units =
         { md_type=Mty_signature sg;
           md_attributes=[];
           md_loc=Location.none;
-          md_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+          md_uid = Uid.mk ~current_unit:(Env.get_current_unit ());
         }
       in
       Sig_module(newid, Mp_present, md, Trec_not, Exported))
@@ -3246,7 +3205,7 @@ let package_units initial_env objfiles target_cmi =
     end;
     let dclsig = Env.read_signature target_cmi in
     let cc, _shape =
-      Includemod.compunit initial_env ~mark:Mark_both
+      Includemod.compunit initial_env ~mark:true
         "(obtained by packing)" sg mli dclsig shape
     in
     Cmt_format.save_cmt (Unit_info.companion_cmt target_cmi)
@@ -3274,9 +3233,7 @@ let package_units initial_env objfiles target_cmi =
 
 
 (* Error report *)
-
-
-open Printtyp
+open Printtyp.Doc
 
 let report_error ~loc _env = function
     Cannot_apply mty ->
@@ -3284,8 +3241,9 @@ let report_error ~loc _env = function
         "@[This module is not a functor; it has type@ %a@]"
         (Style.as_inline_code modtype) mty
   | Not_included errs ->
-      let main = Includemod_errorprinter.err_msgs errs in
-      Location.errorf ~loc "@[<v>Signature mismatch:@ %t@]" main
+      Location.errorf ~loc ~footnote:Out_type.Ident_conflicts.err_msg
+        "@[<v>Signature mismatch:@ %a@]"
+        Includemod_errorprinter.err_msgs errs
   | Cannot_eliminate_dependency mty ->
       Location.errorf ~loc
         "@[This functor has type@ %a@ \
@@ -3304,26 +3262,25 @@ let report_error ~loc _env = function
         Style.inline_code "with"
         (Style.as_inline_code longident) lid
   | With_mismatch(lid, explanation) ->
-      let main = Includemod_errorprinter.err_msgs explanation in
-      Location.errorf ~loc
+      Location.errorf ~loc ~footnote:Out_type.Ident_conflicts.err_msg
         "@[<v>\
            @[In this %a constraint, the new definition of %a@ \
              does not match its original definition@ \
              in the constrained signature:@]@ \
-         %t@]"
+         %a@]"
         Style.inline_code "with"
-        (Style.as_inline_code longident) lid main
+        (Style.as_inline_code longident) lid
+        Includemod_errorprinter.err_msgs explanation
   | With_makes_applicative_functor_ill_typed(lid, path, explanation) ->
-      let main = Includemod_errorprinter.err_msgs explanation in
-      Location.errorf ~loc
+      Location.errorf ~loc ~footnote:Out_type.Ident_conflicts.err_msg
         "@[<v>\
            @[This %a constraint on %a makes the applicative functor @ \
              type %a ill-typed in the constrained signature:@]@ \
-         %t@]"
+         %a@]"
         Style.inline_code "with"
         (Style.as_inline_code longident) lid
         Style.inline_code (Path.name path)
-        main
+        Includemod_errorprinter.err_msgs explanation
   | With_changes_module_alias(lid, id, path) ->
       Location.errorf ~loc
         "@[<v>\
@@ -3342,21 +3299,20 @@ let report_error ~loc _env = function
       let[@manual.ref "ss:module-type-substitution"] manual_ref =
         [ 12; 7; 3 ]
       in
-      let pp_constraint ppf () =
-        Format.fprintf ppf "%s := %a"
-          (Path.name p) Printtyp.modtype mty
+      let pp_constraint ppf (p,mty) =
+        fprintf ppf "%s := %a" (Path.name p) modtype mty
       in
       Location.errorf ~loc
         "This %a constraint@ %a@ makes a packed module ill-formed.@ %a"
         Style.inline_code "with"
-        (Style.as_inline_code pp_constraint) ()
+        (Style.as_inline_code pp_constraint) (p,mty)
         Misc.print_see_manual manual_ref
   | With_package_manifest (lid, ty) ->
       Location.errorf ~loc
         "In the constrained signature, type %a is defined to be %a.@ \
          Package %a constraints may only be used on abstract types."
         (Style.as_inline_code longident) lid
-        (Style.as_inline_code Printtyp.type_expr) ty
+        (Style.as_inline_code type_expr) ty
         Style.inline_code "with"
   | Repeated_name(kind, name) ->
       Location.errorf ~loc
@@ -3365,27 +3321,27 @@ let report_error ~loc _env = function
         (Sig_component_kind.to_string kind) Style.inline_code name
   | Non_generalizable { vars; expression } ->
       let[@manual.ref "ss:valuerestriction"] manual_ref = [ 6; 1; 2 ] in
-      prepare_for_printing vars;
-      add_type_to_preparation expression;
+      Out_type.prepare_for_printing vars;
+      Out_type.add_type_to_preparation expression;
       Location.errorf ~loc
         "@[The type of this expression,@ %a,@ \
          contains the non-generalizable type variable(s): %a.@ %a@]"
-        (Style.as_inline_code prepared_type_scheme) expression
+        (Style.as_inline_code Out_type.prepared_type_scheme) expression
         (pp_print_list ~pp_sep:(fun f () -> fprintf f ",@ ")
-           (Style.as_inline_code prepared_type_scheme)) vars
+           (Style.as_inline_code Out_type.prepared_type_scheme)) vars
         Misc.print_see_manual manual_ref
   | Non_generalizable_module { vars; mty; item } ->
       let[@manual.ref "ss:valuerestriction"] manual_ref = [ 6; 1; 2 ] in
-      prepare_for_printing vars;
-      add_type_to_preparation item.val_type;
+      Out_type.prepare_for_printing vars;
+      Out_type.add_type_to_preparation item.val_type;
       let sub =
         [ Location.msg ~loc:item.val_loc
             "The type of this value,@ %a,@ \
              contains the non-generalizable type variable(s) %a."
-            (Style.as_inline_code prepared_type_scheme)
+            (Style.as_inline_code Out_type.prepared_type_scheme)
             item.val_type
             (pp_print_list ~pp_sep:(fun f () -> fprintf f ",@ ")
-               @@ Style.as_inline_code prepared_type_scheme) vars
+               @@ Style.as_inline_code Out_type.prepared_type_scheme) vars
         ]
       in
       Location.errorf ~loc ~sub
@@ -3397,11 +3353,11 @@ let report_error ~loc _env = function
       Location.errorf ~loc
         "@[The interface %a@ declares values, not just types.@ \
            An implementation must be provided.@]"
-        Location.print_filename intf_name
+        Location.Doc.quoted_filename intf_name
   | Interface_not_compiled intf_name ->
       Location.errorf ~loc
         "@[Could not find the .cmi file for interface@ %a.@]"
-        Location.print_filename intf_name
+        Location.Doc.quoted_filename intf_name
   | Not_allowed_in_functor_body ->
       Location.errorf ~loc
         "@[This expression creates fresh types.@ %s@]"
@@ -3430,12 +3386,18 @@ let report_error ~loc _env = function
       Location.errorf ~loc
         "This is an alias for module %a, which is missing"
         (Style.as_inline_code path) p
+  | Cannot_alias p ->
+      Location.errorf ~loc
+        "Functor arguments, such as %a, cannot be aliased"
+        (Style.as_inline_code path) p
   | Cannot_scrape_package_type p ->
       Location.errorf ~loc
         "The type of this packed module refers to %a, which is missing"
         (Style.as_inline_code path) p
   | Badly_formed_signature (context, err) ->
-      Location.errorf ~loc "@[In %s:@ %a@]" context Typedecl.report_error err
+      Location.errorf ~loc "@[In %s:@ %a@]"
+        context
+        Typedecl.report_error_doc err
   | Cannot_hide_id Illegal_shadowing
       { shadowed_item_kind; shadowed_item_id; shadowed_item_loc;
         shadower_id; user_id; user_kind; user_loc } ->
@@ -3482,7 +3444,7 @@ let report_error ~loc _env = function
   | Invalid_type_subst_rhs ->
       Location.errorf ~loc "Only type synonyms are allowed on the right of %a"
         Style.inline_code  ":="
-  | Unpackable_local_modtype_subst p ->
+  | Non_packable_local_modtype_subst p ->
       let[@manual.ref "ss:module-type-substitution"] manual_ref =
         [ 12; 7; 3 ]
       in

diff --git a/typing/typemod.mli b/typing/typemod.mli
index dd4d1dc357d7720302d90c6c28f813d3398f73d0..8833a8e9d76a68ac66b4385c598149e99eba36e6 100644 (file)
--- a/typing/typemod.mli
+++ b/typing/typemod.mli
@@ -43,8 +43,6 @@ val type_implementation:
   Typedtree.implementation
 val type_interface:
         Env.t -> Parsetree.signature -> Typedtree.signature
-val transl_signature:
-        Env.t -> Parsetree.signature -> Typedtree.signature
 val check_nongen_signature:
         Env.t -> Types.signature -> unit
         (*
@@ -135,8 +133,9 @@ type error =
   | Badly_formed_signature of string * Typedecl.error
   | Cannot_hide_id of hiding_error
   | Invalid_type_subst_rhs
-  | Unpackable_local_modtype_subst of Path.t
+  | Non_packable_local_modtype_subst of Path.t
   | With_cannot_remove_packed_modtype of Path.t * module_type
+  | Cannot_alias of Path.t
 
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error

diff --git a/typing/typeopt.ml b/typing/typeopt.ml
index 0b131ee072999de48200d9381336984551dbc755..2b8fd3e95d5fd5026085ac741a952733e42034b0 100644 (file)
--- a/typing/typeopt.ml
+++ b/typing/typeopt.ml
@@ -24,7 +24,7 @@ open Lambda
 let scrape_ty env ty =
   match get_desc ty with
   | Tconstr _ ->
-      let ty = Ctype.expand_head_opt env (Ctype.correct_levels ty) in
+      let ty = Ctype.expand_head_opt env ty in
       begin match get_desc ty with
       | Tconstr (p, _, _) ->
           begin match Env.find_type p env with

diff --git a/typing/types.ml b/typing/types.ml
index 997e78d4923fb444982410ebd80a5490934dc63a..c66c98eaa8a3508bd7420d368d0d7e2507cbdbb1 100644 (file)
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -22,9 +22,13 @@ open Asttypes
 type transient_expr =
   { mutable desc: type_desc;
     mutable level: int;
-    mutable scope: int;
+    mutable scope: scope_field;
     id: int }
 
+and scope_field = int
+  (* bit field: 27 bits for scope (Ident.highest_scope = 100_000_000)
+     and at least 4 marks *)
+
 and type_expr = transient_expr
 
 and type_desc =
@@ -51,13 +55,14 @@ and row_desc =
 and fixed_explanation =
   | Univar of type_expr | Fixed_private | Reified of Path.t | Rigid
 and row_field = [`some] row_field_gen
+and row_field_cell = [`some | `none] row_field_gen ref
 and _ row_field_gen =
     RFpresent : type_expr option -> [> `some] row_field_gen
   | RFeither :
       { no_arg: bool;
         arg_type: type_expr list;
         matched: bool;
-        ext: [`some | `none] row_field_gen ref} -> [> `some] row_field_gen
+        ext: row_field_cell} -> [> `some] row_field_gen
   | RFabsent : [> `some] row_field_gen
   | RFnone : [> `none] row_field_gen
 
@@ -87,6 +92,8 @@ module TransientTypeOps = struct
   let equal t1 t2 = t1 == t2
 end
 
+module TransientTypeHash = Hashtbl.Make(TransientTypeOps)
+
 (* *)
 
 module Uid = Shape.Uid
@@ -176,6 +183,7 @@ module Variance = struct
   let unknown = 7
   let full = single Inv
   let covariant = single Pos
+  let contravariant = single Neg
   let swap f1 f2 v v' =
     set_if (mem f2 v) f1 (set_if (mem f1 v) f2 v')
   let conjugate v =
@@ -575,12 +583,48 @@ let repr t =
      repr_link1 t t'
  | _ -> t
 
+(* scope_field and marks *)
+
+let scope_mask = (1 lsl 27) - 1
+let marks_mask = (-1) lxor scope_mask
+let () = assert (Ident.highest_scope land marks_mask = 0)
+
+type type_mark =
+  | Mark of {mark: int; mutable marked: type_expr list}
+  | Hash of {visited: unit TransientTypeHash.t}
+let type_marks =
+  (* All the bits in marks_mask *)
+  List.init (Sys.int_size - 27) (fun x -> 1 lsl (x + 27))
+let available_marks = Local_store.s_ref type_marks
+let with_type_mark f =
+  match !available_marks with
+  | mark :: rem as old ->
+      available_marks := rem;
+      let mk = Mark {mark; marked = []} in
+      Misc.try_finally (fun () -> f mk) ~always: begin fun () ->
+        available_marks := old;
+        match mk with
+        | Mark {marked} ->
+            (* unmark marked type nodes *)
+            List.iter
+              (fun ty -> ty.scope <- ty.scope land ((-1) lxor mark))
+              marked
+        | Hash _ -> ()
+      end
+  | [] ->
+      (* When marks are exhausted, fall back to using a hash table *)
+      f (Hash {visited = TransientTypeHash.create 1})
+
 (* getters for type_expr *)
 
 let get_desc t = (repr t).desc
 let get_level t = (repr t).level
-let get_scope t = (repr t).scope
+let get_scope t = (repr t).scope land scope_mask
 let get_id t = (repr t).id
+let not_marked_node mark t =
+  match mark with
+  | Mark {mark} -> (repr t).scope land mark = 0
+  | Hash {visited} -> not (TransientTypeHash.mem visited (repr t))
 
 (* transient type_expr *)
 
@@ -589,12 +633,28 @@ module Transient_expr = struct
   let set_desc ty d = ty.desc <- d
   let set_stub_desc ty d = assert (ty.desc = Tvar None); ty.desc <- d
   let set_level ty lv = ty.level <- lv
-  let set_scope ty sc = ty.scope <- sc
+  let get_scope ty = ty.scope land scope_mask
+  let get_marks ty = ty.scope lsr 27
+  let set_scope ty sc =
+    if (sc land marks_mask <> 0) then
+      invalid_arg "Types.Transient_expr.set_scope";
+    ty.scope <- (ty.scope land marks_mask) lor sc
+  let try_mark_node mark ty =
+    match mark with
+    | Mark ({mark} as mk) ->
+        (ty.scope land mark = 0) && (* mark type node when not marked *)
+        (ty.scope <- ty.scope lor mark; mk.marked <- ty :: mk.marked; true)
+    | Hash {visited} ->
+        not (TransientTypeHash.mem visited ty) &&
+        (TransientTypeHash.add visited ty (); true)
   let coerce ty = ty
   let repr = repr
   let type_expr ty = ty
 end
 
+(* setting marks *)
+let try_mark_node mark t = Transient_expr.try_mark_node mark (repr t)
+
 (* Comparison for [type_expr]; cannot be used for functors *)
 
 let eq_type t1 t2 = t1 == t2 || repr t1 == repr t2
@@ -721,8 +781,7 @@ let match_row_field ~present ~absent ~either (f : row_field) =
         | RFnone -> None
         | RFeither _ | RFpresent _ | RFabsent as e -> Some e
       in
-      either no_arg arg_type matched e
-
+      either no_arg arg_type matched (ext,e)
 
 (**** Some type creators ****)
 
@@ -730,13 +789,10 @@ let new_id = Local_store.s_ref (-1)
 
 let create_expr = Transient_expr.create
 
-let newty3 ~level ~scope desc  =
+let proto_newty3 ~level ~scope desc  =
   incr new_id;
   create_expr desc ~level ~scope ~id:!new_id
 
-let newty2 ~level desc =
-  newty3 ~level ~scope:Ident.lowest_scope desc
-
                   (**********************************)
                   (*  Utilities for backtracking    *)
                   (**********************************)
@@ -795,13 +851,16 @@ let set_level ty level =
     if ty.id <= !last_snapshot then log_change (Clevel (ty, ty.level));
     Transient_expr.set_level ty level
   end
+
 (* TODO: introduce a guard and rename it to set_higher_scope? *)
 let set_scope ty scope =
   let ty = repr ty in
-  if scope <> ty.scope then begin
-    if ty.id <= !last_snapshot then log_change (Cscope (ty, ty.scope));
+  let prev_scope = ty.scope land marks_mask in
+  if scope <> prev_scope then begin
+    if ty.id <= !last_snapshot then log_change (Cscope (ty, prev_scope));
     Transient_expr.set_scope ty scope
   end
+
 let set_univar rty ty =
   log_change (Cuniv (rty, !rty)); rty := Some ty
 let set_name nm v =

diff --git a/typing/types.mli b/typing/types.mli
index 7ed7fc971eec793161faeb81b15f9cc12747b9cc..ca0cc6e061181f0cfddcacd67017424eb3d4f88c 100644 (file)
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -221,18 +221,36 @@ val get_level: type_expr -> int
 val get_scope: type_expr -> int
 val get_id: type_expr -> int
 
+(** Access to marks. They are stored in the scope field. *)
+type type_mark
+val with_type_mark: (type_mark -> 'a) -> 'a
+        (* run a computation using exclusively an available type mark *)
+
+val not_marked_node: type_mark -> type_expr -> bool
+        (* Return true if a type node is not yet marked *)
+
+val try_mark_node: type_mark -> type_expr -> bool
+        (* Mark a type node if it is not yet marked.
+           Marks will be automatically removed when leaving the
+           scope of [with_type_mark].
+
+           Return false if it was already marked *)
+
 (** Transient [type_expr].
     Should only be used immediately after [Transient_expr.repr] *)
 type transient_expr = private
       { mutable desc: type_desc;
         mutable level: int;
-        mutable scope: int;
+        mutable scope: scope_field;
         id: int }
+and scope_field (* abstract *)
 
 module Transient_expr : sig
   (** Operations on [transient_expr] *)
 
   val create: type_desc -> level: int -> scope: int -> id: int -> transient_expr
+  val get_scope: transient_expr -> int
+  val get_marks: transient_expr -> int
   val set_desc: transient_expr -> type_desc -> unit
   val set_level: transient_expr -> int -> unit
   val set_scope: transient_expr -> int -> unit
@@ -244,18 +262,17 @@ module Transient_expr : sig
   val set_stub_desc: type_expr -> type_desc -> unit
       (** Instantiate a not yet instantiated stub.
           Fail if already instantiated. *)
+
+  val try_mark_node: type_mark -> transient_expr -> bool
 end
 
 val create_expr: type_desc -> level: int -> scope: int -> id: int -> type_expr
 
 (** Functions and definitions moved from Btype *)
 
-val newty3: level:int -> scope:int -> type_desc -> type_expr
+val proto_newty3: level:int -> scope:int -> type_desc -> transient_expr
         (** Create a type with a fresh id *)
 
-val newty2: level:int -> type_desc -> type_expr
-        (** Create a type with a fresh id and no scope *)
-
 module TransientTypeOps : sig
   (** Comparisons for functors *)
 
@@ -265,6 +282,8 @@ module TransientTypeOps : sig
   val hash : t -> int
 end
 
+module TransientTypeHash : Hashtbl.S with type key = transient_expr
+
 (** Comparisons for [type_expr]; cannot be used for functors *)
 
 val eq_type: type_expr -> type_expr -> bool
@@ -346,12 +365,15 @@ val rf_either_of: type_expr option -> row_field
 val eq_row_field_ext: row_field -> row_field -> bool
 val changed_row_field_exts: row_field list -> (unit -> unit) -> bool
 
+type row_field_cell
 val match_row_field:
     present:(type_expr option -> 'a) ->
     absent:(unit -> 'a) ->
-    either:(bool -> type_expr list -> bool -> row_field option ->'a) ->
+    either:(bool -> type_expr list -> bool ->
+            row_field_cell * row_field option ->'a) ->
     row_field -> 'a
 
+
 (* *)
 
 module Uid = Shape.Uid
@@ -413,6 +435,7 @@ module Variance : sig
   val null : t               (* no occurrence *)
   val full : t               (* strictly invariant (all flags) *)
   val covariant : t          (* strictly covariant (May_pos, Pos and Inj) *)
+  val contravariant : t      (* strictly contravariant *)
   val unknown : t            (* allow everything, guarantee nothing *)
   val union  : t -> t -> t
   val inter  : t -> t -> t

diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 2d7d690790032aa2bda2dfc9705e7312e4b8ad41..1be07aa3f5240c08fef0156bf268e84509c7df75 100644 (file)
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -218,7 +218,6 @@ end = struct
         promoted vars
 
   let check_poly_univars env loc vars =
-    vars |> List.iter (fun (_, p) -> generalize p.univar);
     let univars =
       vars |> List.map (fun (name, {univar=ty1; _ }) ->
       let v = Btype.proxy ty1 in
@@ -350,8 +349,6 @@ let sort_constraints_no_duplicates loc env l =
 
 (* Translation of type expressions *)
 
-let generalize_ctyp typ = generalize typ.ctyp_type
-
 let strict_ident c = (c = '_' || c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z')
 
 let validate_name = function
@@ -519,7 +516,7 @@ and transl_type_aux env ~row_context ~aliased ~policy styp =
           ty
         with Not_found ->
           let t, ty =
-            with_local_level_if_principal begin fun () ->
+            with_local_level_generalize_structure_if_principal begin fun () ->
               let t = newvar () in
               (* Use the whole location, which is used by [Type_mismatch]. *)
               TyVarEnv.remember_used alias.txt t styp.ptyp_loc;
@@ -530,7 +527,6 @@ and transl_type_aux env ~row_context ~aliased ~policy styp =
               end;
               (t, ty)
             end
-            ~post: (fun (t, _) -> generalize_structure t)
           in
           let t = instance t in
           let px = Btype.proxy t in
@@ -645,14 +641,13 @@ and transl_type_aux env ~row_context ~aliased ~policy styp =
   | Ptyp_poly(vars, st) ->
       let vars = List.map (fun v -> v.txt) vars in
       let new_univars, cty =
-        with_local_level begin fun () ->
+        with_local_level_generalize begin fun () ->
           let new_univars = TyVarEnv.make_poly_univars vars in
           let cty = TyVarEnv.with_univars new_univars begin fun () ->
             transl_type env ~policy ~row_context st
           end in
           (new_univars, cty)
         end
-        ~post:(fun (_,cty) -> generalize_ctyp cty)
       in
       let ty = cty.ctyp_type in
       let ty_list = TyVarEnv.check_poly_univars env styp.ptyp_loc new_univars in
@@ -760,8 +755,8 @@ and transl_fields env ~policy ~row_context o fields =
 
 
 (* Make the rows "fixed" in this type, to make universal check easier *)
-let rec make_fixed_univars ty =
-  if Btype.try_mark_node ty then
+let rec make_fixed_univars mark ty =
+  if try_mark_node mark ty then
     begin match get_desc ty with
     | Tvariant row ->
         let Row {fields; more; name; closed} = row_repr row in
@@ -778,18 +773,17 @@ let rec make_fixed_univars ty =
             (Tvariant
                (create_row ~fields ~more ~name ~closed
                   ~fixed:(Some (Univar more))));
-        Btype.iter_row make_fixed_univars row
+        Btype.iter_row (make_fixed_univars mark) row
     | _ ->
-        Btype.iter_type_expr make_fixed_univars ty
+        Btype.iter_type_expr (make_fixed_univars mark) ty
     end
 
+let make_fixed_univars ty =
+  with_type_mark (fun mark -> make_fixed_univars mark ty)
+
 let transl_type env policy styp =
   transl_type env ~policy ~row_context:[] styp
 
-let make_fixed_univars ty =
-  make_fixed_univars ty;
-  Btype.unmark_type ty
-
 let transl_simple_type env ?univars ~closed styp =
   TyVarEnv.reset_locals ?univars ();
   let policy = TyVarEnv.(if closed then fixed_policy else extensible_policy) in
@@ -802,7 +796,7 @@ let transl_simple_type_univars env styp =
   TyVarEnv.reset_locals ();
   let typ, univs =
     TyVarEnv.collect_univars begin fun () ->
-      with_local_level ~post:generalize_ctyp begin fun () ->
+      with_local_level_generalize begin fun () ->
         let policy = TyVarEnv.univars_policy in
         let typ = transl_type env policy styp in
         TyVarEnv.globalize_used_variables policy env ();
@@ -816,7 +810,7 @@ let transl_simple_type_univars env styp =
 let transl_simple_type_delayed env styp =
   TyVarEnv.reset_locals ();
   let typ, force =
-    with_local_level begin fun () ->
+    with_local_level_generalize begin fun () ->
       let policy = TyVarEnv.extensible_policy in
       let typ = transl_type env policy styp in
       make_fixed_univars typ.ctyp_type;
@@ -826,8 +820,6 @@ let transl_simple_type_delayed env styp =
       let force = TyVarEnv.globalize_used_variables policy env in
       (typ, force)
     end
-    (* Generalize everything except the variables that were just globalized. *)
-    ~post:(fun (typ,_) -> generalize_ctyp typ)
   in
   (typ, instance typ.ctyp_type, force)
 
@@ -836,13 +828,12 @@ let transl_type_scheme env styp =
   | Ptyp_poly (vars, st) ->
      let vars = List.map (fun v -> v.txt) vars in
      let univars, typ =
-       with_local_level begin fun () ->
+       with_local_level_generalize begin fun () ->
          TyVarEnv.reset ();
          let univars = TyVarEnv.make_poly_univars vars in
          let typ = transl_simple_type env ~univars ~closed:true st in
          (univars, typ)
        end
-       ~post:(fun (_,typ) -> generalize_ctyp typ)
      in
      let _ = TyVarEnv.instance_poly_univars env styp.ptyp_loc univars in
      { ctyp_desc = Ttyp_poly (vars, typ);
@@ -851,20 +842,20 @@ let transl_type_scheme env styp =
        ctyp_loc = styp.ptyp_loc;
        ctyp_attributes = styp.ptyp_attributes }
   | _ ->
-      with_local_level
+      with_local_level_generalize
         (fun () -> TyVarEnv.reset (); transl_simple_type env ~closed:false styp)
-        ~post:generalize_ctyp
 
 
 (* Error report *)
 
-open Format
-open Printtyp
+open Format_doc
+open Printtyp.Doc
 module Style = Misc.Style
-let pp_tag ppf t = Format.fprintf ppf "`%s" t
-
+let pp_tag ppf t = fprintf ppf "`%s" t
+let pp_out_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty
+let pp_type ppf ty = Style.as_inline_code Printtyp.Doc.type_expr ppf ty
 
-let report_error env ppf = function
+let report_error_doc env ppf = function
   | Unbound_type_variable (name, in_scope_names) ->
     fprintf ppf "The type variable %a is unbound in this type declaration.@ %a"
       Style.inline_code name
@@ -882,21 +873,19 @@ let report_error env ppf = function
       (Style.as_inline_code longident) lid expected provided
   | Bound_type_variable name ->
       fprintf ppf "Already bound type parameter %a"
-        (Style.as_inline_code Pprintast.tyvar) name
+        (Style.as_inline_code Pprintast.Doc.tyvar) name
   | Recursive_type ->
     fprintf ppf "This type is recursive"
   | Type_mismatch trace ->
-      Printtyp.report_unification_error ppf Env.empty trace
-        (function ppf ->
-           fprintf ppf "This type")
-        (function ppf ->
-           fprintf ppf "should be an instance of type")
+      let msg = Format_doc.Doc.msg in
+      Errortrace_report.unification ppf Env.empty trace
+        (msg "This type")
+        (msg "should be an instance of type")
   | Alias_type_mismatch trace ->
-      Printtyp.report_unification_error ppf Env.empty trace
-        (function ppf ->
-           fprintf ppf "This alias is bound to type")
-        (function ppf ->
-           fprintf ppf "but is used as an instance of type")
+      let msg = Format_doc.Doc.msg in
+      Errortrace_report.unification ppf Env.empty trace
+        (msg "This alias is bound to type")
+        (msg "but is used as an instance of type")
   | Present_has_conjunction l ->
       fprintf ppf "The present constructor %a has a conjunctive type"
         Style.inline_code l
@@ -913,18 +902,17 @@ let report_error env ppf = function
         Style.inline_code ">"
         (Style.as_inline_code pp_tag) l
   | Constructor_mismatch (ty, ty') ->
-      let pp_type ppf ty = Style.as_inline_code !Oprint.out_type ppf ty in
       wrap_printing_env ~error:true env (fun ()  ->
-        Printtyp.prepare_for_printing [ty; ty'];
+        Out_type.prepare_for_printing [ty; ty'];
         fprintf ppf "@[<hov>%s %a@ %s@ %a@]"
           "This variant type contains a constructor"
-          pp_type (tree_of_typexp Type ty)
+          pp_out_type (Out_type.tree_of_typexp Type ty)
           "which should be"
-          pp_type (tree_of_typexp Type ty'))
+          pp_out_type (Out_type.tree_of_typexp Type ty'))
   | Not_a_variant ty ->
       fprintf ppf
         "@[The type %a@ does not expand to a polymorphic variant type@]"
-        (Style.as_inline_code Printtyp.type_expr) ty;
+        pp_type ty;
       begin match get_desc ty with
         | Tvar (Some s) ->
            (* PR#7012: help the user that wrote 'Foo instead of `Foo *)
@@ -943,14 +931,13 @@ let report_error env ppf = function
   | Cannot_quantify (name, v) ->
       fprintf ppf
         "@[<hov>The universal type variable %a cannot be generalized:@ "
-        (Style.as_inline_code Pprintast.tyvar) name;
+        (Style.as_inline_code Pprintast.Doc.tyvar) name;
       if Btype.is_Tvar v then
         fprintf ppf "it escapes its scope"
       else if Btype.is_Tunivar v then
         fprintf ppf "it is already bound to another variable"
       else
-        fprintf ppf "it is bound to@ %a"
-          (Style.as_inline_code Printtyp.type_expr) v;
+        fprintf ppf "it is bound to@ %a" pp_type v;
       fprintf ppf ".@]";
   | Multiple_constraints_on_type s ->
       fprintf ppf "Multiple constraints for type %a"
@@ -959,8 +946,8 @@ let report_error env ppf = function
       wrap_printing_env ~error:true env (fun ()  ->
         fprintf ppf "@[<hov>Method %a has type %a,@ which should be %a@]"
           Style.inline_code l
-          (Style.as_inline_code Printtyp.type_expr) ty
-          (Style.as_inline_code Printtyp.type_expr) ty')
+          pp_type ty
+          pp_type ty')
   | Opened_object nm ->
       fprintf ppf
         "Illegal open object type%a"
@@ -969,15 +956,17 @@ let report_error env ppf = function
            | None -> fprintf ppf "") nm
   | Not_an_object ty ->
       fprintf ppf "@[The type %a@ is not an object type@]"
-        (Style.as_inline_code Printtyp.type_expr) ty
+        pp_type ty
 
 let () =
   Location.register_error_of_exn
     (function
       | Error (loc, env, err) ->
-        Some (Location.error_of_printer ~loc (report_error env) err)
+        Some (Location.error_of_printer ~loc (report_error_doc env) err)
       | Error_forward err ->
         Some err
       | _ ->
         None
     )
+
+let report_error = Format_doc.compat1 report_error_doc

diff --git a/typing/typetexp.mli b/typing/typetexp.mli
index 34243b1d42f81fdbf0d4cef38495d968f242f021..bd03489f323719173175c455ca03978fa7f298cb 100644 (file)
--- a/typing/typetexp.mli
+++ b/typing/typetexp.mli
@@ -95,7 +95,8 @@ type error =
 
 exception Error of Location.t * Env.t * error
 
-val report_error: Env.t -> Format.formatter -> error -> unit
+val report_error: Env.t -> error Format_doc.format_printer
+val report_error_doc: Env.t -> error Format_doc.printer
 
 (* Support for first-class modules. *)
 val transl_modtype_longident:  (* from Typemod *)

diff --git a/typing/untypeast.ml b/typing/untypeast.ml
index 50fbbf8bd95f85b7deca04b73f8fe8c40297f883..07e4e86437167315409b727c8593f399c92e869d 100644 (file)
--- a/typing/untypeast.ml
+++ b/typing/untypeast.ml
@@ -121,13 +121,13 @@ let rec extract_letop_patterns n pat =
 (** Mapping functions. *)
 
 let constant = function
-  | Const_char c -> Pconst_char c
-  | Const_string (s,loc,d) -> Pconst_string (s,loc,d)
-  | Const_int i -> Pconst_integer (Int.to_string i, None)
-  | Const_int32 i -> Pconst_integer (Int32.to_string i, Some 'l')
-  | Const_int64 i -> Pconst_integer (Int64.to_string i, Some 'L')
-  | Const_nativeint i -> Pconst_integer (Nativeint.to_string i, Some 'n')
-  | Const_float f -> Pconst_float (f,None)
+  | Const_char c -> Const.char c
+  | Const_string (s,loc,d) -> Const.string ?quotation_delimiter:d ~loc s
+  | Const_int i -> Const.integer (Int.to_string i)
+  | Const_int32 i -> Const.integer ~suffix:'l' (Int32.to_string i)
+  | Const_int64 i -> Const.integer ~suffix:'L' (Int64.to_string i)
+  | Const_nativeint i -> Const.integer ~suffix:'n' (Nativeint.to_string i)
+  | Const_float f -> Const.float f
 
 let attribute sub a = {
     attr_name = map_loc sub a.attr_name;
@@ -450,10 +450,32 @@ let expression sub exp =
                 None -> list
               | Some exp -> (label, sub.expr sub exp) :: list
           ) list [])
-    | Texp_match (exp, cases, _) ->
-      Pexp_match (sub.expr sub exp, List.map (sub.case sub) cases)
-    | Texp_try (exp, cases) ->
-        Pexp_try (sub.expr sub exp, List.map (sub.case sub) cases)
+    | Texp_match (exp, cases, eff_cases, _) ->
+      let merged_cases = List.map (sub.case sub) cases
+        @ List.map
+          (fun c ->
+            let uc = sub.case sub c in
+            let pat = { uc.pc_lhs
+                        (* XXX KC: The 2nd argument of Ppat_effect is wrong *)
+                        with ppat_desc = Ppat_effect (uc.pc_lhs, uc.pc_lhs) }
+            in
+            { uc with pc_lhs = pat })
+          eff_cases
+      in
+      Pexp_match (sub.expr sub exp, merged_cases)
+    | Texp_try (exp, exn_cases, eff_cases) ->
+        let merged_cases = List.map (sub.case sub) exn_cases
+        @ List.map
+          (fun c ->
+            let uc = sub.case sub c in
+            let pat = { uc.pc_lhs
+                        (* XXX KC: The 2nd argument of Ppat_effect is wrong *)
+                        with ppat_desc = Ppat_effect (uc.pc_lhs, uc.pc_lhs) }
+            in
+            { uc with pc_lhs = pat })
+          eff_cases
+        in
+        Pexp_try (sub.expr sub exp, merged_cases)
     | Texp_tuple list ->
         Pexp_tuple (List.map (sub.expr sub) list)
     | Texp_construct (lid, _, args) ->

diff --git a/typing/value_rec_check.ml b/typing/value_rec_check.ml
index e36f2b329309d161939966ae8b3650fecdaf2eba..4f4e4d052d38c4abdfa3d85c0dcedb093c8ed5f2 100644 (file)
--- a/typing/value_rec_check.ml
+++ b/typing/value_rec_check.ml
@@ -154,7 +154,7 @@ let classify_expression : Typedtree.expression -> sd =
         (* Note on module presence:
            For absent modules (i.e. module aliases), the module being bound
            does not have a physical representation, but its size can still be
-           derived from the alias itself, so we can re-use the same code as
+           derived from the alias itself, so we can reuse the same code as
            for modules that are present. *)
         let size = classify_module_expression env mexp in
         let env = Ident.add mid size env in
@@ -592,8 +592,8 @@ let rec expression : Typedtree.expression -> term_judg =
       value_bindings rec_flag bindings >> expression body
     | Texp_letmodule (x, _, _, mexp, e) ->
       module_binding (x, mexp) >> expression e
-    | Texp_match (e, cases, _) ->
-      (*
+    | Texp_match (e, cases, eff_cases, _) ->
+      (* TODO: update comment below for eff_cases
          (Gi; mi |- pi -> ei : m)^i
          G |- e : sum(mi)^i
          ----------------------------------------------
@@ -603,7 +603,11 @@ let rec expression : Typedtree.expression -> term_judg =
         let pat_envs, pat_modes =
           List.split (List.map (fun c -> case c mode) cases) in
         let env_e = expression e (List.fold_left Mode.join Ignore pat_modes) in
-        Env.join_list (env_e :: pat_envs))
+        let eff_envs, eff_modes =
+          List.split (List.map (fun c -> case c mode) eff_cases) in
+        let eff_e = expression e (List.fold_left Mode.join Ignore eff_modes) in
+        Env.join_list
+          ((Env.join_list (env_e :: pat_envs)) :: (eff_e :: eff_envs)))
     | Texp_for (_, _, low, high, _, body) ->
       (*
         G1 |- low: m[Dereference]
@@ -825,7 +829,7 @@ let rec expression : Typedtree.expression -> term_judg =
       modexp mexp
     | Texp_object (clsstrct, _) ->
       class_structure clsstrct
-    | Texp_try (e, cases) ->
+    | Texp_try (e, cases, eff_cases) ->
       (*
         G |- e: m      (Gi; _ |- pi -> ei : m)^i
         --------------------------------------------
@@ -839,6 +843,7 @@ let rec expression : Typedtree.expression -> term_judg =
       join [
         expression e;
         list case_env cases;
+        list case_env eff_cases;
       ]
     | Texp_override (pth, fields) ->
       (*

diff --git a/utils/ccomp.ml b/utils/ccomp.ml
index afde5a6567cc6125a60750fb549b6951af06c58e..defe4d2a4b92faa4d732125dd53a20fc2cfcea09 100644 (file)
--- a/utils/ccomp.ml
+++ b/utils/ccomp.ml
@@ -100,12 +100,11 @@ let compile_file ?output ?(opt="") ?stable_name name =
          (match !Clflags.c_compiler with
           | Some cc -> cc
           | None ->
-              (* #7678: ocamlopt only calls the C compiler to process .c files
-                 from the command line, and the behaviour between
-                 ocamlc/ocamlopt should be identical. *)
-              (String.concat " " [Config.c_compiler;
-                                  Config.ocamlc_cflags;
-                                  Config.ocamlc_cppflags]))
+              let (cflags, cppflags) =
+                  if !Clflags.native_code
+                  then (Config.native_cflags, Config.native_cppflags)
+                  else (Config.bytecode_cflags, Config.bytecode_cppflags) in
+              (String.concat " " [Config.c_compiler; cflags; cppflags]))
          debug_prefix_map
          (match output with
           | None -> ""
@@ -208,9 +207,3 @@ let call_linker mode output_name files extra =
     in
     command cmd
   )
-
-let linker_is_flexlink =
-  (* Config.mkexe, Config.mkdll and Config.mkmaindll are all flexlink
-     invocations for the native Windows ports and for Cygwin, if shared library
-     support is enabled. *)
-  Sys.win32 || Config.supports_shared_libraries && Sys.cygwin

diff --git a/utils/ccomp.mli b/utils/ccomp.mli
index 84f5041871c46bf0de8671a80effa368f2ce09de..38dfd5486f37a75dc2c171738bd85cb610b6827a 100644 (file)
--- a/utils/ccomp.mli
+++ b/utils/ccomp.mli
@@ -36,5 +36,3 @@ type link_mode =
   | Partial
 
 val call_linker: link_mode -> string -> string list -> string -> int
-
-val linker_is_flexlink : bool

diff --git a/utils/clflags.ml b/utils/clflags.ml
index ed6b6ce80095ce8938b73b64c121aed7330cab42..be10f235221917a483ffb569b011cf912fd81e4c 100644 (file)
--- a/utils/clflags.ml
+++ b/utils/clflags.ml
@@ -118,6 +118,8 @@ and dump_flambda_verbose = ref false    (* -dflambda-verbose *)
 and dump_instr = ref false              (* -dinstr *)
 and keep_camlprimc_file = ref false     (* -dcamlprimc *)
 
+let keyword_edition: string option ref = ref None
+
 let keep_asm_file = ref false           (* -S *)
 let optimize_for_speed = ref true       (* -compact *)
 and opaque = ref false                  (* -opaque *)
@@ -165,8 +167,8 @@ let shared = ref false (* -shared *)
 let dlcode = ref true (* not -nodynlink *)
 
 let pic_code = ref (match Config.architecture with (* -fPIC *)
-                     | "amd64" -> true
-                     | _       -> false)
+                     | "amd64" | "s390x" -> true
+                     | _                 -> false)
 
 let runtime_variant = ref ""
 
@@ -551,6 +553,23 @@ let set_save_ir_after pass enabled =
   in
   save_ir_after := new_passes
 
+let parse_keyword_edition s =
+  let parse_version s =
+  let bad_version () =
+    raise (Arg.Bad "Ill-formed version in keywords flag,\n\
+                    the supported format is <major>.<minor>, for example 5.2 .")
+  in
+  if s = "" then None else match String.split_on_char '.' s with
+  | [] | [_] | _ :: _ :: _ :: _ -> bad_version ()
+  | [major;minor] -> match int_of_string_opt major, int_of_string_opt minor with
+    | Some major, Some minor -> Some (major,minor)
+    | _ -> bad_version ()
+  in
+  match String.split_on_char '+' s with
+  | [] -> None, []
+  | [s] -> parse_version s, []
+  | v :: rest -> parse_version v, rest
+
 module String = Misc.Stdlib.String
 
 let arg_spec = ref []

diff --git a/utils/clflags.mli b/utils/clflags.mli
index 0dba055eba84014db6266c84990c226131749756..248a7d86e62067092b5ad849e12a23e2776189cf 100644 (file)
--- a/utils/clflags.mli
+++ b/utils/clflags.mli
@@ -223,6 +223,9 @@ val set_dumped_pass : string -> bool -> unit
 val dump_into_file : bool ref
 val dump_dir : string option ref
 
+val keyword_edition: string option ref
+val parse_keyword_edition: string -> (int*int) option * string list
+
 (* Support for flags that can also be set from an environment variable *)
 type 'a env_reader = {
   parse : string -> 'a option;

diff --git a/utils/config.common.ml.in b/utils/config.common.ml.in
index 15043dae8432eaa9452f190e5a91202d5d437944..3603fe6c60c766622aead6aafddeac53e377f269 100644 (file)
--- a/utils/config.common.ml.in
+++ b/utils/config.common.ml.in
@@ -77,10 +77,14 @@ let configuration_variables () =
   p "standard_library" standard_library;
   p "ccomp_type" ccomp_type;
   p "c_compiler" c_compiler;
-  p "ocamlc_cflags" ocamlc_cflags;
-  p "ocamlc_cppflags" ocamlc_cppflags;
-  p "ocamlopt_cflags" ocamlopt_cflags;
-  p "ocamlopt_cppflags" ocamlopt_cppflags;
+  p "bytecode_cflags" bytecode_cflags;
+  p "ocamlc_cflags" bytecode_cflags;
+  p "bytecode_cppflags" bytecode_cppflags;
+  p "ocamlc_cppflags" bytecode_cppflags;
+  p "native_cflags" native_cflags;
+  p "ocamlopt_cflags" native_cflags;
+  p "native_cppflags" native_cppflags;
+  p "ocamlopt_cppflags" native_cppflags;
   p "bytecomp_c_compiler" bytecomp_c_compiler;
   p "native_c_compiler" native_c_compiler;
   p "bytecomp_c_libraries" bytecomp_c_libraries;

diff --git a/utils/config.fixed.ml b/utils/config.fixed.ml
index 9374f4464acc7a3b481627477816f6d50ea13b04..807b9293553196a47c4185d4c31c7d50df9bb27b 100644 (file)
--- a/utils/config.fixed.ml
+++ b/utils/config.fixed.ml
@@ -27,10 +27,10 @@ let c_compiler = boot_cannot_call "the C compiler"
 let c_output_obj = ""
 let c_has_debug_prefix_map = false
 let as_has_debug_prefix_map = false
-let ocamlc_cflags = ""
-let ocamlc_cppflags = ""
-let ocamlopt_cflags = ""
-let ocamlopt_cppflags = ""
+let bytecode_cflags = ""
+let bytecode_cppflags = ""
+let native_cflags = ""
+let native_cppflags = ""
 let bytecomp_c_libraries = ""
 let bytecomp_c_compiler = ""
 let native_c_compiler = c_compiler

diff --git a/utils/config.generated.ml.in b/utils/config.generated.ml.in
index 1d22c1d7f619f629ddc941a46168d44966b85f4a..aa034554096827bdf9936cf96b3bb8b70d8df1af 100644 (file)
--- a/utils/config.generated.ml.in
+++ b/utils/config.generated.ml.in
@@ -27,23 +27,22 @@ let c_compiler = {@QS@|@CC@|@QS@}
 let c_output_obj = {@QS@|@outputobj@|@QS@}
 let c_has_debug_prefix_map = @cc_has_debug_prefix_map@
 let as_has_debug_prefix_map = @as_has_debug_prefix_map@
-let ocamlc_cflags = {@QS@|@ocamlc_cflags@|@QS@}
-let ocamlc_cppflags = {@QS@|@ocamlc_cppflags@|@QS@}
-(* #7678: ocamlopt uses these only to compile .c files, and the behaviour for
-          the two drivers should be identical. *)
-let ocamlopt_cflags = {@QS@|@ocamlc_cflags@|@QS@}
-let ocamlopt_cppflags = {@QS@|@ocamlc_cppflags@|@QS@}
+let bytecode_cflags = {@QS@|@bytecode_cflags@|@QS@}
+let bytecode_cppflags = {@QS@|@bytecode_cppflags@|@QS@}
+let native_cflags = {@QS@|@native_cflags@|@QS@}
+let native_cppflags = {@QS@|@native_cppflags@|@QS@}
+
 let bytecomp_c_libraries = {@QS@|@zstd_libs@ @cclibs@|@QS@}
 (* bytecomp_c_compiler and native_c_compiler have been supported for a
    long time and are retained for backwards compatibility.
    For programs that don't need compatibility with older OCaml releases
    the recommended approach is to use the constituent variables
-   c_compiler, ocamlc_cflags, ocamlc_cppflags etc., directly.
+   c_compiler, {bytecode,native}_c[pp]flags etc. directly.
 *)
 let bytecomp_c_compiler =
-  c_compiler ^ " " ^ ocamlc_cflags ^ " " ^ ocamlc_cppflags
+  c_compiler ^ " " ^ bytecode_cflags ^ " " ^ bytecode_cppflags
 let native_c_compiler =
-  c_compiler ^ " " ^ ocamlopt_cflags ^ " " ^ ocamlopt_cppflags
+  c_compiler ^ " " ^ native_cflags ^ " " ^ native_cppflags
 let native_c_libraries = {@QS@|@cclibs@|@QS@}
 let native_ldflags = {@QS@|@native_ldflags@|@QS@}
 let native_pack_linker = {@QS@|@PACKLD@|@QS@}

diff --git a/utils/config.mli b/utils/config.mli
index f1e1d04bd4392cf6215cef06c2be8302e0a66ae9..51e31a37294c2b69fa99038119a73f1aedbeb24a 100644 (file)
--- a/utils/config.mli
+++ b/utils/config.mli
@@ -47,21 +47,17 @@ val c_has_debug_prefix_map : bool
 val as_has_debug_prefix_map : bool
 (** Whether the assembler supports --debug-prefix-map *)
 
-val ocamlc_cflags : string
+val bytecode_cflags : string
 (** The flags ocamlc should pass to the C compiler *)
 
-val ocamlc_cppflags : string
+val bytecode_cppflags : string
 (** The flags ocamlc should pass to the C preprocessor *)
 
-val ocamlopt_cflags : string
-  [@@ocaml.deprecated "Use ocamlc_cflags instead."]
-(** @deprecated {!ocamlc_cflags} should be used instead.
-    The flags ocamlopt should pass to the C compiler *)
+val native_cflags : string
+(** The flags ocamlopt should pass to the C compiler *)
 
-val ocamlopt_cppflags : string
-  [@@ocaml.deprecated "Use ocamlc_cppflags instead."]
-(** @deprecated {!ocamlc_cppflags} should be used instead.
-    The flags ocamlopt should pass to the C preprocessor *)
+val native_cppflags : string
+(** The flags ocamlopt should pass to the C preprocessor *)
 
 val bytecomp_c_libraries: string
 (** The C libraries to link with custom runtimes *)

diff --git a/utils/diffing.ml b/utils/diffing.ml
index 94391803ae664c11947a7ff5688dce13b189979d..f2c336d9c4bc2412004a12e4fdeda2e9165eafb1 100644 (file)
--- a/utils/diffing.ml
+++ b/utils/diffing.ml
@@ -42,10 +42,11 @@ let style = function
   | Modification -> Misc.Style.[ FG Magenta; Bold]
 
 let prefix ppf (pos, p) =
+  let open Format_doc in
   let sty = style p in
-  Format.pp_open_stag ppf (Misc.Style.Style sty);
-  Format.fprintf ppf "%i. " pos;
-  Format.pp_close_stag ppf ()
+  pp_open_stag ppf (Misc.Style.Style sty);
+  fprintf ppf "%i. " pos;
+  pp_close_stag ppf ()
 
 
 let (let*) = Option.bind
@@ -346,7 +347,22 @@ let compute_inner_cell tbl i j =
     compute_proposition (i-1) (j-1) diff
   in
   let*! newweight, (diff, localstate) =
-    select_best_proposition [diag;del;insert]
+    (* The order of propositions is important here:
+       the call [select_best_proposition [P_0, ...; P_n]] keeps the first
+       proposition with minimal weight as the representative path for this
+       weight class at the current matrix position.
+
+       By induction, the representative path for the minimal weight class will
+       be the smallest path according to the reverse lexical order induced by
+       the element order [[P_0;...; P_n]].
+
+       This is why we choose to start with the [Del] case since path ending with
+       [Del+] suffix are likely to correspond to parital application in the
+       functor application case.
+       Similarly, large block of deletions or insertions at the end of the
+       definitions might point toward incomplete definitions.
+       Thus this seems a good overall setting. *)
+    select_best_proposition [del;insert;diag]
   in
   let state = update diff localstate in
   Matrix.set tbl i j ~weight:newweight ~state ~diff:(Some diff)

diff --git a/utils/diffing.mli b/utils/diffing.mli
index 7f4d7ced1b6e1ae1dbac34c637c8c2ee4370dabb..79c51fbbae7a1d5ba8c8b6e7358955808879a904 100644 (file)
--- a/utils/diffing.mli
+++ b/utils/diffing.mli
@@ -79,7 +79,7 @@ type change_kind =
   | Insertion
   | Modification
   | Preservation
-val prefix: Format.formatter -> (int * change_kind) -> unit
+val prefix: (int * change_kind) Format_doc.printer
 val style: change_kind -> Misc.Style.style list
 
 

diff --git a/utils/diffing_with_keys.ml b/utils/diffing_with_keys.ml
index 28688a838b35b0356115654d8c23acc8e5d93294..b56db5a06f37ead03280ef9bba7d90111b060734 100644 (file)
--- a/utils/diffing_with_keys.ml
+++ b/utils/diffing_with_keys.ml
@@ -37,8 +37,8 @@ let prefix ppf x =
   in
   let style k ppf inner =
     let sty = Diffing.style k in
-    Format.pp_open_stag ppf (Misc.Style.Style sty);
-    Format.kfprintf (fun ppf -> Format.pp_close_stag ppf () ) ppf inner
+    Format_doc.pp_open_stag ppf (Misc.Style.Style sty);
+    Format_doc.kfprintf (fun ppf -> Format_doc.pp_close_stag ppf () ) ppf inner
   in
   match x with
   | Change (Name {pos; _ } | Type {pos; _})
@@ -53,7 +53,7 @@ let prefix ppf x =
 
 (** To detect [move] and [swaps], we are using the fact that
     there are 2-cycles in the graph of name renaming.
-    - [Change (x,y,_) is then an edge from
+    - [Change (x,y,_)] is then an edge from
       [key_left x] to [key_right y].
     - [Insert x] is an edge between the special node epsilon and
       [key_left x]

diff --git a/utils/diffing_with_keys.mli b/utils/diffing_with_keys.mli
index 2da826876732c734b6f00ee4355483f4c5858968..94e56fb72ee0382248b843d181329e4b701a2932 100644 (file)
--- a/utils/diffing_with_keys.mli
+++ b/utils/diffing_with_keys.mli
@@ -46,7 +46,7 @@ type ('l,'r,'diff) change =
   | Insert of {pos:int; insert:'r}
   | Delete of {pos:int; delete:'l}
 
-val prefix: Format.formatter -> ('l,'r,'diff) change -> unit
+val prefix: ('l,'r,'diff) change Format_doc.printer
 
 module Define(D:Diffing.Defs with type eq := unit): sig
 

diff --git a/utils/format_doc.ml b/utils/format_doc.ml
new file mode 100644 (file)
index 0000000..97014af
--- /dev/null
+++ b/utils/format_doc.ml
@@ -0,0 +1,485 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Florian Angeletti, projet Cambium, Inria Paris             *)
+(*                                                                        *)
+(*   Copyright 2021 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Doc = struct
+
+  type box_type =
+    | H
+    | V
+    | HV
+    | HoV
+    | B
+
+  type stag = Format.stag
+
+  type element =
+    | Text of string
+    | With_size of int
+    | Open_box of { kind: box_type ; indent:int }
+    | Close_box
+    | Open_tag of Format.stag
+    | Close_tag
+    | Open_tbox
+    | Tab_break of { width : int; offset : int }
+    | Set_tab
+    | Close_tbox
+    | Simple_break of { spaces : int; indent: int }
+    | Break of { fits : string * int * string as 'a; breaks : 'a }
+    | Flush of { newline:bool }
+    | Newline
+    | If_newline
+
+    | Deprecated of (Format.formatter -> unit)
+
+  type t = { rev:element list } [@@unboxed]
+
+  let empty = { rev = [] }
+
+  let to_list doc = List.rev doc.rev
+  let add doc x = { rev = x :: doc.rev }
+  let fold f acc doc = List.fold_left f acc (to_list doc)
+  let append left right = { rev = right.rev @ left.rev }
+
+  let format_open_box_gen ppf kind indent =
+    match kind with
+    | H-> Format.pp_open_hbox ppf ()
+    | V -> Format.pp_open_vbox ppf indent
+    | HV -> Format.pp_open_hvbox ppf indent
+    | HoV -> Format.pp_open_hovbox ppf indent
+    | B -> Format.pp_open_box ppf indent
+
+  let interpret_elt ppf = function
+    | Text x -> Format.pp_print_string ppf x
+    | Open_box { kind; indent } -> format_open_box_gen ppf kind indent
+    | Close_box -> Format.pp_close_box ppf ()
+    | Open_tag tag -> Format.pp_open_stag ppf tag
+    | Close_tag -> Format.pp_close_stag ppf ()
+    | Open_tbox -> Format.pp_open_tbox ppf ()
+    | Tab_break {width;offset} -> Format.pp_print_tbreak ppf width offset
+    | Set_tab -> Format.pp_set_tab ppf ()
+    | Close_tbox -> Format.pp_close_tbox ppf ()
+    | Simple_break {spaces;indent} -> Format.pp_print_break ppf spaces indent
+    | Break {fits;breaks} -> Format.pp_print_custom_break ppf ~fits ~breaks
+    | Flush {newline=true} -> Format.pp_print_newline ppf ()
+    | Flush {newline=false} -> Format.pp_print_flush ppf ()
+    | Newline -> Format.pp_force_newline ppf ()
+    | If_newline -> Format.pp_print_if_newline ppf ()
+    | With_size _ ->  ()
+    | Deprecated pr -> pr ppf
+
+  let rec interpret ppf = function
+    | [] -> ()
+    | With_size size :: Text text :: l ->
+        Format.pp_print_as ppf size text;
+        interpret ppf l
+    | x :: l ->
+        interpret_elt ppf x;
+        interpret ppf l
+
+  let format ppf doc = interpret ppf (to_list doc)
+
+
+
+  let open_box kind indent doc = add doc (Open_box {kind;indent})
+  let close_box doc = add doc Close_box
+
+  let string s doc = add doc (Text s)
+  let bytes b doc = add doc (Text (Bytes.to_string b))
+  let with_size size doc = add doc (With_size size)
+
+  let int n doc = add doc (Text (string_of_int n))
+  let float f doc = add doc (Text (string_of_float f))
+  let char c doc = add doc (Text (String.make 1 c))
+  let bool c doc = add doc (Text (Bool.to_string c))
+
+  let break ~spaces ~indent doc = add doc (Simple_break {spaces; indent})
+  let space doc = break ~spaces:1 ~indent:0 doc
+  let cut = break ~spaces:0 ~indent:0
+
+  let custom_break ~fits ~breaks doc = add doc (Break {fits;breaks})
+
+  let force_newline doc = add doc Newline
+  let if_newline doc = add doc If_newline
+
+  let flush doc = add doc (Flush {newline=false})
+  let force_stop doc = add doc (Flush {newline=true})
+
+  let open_tbox doc = add doc Open_tbox
+  let set_tab doc = add doc Set_tab
+  let tab_break ~width ~offset doc = add doc (Tab_break {width;offset})
+  let tab doc = tab_break ~width:0 ~offset:0 doc
+  let close_tbox doc = add doc Close_tbox
+
+  let open_tag stag doc = add doc (Open_tag stag)
+  let close_tag doc = add doc Close_tag
+
+  let iter ?(sep=Fun.id) ~iter:iterator elt l doc =
+    let first = ref true in
+    let rdoc = ref doc in
+    let print x =
+      if !first then (first := false; rdoc := elt x !rdoc)
+      else rdoc := !rdoc |> sep |> elt x
+    in
+    iterator print l;
+    !rdoc
+
+  let rec list ?(sep=Fun.id) elt l doc = match l with
+    | [] -> doc
+    | [a] -> elt a doc
+    | a :: ((_ :: _) as q) ->
+        doc |> elt a |> sep |> list ~sep elt q
+
+  let array ?sep elt a doc = iter ?sep ~iter:Array.iter elt a doc
+  let seq ?sep elt s doc = iter ?sep ~iter:Seq.iter elt s doc
+
+  let option ?(none=Fun.id) elt o doc = match o with
+    | None -> none doc
+    | Some x -> elt x doc
+
+  let either ~left ~right x doc = match x with
+    | Either.Left x -> left x doc
+    | Either.Right x -> right x doc
+
+  let result ~ok ~error x doc = match x with
+    | Ok x -> ok x doc
+    | Error x -> error x doc
+
+  (* To format free-flowing text *)
+  let rec subtext len left right s doc =
+    let flush doc =
+      doc |> string (String.sub s left (right - left))
+    in
+    let after_flush doc = subtext len (right+1) (right+1) s doc in
+    if right = len then
+      if left <> len then flush doc else doc
+    else
+      match s.[right] with
+      | '\n' ->
+          doc |> flush |> force_newline |> after_flush
+      | ' ' ->
+          doc |> flush |> space |> after_flush
+      (* there is no specific support for '\t'
+         as it is unclear what a right semantics would be *)
+      | _ -> subtext len left (right + 1) s doc
+
+  let text s doc =
+    subtext (String.length s) 0 0 s doc
+
+  type ('a,'b) fmt = ('a, t, t, 'b) format4
+  type printer0 = t -> t
+  type 'a printer = 'a -> printer0
+
+  let output_formatting_lit fmting_lit doc =
+    let open CamlinternalFormatBasics in
+    match fmting_lit with
+    | Close_box    -> close_box doc
+    | Close_tag                 -> close_tag doc
+    | Break (_, width, offset)  -> break ~spaces:width ~indent:offset doc
+    | FFlush                    -> flush doc
+    | Force_newline             -> force_newline doc
+    | Flush_newline             -> force_stop doc
+    | Magic_size (_, n)         -> with_size n doc
+    | Escaped_at                -> char '@' doc
+    | Escaped_percent           -> char '%' doc
+    | Scan_indic c              -> doc |> char '@' |> char c
+
+  let to_string doc =
+    let b = Buffer.create 20 in
+    let convert = function
+      | Text s -> Buffer.add_string b s
+      | _ -> ()
+    in
+    fold (fun () x -> convert x) () doc;
+    Buffer.contents b
+
+  let box_type =
+    let open CamlinternalFormatBasics in
+    function
+    | Pp_fits -> H
+    | Pp_hbox -> H
+    | Pp_vbox -> V
+    | Pp_hovbox -> HoV
+    | Pp_hvbox -> HV
+    | Pp_box -> B
+
+  let rec compose_acc acc doc =
+    let open CamlinternalFormat in
+    match acc with
+    | CamlinternalFormat.Acc_formatting_lit (p, f) ->
+        doc |> compose_acc p |> output_formatting_lit f
+    | Acc_formatting_gen (p, Acc_open_tag acc') ->
+        let tag = to_string (compose_acc acc' empty) in
+        let doc = compose_acc p doc in
+        doc |> open_tag (Format.String_tag tag)
+    | Acc_formatting_gen (p, Acc_open_box acc') ->
+        let doc = compose_acc p doc in
+        let box = to_string (compose_acc acc' empty) in
+        let (indent, bty) = CamlinternalFormat.open_box_of_string box in
+        doc |> open_box (box_type bty) indent
+    | Acc_string_literal (p, s)
+    | Acc_data_string (p, s)   ->
+        doc |> compose_acc p |> string s
+    | Acc_char_literal (p, c)
+    | Acc_data_char (p, c)     -> doc |> compose_acc p |> char c
+    | Acc_delay (p, f)         -> doc |> compose_acc p |> f
+    | Acc_flush p              -> doc |> compose_acc p |> flush
+    | Acc_invalid_arg (_p, msg) ->  invalid_arg msg;
+    | End_of_acc               -> doc
+
+  let kprintf k (CamlinternalFormatBasics.Format (fmt, _))  =
+    CamlinternalFormat.make_printf
+      (fun acc doc -> doc |> compose_acc acc |> k )
+      End_of_acc fmt
+
+  let printf doc = kprintf Fun.id doc
+  let kmsg k  (CamlinternalFormatBasics.Format (fmt, _)) =
+    CamlinternalFormat.make_printf
+      (fun acc -> k (compose_acc acc empty))
+      End_of_acc fmt
+
+  let msg fmt = kmsg Fun.id fmt
+
+end
+
+(** Compatibility interface *)
+
+type doc = Doc.t
+type t = doc
+type formatter = doc ref
+type 'a printer = formatter -> 'a -> unit
+
+let formatter d = d
+
+(** {1 Primitive functions }*)
+
+let pp_print_string ppf s = ppf := Doc.string s !ppf
+
+let pp_print_as ppf size s =
+  ppf := !ppf |> Doc.with_size size |> Doc.string s
+
+let pp_print_substring ~pos ~len ppf s =
+ ppf := Doc.string (String.sub s pos len) !ppf
+
+let pp_print_substring_as ~pos ~len ppf size s =
+  ppf :=
+  !ppf
+  |> Doc.with_size size
+  |> Doc.string (String.sub s pos len)
+
+let pp_print_bytes ppf s = ppf := Doc.string (Bytes.to_string s) !ppf
+let pp_print_text ppf s = ppf := Doc.text s !ppf
+let pp_print_char ppf c = ppf := Doc.char c !ppf
+let pp_print_int ppf c = ppf := Doc.int c !ppf
+let pp_print_float ppf f = ppf := Doc.float f !ppf
+let pp_print_bool ppf b = ppf := Doc.bool b !ppf
+let pp_print_nothing _ _ = ()
+
+let pp_close_box ppf () = ppf := Doc.close_box !ppf
+let pp_close_stag ppf () = ppf := Doc.close_tag !ppf
+
+let pp_print_break ppf spaces indent = ppf := Doc.break ~spaces ~indent !ppf
+
+let pp_print_custom_break ppf ~fits ~breaks =
+  ppf := Doc.custom_break ~fits ~breaks !ppf
+
+let pp_print_space ppf () = pp_print_break ppf 1 0
+let pp_print_cut ppf () = pp_print_break ppf 0 0
+
+let pp_print_flush ppf () = ppf := Doc.flush !ppf
+let pp_force_newline ppf () = ppf := Doc.force_newline !ppf
+let pp_print_newline ppf () = ppf := Doc.force_stop !ppf
+let pp_print_if_newline ppf () =ppf := Doc.if_newline !ppf
+
+let pp_open_stag ppf stag = ppf := !ppf |> Doc.open_tag stag
+
+let pp_open_box_gen ppf indent bxty =
+  let box_type = Doc.box_type bxty in
+   ppf := !ppf |> Doc.open_box box_type indent
+
+let pp_open_box ppf indent = pp_open_box_gen ppf indent Pp_box
+
+
+let pp_open_tbox ppf () = ppf := !ppf |> Doc.open_tbox
+
+let pp_close_tbox ppf () = ppf := !ppf |> Doc.close_tbox
+
+let pp_set_tab ppf () = ppf := !ppf |> Doc.set_tab
+
+let pp_print_tab ppf () = ppf := !ppf |> Doc.tab
+
+let pp_print_tbreak ppf width offset =
+  ppf := !ppf |> Doc.tab_break ~width ~offset
+
+let pp_doc ppf doc = ppf := Doc.append !ppf doc
+
+module Driver = struct
+  (* Interpret a formatting entity on a formatter. *)
+  let output_formatting_lit ppf
+      (fmting_lit:CamlinternalFormatBasics.formatting_lit)
+    = match fmting_lit with
+    | Close_box                 -> pp_close_box ppf ()
+    | Close_tag                 -> pp_close_stag 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
+
+
+
+  let compute_tag output tag_acc =
+    let buf = Buffer.create 16 in
+    let buf_fmt = Format.formatter_of_buffer buf in
+    let ppf = ref Doc.empty in
+    output ppf tag_acc;
+    pp_print_flush ppf ();
+    Doc.format buf_fmt !ppf;
+    let len = Buffer.length buf in
+    if len < 2 then Buffer.contents buf
+    else Buffer.sub buf 1 (len - 2)
+
+  (* 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: _ CamlinternalFormat.acc) =
+    match acc with
+    | Acc_string_literal (Acc_formatting_lit (p, Magic_size (_, size)), s)
+    | Acc_data_string (Acc_formatting_lit (p, Magic_size (_, size)), s) ->
+        output_acc ppf p;
+        pp_print_as ppf size s;
+    | Acc_char_literal (Acc_formatting_lit (p, Magic_size (_, size)), c)
+    | Acc_data_char (Acc_formatting_lit (p, Magic_size (_, size)), c) ->
+        output_acc ppf p;
+        pp_print_as ppf 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_stag ppf (Format.String_tag (compute_tag output_acc acc'))
+    | Acc_formatting_gen (p, Acc_open_box acc') ->
+        output_acc ppf p;
+        let (indent, bty) =
+          let box_info = compute_tag output_acc acc' in
+          CamlinternalFormat.open_box_of_string box_info
+        in
+        pp_open_box_gen ppf indent bty
+    | Acc_string_literal (p, s)
+    | Acc_data_string (p, s)   -> output_acc ppf p; pp_print_string ppf s;
+    | Acc_char_literal (p, c)
+    | Acc_data_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               -> ()
+end
+
+let kfprintf k ppf (CamlinternalFormatBasics.Format (fmt, _))  =
+  CamlinternalFormat.make_printf
+    (fun acc -> Driver.output_acc ppf acc; k ppf)
+    End_of_acc fmt
+let fprintf doc fmt = kfprintf ignore doc fmt
+
+
+let kdprintf k (CamlinternalFormatBasics.Format (fmt, _)) =
+  CamlinternalFormat.make_printf
+    (fun acc -> k (fun ppf -> Driver.output_acc ppf acc))
+    End_of_acc fmt
+
+let dprintf fmt = kdprintf (fun i -> i) fmt
+
+let doc_printf fmt =
+  let ppf = ref Doc.empty in
+  kfprintf (fun _ -> let doc = !ppf in ppf := Doc.empty; doc) ppf fmt
+
+let kdoc_printf k fmt =
+  let ppf = ref Doc.empty in
+  kfprintf (fun ppf ->
+      let doc = !ppf in
+      ppf := Doc.empty;
+      k doc
+    )
+    ppf fmt
+
+let doc_printer f x doc =
+  let r = ref doc in
+  f r x;
+  !r
+
+type 'a format_printer = Format.formatter -> 'a -> unit
+
+let format_printer f ppf x =
+  let doc = doc_printer f x Doc.empty in
+  Doc.format ppf doc
+let compat = format_printer
+let compat1 f p1 = compat (f p1)
+let compat2 f p1 p2 = compat (f p1 p2)
+
+let kasprintf k fmt =
+  kdoc_printf (fun doc -> k (Format.asprintf "%a" Doc.format doc)) fmt
+let asprintf fmt = kasprintf Fun.id fmt
+
+let pp_print_iter ?(pp_sep=pp_print_cut) iter elt ppf c =
+      let sep = doc_printer pp_sep () in
+      ppf:= Doc.iter ~sep ~iter (doc_printer elt) c !ppf
+
+let pp_print_list ?(pp_sep=pp_print_cut) elt ppf l =
+  ppf := Doc.list ~sep:(doc_printer pp_sep ()) (doc_printer elt) l !ppf
+
+let pp_print_array ?pp_sep elt ppf a =
+  pp_print_iter ?pp_sep Array.iter elt ppf a
+let pp_print_seq ?pp_sep elt ppf s = pp_print_iter ?pp_sep Seq.iter elt ppf s
+
+let pp_print_option  ?(none=fun _ () -> ()) elt ppf o =
+  ppf := Doc.option ~none:(doc_printer none ()) (doc_printer elt) o !ppf
+
+let pp_print_result  ~ok ~error ppf r =
+   ppf := Doc.result ~ok:(doc_printer ok) ~error:(doc_printer error) r !ppf
+
+let pp_print_either  ~left ~right ppf e =
+  ppf := Doc.either ~left:(doc_printer left) ~right:(doc_printer right) e !ppf
+
+let comma ppf () = fprintf ppf ",@ "
+
+let pp_two_columns ?(sep = "|") ?max_lines ppf (lines: (string * string) list) =
+  let left_column_size =
+    List.fold_left (fun acc (s, _) -> Int.max acc (String.length s)) 0 lines in
+  let lines_nb = List.length lines in
+  let ellipsed_first, ellipsed_last =
+    match max_lines with
+    | Some max_lines when lines_nb > max_lines ->
+        let printed_lines = max_lines - 1 in (* the ellipsis uses one line *)
+        let lines_before = printed_lines / 2 + printed_lines mod 2 in
+        let lines_after = printed_lines / 2 in
+        (lines_before, lines_nb - lines_after - 1)
+    | _ -> (-1, -1)
+  in
+  fprintf ppf "@[<v>";
+  List.iteri (fun k (line_l, line_r) ->
+      if k = ellipsed_first then fprintf ppf "...@,";
+      if ellipsed_first <= k && k <= ellipsed_last then ()
+      else fprintf ppf "%*s %s %s@," left_column_size line_l sep line_r
+    ) lines;
+  fprintf ppf "@]"
+
+let deprecated_printer pr ppf = ppf := Doc.add !ppf (Doc.Deprecated pr)
+let deprecated pr ppf x =
+  ppf := Doc.add !ppf (Doc.Deprecated (fun ppf -> pr ppf x))
+let deprecated1 pr p1 ppf x =
+  ppf := Doc.add !ppf (Doc.Deprecated (fun ppf -> pr p1 ppf x))

diff --git a/utils/format_doc.mli b/utils/format_doc.mli
new file mode 100644 (file)
index 0000000..bf36829
--- /dev/null
+++ b/utils/format_doc.mli
@@ -0,0 +1,299 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Florian Angeletti, projet Cambium, Inria Paris             *)
+(*                                                                        *)
+(*   Copyright 2024 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Composable document for the {!Format} formatting engine. *)
+
+(** This module introduces a pure and immutable document type which represents a
+    sequence of formatting instructions to be printed by a formatting engine at
+    later point. At the same time, it also provides format string interpreter
+    which produces this document type from format string and their associated
+    printers.
+
+    The module is designed to be source compatible with code defining format
+    printers: replacing `Format` by `Format_doc` in your code will convert
+    `Format` printers to `Format_doc` printers.
+*)
+
+(** Definitions and immutable API for composing documents *)
+module Doc: sig
+
+  (** {2 Type definitions and core functions }*)
+
+  (** Format box types *)
+  type box_type =
+    | H
+    | V
+    | HV
+    | HoV
+    | B
+
+  type stag = Format.stag
+
+  (** Base formatting instruction recognized by {!Format} *)
+  type element =
+    | Text of string
+    | With_size of int
+    | Open_box of { kind: box_type ; indent:int }
+    | Close_box
+    | Open_tag of Format.stag
+    | Close_tag
+    | Open_tbox
+    | Tab_break of { width : int; offset : int }
+    | Set_tab
+    | Close_tbox
+    | Simple_break of { spaces : int; indent : int }
+    | Break of { fits : string * int * string as 'a; breaks : 'a }
+    | Flush of { newline:bool }
+    | Newline
+    | If_newline
+
+    | Deprecated of (Format.formatter -> unit)
+    (** Escape hatch: a {!Format} printer used to provide backward-compatibility
+        for user-defined printer (from the [#install_printer] toplevel directive
+        for instance). *)
+
+  (** Immutable document type*)
+  type t
+
+  type ('a,'b) fmt = ('a, t, t,'b) format4
+
+  type printer0 = t -> t
+  type 'a printer = 'a -> printer0
+
+
+  (** Empty document *)
+  val empty: t
+
+  (** [format ppf doc] sends the format instruction of [doc] to the Format's
+      formatter [doc]. *)
+  val format: Format.formatter -> t -> unit
+
+  (** Fold over a document as a sequence of instructions *)
+  val fold: ('acc -> element -> 'acc) -> 'acc -> t -> 'acc
+
+  (** {!msg} and {!kmsg} produce a document from a format string and its
+      argument *)
+  val msg: ('a,t) fmt -> 'a
+  val kmsg: (t -> 'b) -> ('a,'b) fmt -> 'a
+
+  (** {!printf} and {!kprintf} produce a printer from a format string and its
+      argument*)
+  val printf: ('a, printer0) fmt -> 'a
+  val kprintf: (t -> 'b) -> ('a, t -> 'b) fmt -> 'a
+
+  (** The functions below mirror {!Format} printers, without the [pp_print_]
+      prefix naming convention *)
+  val open_box: box_type -> int -> printer0
+  val close_box: printer0
+
+  val text: string printer
+  val string: string printer
+  val bytes: bytes printer
+  val with_size: int printer
+
+  val int: int printer
+  val float: float printer
+  val char: char printer
+  val bool: bool printer
+
+  val space: printer0
+  val cut: printer0
+  val break: spaces:int -> indent:int -> printer0
+
+  val custom_break:
+    fits:(string * int * string as 'a) -> breaks:'a -> printer0
+  val force_newline: printer0
+  val if_newline: printer0
+
+  val flush: printer0
+  val force_stop: printer0
+
+  val open_tbox: printer0
+  val set_tab: printer0
+  val tab: printer0
+  val tab_break: width:int -> offset:int -> printer0
+  val close_tbox: printer0
+
+  val open_tag: stag printer
+  val close_tag: printer0
+
+  val list: ?sep:printer0 -> 'a printer -> 'a list printer
+  val iter:
+    ?sep:printer0 -> iter:(('a -> unit) -> 'b -> unit) -> 'a printer
+    ->'b printer
+  val array: ?sep:printer0 -> 'a printer -> 'a array printer
+  val seq: ?sep:printer0 -> 'a printer -> 'a Seq.t printer
+
+  val option: ?none:printer0 -> 'a printer -> 'a option printer
+  val result: ok:'a printer -> error:'e printer -> ('a,'e) result printer
+  val either: left:'a printer -> right:'b printer -> ('a,'b) Either.t printer
+
+end
+
+(** {1 Compatibility API} *)
+
+(** The functions and types below provides source compatibility with format
+printers and conversion function from {!Format_doc} printers to {!Format}
+printers. The reverse direction is implemented using an escape hatch in the
+formatting instruction and should only be used to preserve backward
+compatibility. *)
+
+type doc = Doc.t
+type t = doc
+type formatter
+type 'a printer = formatter -> 'a -> unit
+
+val formatter: doc ref -> formatter
+(** [formatter rdoc] creates a {!formatter} that updates the [rdoc] reference *)
+
+(** Translate a {!Format_doc} printer to a {!Format} one. *)
+type 'a format_printer = Format.formatter -> 'a -> unit
+val compat: 'a printer -> 'a format_printer
+val compat1: ('p1 -> 'a printer) -> ('p1 -> 'a format_printer)
+val compat2: ('p1 -> 'p2 -> 'a printer) -> ('p1 -> 'p2 -> 'a format_printer)
+
+(** If necessary, embbed a {!Format} printer inside a formatting instruction
+    stream. This breaks every guarantees provided by {!Format_doc}. *)
+val deprecated_printer: (Format.formatter -> unit) -> formatter -> unit
+val deprecated: 'a format_printer -> 'a printer
+val deprecated1: ('p1 -> 'a format_printer) -> ('p1 -> 'a printer)
+
+
+(** {2 Format string interpreters }*)
+
+val fprintf : formatter -> ('a, formatter,unit) format -> 'a
+val kfprintf:
+  (formatter -> 'a) -> formatter ->
+  ('b, formatter, unit, 'a) format4 -> 'b
+
+val asprintf :  ('a, formatter, unit, string) format4 -> 'a
+val kasprintf : (string -> 'a) -> ('b, formatter, unit, 'a) format4 -> 'b
+
+
+val dprintf : ('a, formatter, unit, formatter -> unit) format4 -> 'a
+val kdprintf:
+  ((formatter -> unit) -> 'a) ->
+  ('b, formatter, unit, 'a) format4 -> 'b
+
+(** {!doc_printf} and {!kdoc_printf} creates a document directly *)
+val doc_printf: ('a, formatter, unit, doc) format4 -> 'a
+val kdoc_printf: (doc -> 'r) -> ('a, formatter, unit, 'r) format4 -> 'a
+
+(** {2 Compatibility with {!Doc} }*)
+
+val doc_printer: 'a printer -> 'a Doc.printer
+val pp_doc: doc printer
+
+(** {2 Source compatibility with Format}*)
+
+(** {3 String printers } *)
+
+val pp_print_string: string printer
+val pp_print_substring: pos:int -> len:int -> string printer
+val pp_print_text: string printer
+val pp_print_bytes: bytes printer
+
+val pp_print_as: formatter -> int -> string -> unit
+val pp_print_substring_as:
+  pos:int -> len:int -> formatter -> int -> string -> unit
+
+(** {3 Primitive type printers }*)
+
+val pp_print_char: char printer
+val pp_print_int: int printer
+val pp_print_float: float printer
+val pp_print_bool: bool printer
+val pp_print_nothing: unit printer
+
+(** {3 Printer combinators }*)
+
+val pp_print_iter:
+  ?pp_sep:unit printer -> (('a -> unit) -> 'b -> unit) ->
+  'a printer -> 'b printer
+
+val pp_print_list: ?pp_sep:unit printer -> 'a printer -> 'a list printer
+val pp_print_array: ?pp_sep:unit printer -> 'a printer -> 'a array printer
+val pp_print_seq: ?pp_sep:unit printer -> 'a printer -> 'a Seq.t printer
+
+val pp_print_option: ?none:unit printer -> 'a printer -> 'a option printer
+val pp_print_result: ok:'a printer -> error:'e printer -> ('a,'e) result printer
+val pp_print_either:
+  left:'a printer -> right:'b printer -> ('a,'b) Either.t printer
+
+
+(** {3 Boxes and tags }*)
+
+val pp_open_stag: Format.stag printer
+val pp_close_stag: unit printer
+
+val pp_open_box: int printer
+val pp_close_box: unit printer
+
+(** {3 Break hints} *)
+
+val pp_print_space: unit printer
+val pp_print_cut: unit printer
+val pp_print_break: formatter -> int -> int -> unit
+val pp_print_custom_break:
+  formatter -> fits:(string * int * string as 'c) -> breaks:'c -> unit
+
+(** {3 Tabulations }*)
+
+val pp_open_tbox: unit printer
+val pp_close_tbox: unit printer
+val pp_set_tab: unit printer
+val pp_print_tab: unit printer
+val pp_print_tbreak: formatter -> int -> int -> unit
+
+(** {3 Newlines and flushing }*)
+
+val pp_print_if_newline: unit printer
+val pp_force_newline: unit printer
+val pp_print_flush: unit printer
+val pp_print_newline: unit printer
+
+(** {1 Compiler specific functions }*)
+
+(** {2 Separators }*)
+
+val comma: unit printer
+
+(** {2 Compiler output} *)
+
+val pp_two_columns :
+  ?sep:string -> ?max_lines:int ->
+  formatter -> (string * string) list -> unit
+(** [pp_two_columns ?sep ?max_lines ppf l] prints the lines in [l] as two
+   columns separated by [sep] ("|" by default). [max_lines] can be used to
+   indicate a maximum number of lines to print -- an ellipsis gets inserted at
+   the middle if the input has too many lines.
+
+   Example:
+
+    {v pp_two_columns ~max_lines:3 Format.std_formatter [
+      "abc", "hello";
+      "def", "zzz";
+      "a"  , "bllbl";
+      "bb" , "dddddd";
+    ] v}
+
+    prints
+
+    {v
+    abc | hello
+    ...
+    bb  | dddddd
+    v}
+*)

diff --git a/utils/linkdeps.ml b/utils/linkdeps.ml
new file mode 100644 (file)
index 0000000..824c898
--- /dev/null
+++ b/utils/linkdeps.ml
@@ -0,0 +1,142 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                              Hugo Heuzard                              *)
+(*                                                                        *)
+(*   Copyright 2020 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Style = Misc.Style
+
+type compunit = string
+
+type filename = string
+
+type compunit_and_source = {
+  compunit  : compunit;
+  filename : filename;
+}
+
+module Compunit_and_source = struct
+  type t = compunit_and_source
+  module Set = Set.Make(struct type nonrec t = t let compare = compare end)
+end
+
+type refs = Compunit_and_source.Set.t
+
+type t = {
+  complete : bool;
+  missing_compunits : (compunit, refs) Hashtbl.t;
+  provided_compunits : (compunit, filename list) Hashtbl.t;
+  badly_ordered_deps : (Compunit_and_source.t, refs) Hashtbl.t;
+}
+
+type error =
+  | Missing_implementations of (compunit * compunit_and_source list) list
+  | Wrong_link_order of (compunit_and_source * compunit_and_source list) list
+  | Multiple_definitions of (compunit * filename list) list
+
+let create ~complete = {
+  complete;
+  missing_compunits = Hashtbl.create 17;
+  provided_compunits = Hashtbl.create 17;
+  badly_ordered_deps = Hashtbl.create 17;
+}
+
+let required t compunit = Hashtbl.mem t.missing_compunits compunit
+
+let update t k f =
+  let v = Hashtbl.find_opt t k in
+  Hashtbl.replace t k (f v)
+
+let add_required t by (name : string) =
+  let add s =
+    Compunit_and_source.Set.add by
+      (Option.value s ~default:Compunit_and_source.Set.empty) in
+  (try
+     let filename = List.hd (Hashtbl.find t.provided_compunits name) in
+     update t.badly_ordered_deps {compunit = name; filename } add
+   with Not_found -> ());
+  update t.missing_compunits name add
+
+let add t ~filename ~compunit ~provides ~requires =
+  List.iter (add_required t {compunit; filename}) requires;
+  List.iter (fun p ->
+    Hashtbl.remove t.missing_compunits p;
+    let l = Option.value ~default:[]
+        (Hashtbl.find_opt t.provided_compunits p) in
+    Hashtbl.replace t.provided_compunits p (filename :: l)) provides
+
+let check t =
+  let of_seq s =
+    Seq.map (fun (k,v) -> k, Compunit_and_source.Set.elements v) s
+    |> List.of_seq
+  in
+  let missing = of_seq (Hashtbl.to_seq t.missing_compunits) in
+  let badly_ordered_deps = of_seq (Hashtbl.to_seq t.badly_ordered_deps) in
+  let duplicated =
+    Hashtbl.to_seq t.provided_compunits
+    |> Seq.filter (fun (_, files) -> List.compare_length_with files 1 > 0)
+    |> List.of_seq
+  in
+  match duplicated, badly_ordered_deps, missing with
+  | [], [], [] -> None
+  | [], [], l ->
+      if t.complete
+      then Some (Missing_implementations l)
+      else None
+  | [], l,  _  ->
+      Some (Wrong_link_order l)
+  | l, _, _ ->
+      Some (Multiple_definitions l)
+
+(* Error report *)
+
+open Format_doc
+
+let print_reference print_fname ppf {compunit; filename} =
+  fprintf ppf "%a (%a)" Style.inline_code compunit print_fname filename
+
+let pp_list_comma f =
+  pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ",@ ") f
+
+let report_error_doc ~print_filename ppf = function
+  | Missing_implementations l ->
+      let print_modules ppf =
+        List.iter
+          (fun (md, rq) ->
+             fprintf ppf "@ @[<hov 2>%a referenced from %a@]"
+               Style.inline_code md
+               (pp_list_comma (print_reference print_filename)) rq)
+      in
+      fprintf ppf
+        "@[<v 2>No implementation provided for the following modules:%a@]"
+        print_modules l
+  | Wrong_link_order l ->
+      let depends_on ppf (dep, depending) =
+        fprintf ppf "@ @[<hov 2>%a depends on %a@]"
+          (pp_list_comma (print_reference print_filename)) depending
+          (print_reference print_filename) dep
+      in
+      fprintf ppf "@[<hov 2>Wrong link order:%a@]"
+        (pp_list_comma depends_on) l
+  | Multiple_definitions l ->
+      let print ppf (compunit, files) =
+        fprintf ppf
+          "@ @[<hov>Multiple definitions of module %a in files %a@]"
+          Style.inline_code compunit
+          (pp_list_comma (Style.as_inline_code print_filename)) files
+
+      in
+      fprintf ppf "@[<hov 2> Duplicated implementations:%a@]"
+        (pp_list_comma print) l
+
+let report_error ~print_filename =
+  Format_doc.compat (report_error_doc ~print_filename)

diff --git a/utils/linkdeps.mli b/utils/linkdeps.mli
new file mode 100644 (file)
index 0000000..070b0e5
--- /dev/null
+++ b/utils/linkdeps.mli
@@ -0,0 +1,64 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                              Hugo Heuzard                              *)
+(*                                                                        *)
+(*   Copyright 2020 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type t
+(** The state of the linking check.
+    It keeps track of compilation units provided and required so far. *)
+
+type compunit = string
+
+type filename = string
+
+val create : complete:bool -> t
+(** [create ~complete] returns an empty state. If [complete] is
+   [true], missing compilation units will be treated as errors.  *)
+
+val add : t
+  -> filename:filename -> compunit:compunit
+  -> provides:compunit list -> requires:compunit list -> unit
+(** [add t ~filename ~compunit ~provides ~requires] registers the
+    compilation unit [compunit] found in [filename] to [t].
+    - [provides] are units and sub-units provided by [compunit]
+    - [requires] are units required by [compunit]
+
+    [add] should be called in reverse topological order. *)
+
+val required : t -> compunit -> bool
+(** [required t compunit] returns [true] if [compunit] is a dependency of
+    previously added compilation units. *)
+
+type compunit_and_source = {
+  compunit : compunit;
+  filename : filename;
+}
+
+type error =
+  | Missing_implementations of (compunit * compunit_and_source list) list
+  | Wrong_link_order of (compunit_and_source * compunit_and_source list) list
+  | Multiple_definitions of (compunit * filename list) list
+
+val check : t -> error option
+(** [check t] should be called once all the compilation units to be linked
+    have been added.  It returns some error if:
+    - There are some missing implementations
+      and [complete] is [true]
+    - Some implementation appear
+      before their dependencies *)
+
+
+val report_error :
+  print_filename:string Format_doc.printer -> error Format_doc.format_printer
+val report_error_doc :
+  print_filename:string Format_doc.printer -> error Format_doc.printer

diff --git a/utils/load_path.ml b/utils/load_path.ml
index 08b94c83437b72863e37955102e764c2025a2941..49f593f985ef9a030d5d04621c538596f2349559 100644 (file)
--- a/utils/load_path.ml
+++ b/utils/load_path.ml
@@ -105,15 +105,16 @@ let get_hidden_path_list () = List.rev_map Dir.path !hidden_dirs
    order. *)
 let prepend_add dir =
   List.iter (fun base ->
-      let fn = Filename.concat dir.Dir.path base in
-      let filename = Misc.normalized_unit_filename base in
-      if dir.Dir.hidden then begin
-        STbl.replace !hidden_files base fn;
-        STbl.replace !hidden_files_uncap filename fn
-      end else begin
-        STbl.replace !visible_files base fn;
-        STbl.replace !visible_files_uncap filename fn
-      end
+      Result.iter (fun filename ->
+          let fn = Filename.concat dir.Dir.path base in
+          if dir.Dir.hidden then begin
+            STbl.replace !hidden_files base fn;
+            STbl.replace !hidden_files_uncap filename fn
+          end else begin
+            STbl.replace !visible_files base fn;
+            STbl.replace !visible_files_uncap filename fn
+          end)
+        (Misc.normalized_unit_filename base)
     ) dir.Dir.files
 
 let init ~auto_include ~visible ~hidden =
@@ -150,10 +151,13 @@ let add (dir : Dir.t) =
   in
   List.iter
     (fun base ->
-       let fn = Filename.concat dir.Dir.path base in
-       update base fn visible_files hidden_files;
-       let ubase = Misc.normalized_unit_filename base in
-       update ubase fn visible_files_uncap hidden_files_uncap)
+       Result.iter (fun ubase ->
+           let fn = Filename.concat dir.Dir.path base in
+           update base fn visible_files hidden_files;
+           update ubase fn visible_files_uncap hidden_files_uncap
+         )
+         (Misc.normalized_unit_filename base)
+    )
     dir.files;
   if dir.hidden then
     hidden_dirs := dir :: !hidden_dirs
@@ -216,9 +220,12 @@ let find fn =
 
 let find_normalized_with_visibility fn =
   assert (not Config.merlin || Local_store.is_bound ());
+  match Misc.normalized_unit_filename fn with
+  | Error _ -> raise Not_found
+  | Ok fn_uncap ->
   try
     if is_basename fn && not !Sys.interactive then
-      find_file_in_cache (Misc.normalized_unit_filename fn)
+      find_file_in_cache fn_uncap
         visible_files_uncap hidden_files_uncap
     else
       try
@@ -227,7 +234,6 @@ let find_normalized_with_visibility fn =
       | Not_found ->
         (Misc.find_in_path_normalized (get_hidden_path_list ()) fn, Hidden)
   with Not_found ->
-    let fn_uncap = Misc.normalized_unit_filename fn in
     (!auto_include_callback Dir.find_normalized fn_uncap, Visible)
 
 let find_normalized fn = fst (find_normalized_with_visibility fn)

diff --git a/utils/local_store.mli b/utils/local_store.mli
index 3ea05d58896dfe2edb20b713a37c3cd9c42d7d3b..545cf71e0277a6d0c9ec7d6f1fd8bc83b708678b 100644 (file)
--- a/utils/local_store.mli
+++ b/utils/local_store.mli
@@ -14,7 +14,8 @@
 (**************************************************************************)
 
 (** This module provides some facilities for creating references (and hash
-    tables) which can easily be snapshoted and restored to an arbitrary version.
+    tables) which can easily be snapshotted and restored to an arbitrary
+    version.
 
     It is used throughout the frontend (read: typechecker), to register all
     (well, hopefully) the global state. Thus making it easy for tools like

diff --git a/utils/misc.ml b/utils/misc.ml
index 8a7883b42761beb01cda2aa6f02bf9afee71e5c5..b3d75dbb866411d54c55b538346636177df14634 100644 (file)
--- a/utils/misc.ml
+++ b/utils/misc.ml
@@ -260,6 +260,236 @@ module Stdlib = struct
   external compare : 'a -> 'a -> int = "%compare"
 end
 
+(** {1 Minimal support for Unicode characters in identifiers} *)
+
+module Utf8_lexeme = struct
+
+  type t = string
+
+  (* Non-ASCII letters that are allowed in identifiers (currently: Latin-9) *)
+
+  type case = Upper of Uchar.t | Lower of Uchar.t
+  let known_chars : (Uchar.t, case) Hashtbl.t = Hashtbl.create 32
+
+  let _ =
+    List.iter
+      (fun (upper, lower) ->
+        let upper = Uchar.of_int upper and lower = Uchar.of_int lower in
+        Hashtbl.add known_chars upper (Upper lower);
+        Hashtbl.add known_chars lower (Lower upper))
+  [
+    (0xc0, 0xe0); (* À, à *)    (0xc1, 0xe1); (* Á, á *)
+    (0xc2, 0xe2); (* Â, â *)    (0xc3, 0xe3); (* Ã, ã *)
+    (0xc4, 0xe4); (* Ä, ä *)    (0xc5, 0xe5); (* Å, å *)
+    (0xc6, 0xe6); (* Æ, æ *)    (0xc7, 0xe7); (* Ç, ç *)
+    (0xc8, 0xe8); (* È, è *)    (0xc9, 0xe9); (* É, é *)
+    (0xca, 0xea); (* Ê, ê *)    (0xcb, 0xeb); (* Ë, ë *)
+    (0xcc, 0xec); (* Ì, ì *)    (0xcd, 0xed); (* Í, í *)
+    (0xce, 0xee); (* Î, î *)    (0xcf, 0xef); (* Ï, ï *)
+    (0xd0, 0xf0); (* Ð, ð *)    (0xd1, 0xf1); (* Ñ, ñ *)
+    (0xd2, 0xf2); (* Ò, ò *)    (0xd3, 0xf3); (* Ó, ó *)
+    (0xd4, 0xf4); (* Ô, ô *)    (0xd5, 0xf5); (* Õ, õ *)
+    (0xd6, 0xf6); (* Ö, ö *)    (0xd8, 0xf8); (* Ø, ø *)
+    (0xd9, 0xf9); (* Ù, ù *)    (0xda, 0xfa); (* Ú, ú *)
+    (0xdb, 0xfb); (* Û, û *)    (0xdc, 0xfc); (* Ü, ü *)
+    (0xdd, 0xfd); (* Ý, ý *)    (0xde, 0xfe); (* Þ, þ *)
+    (0x160, 0x161); (* Š, š *)  (0x17d, 0x17e); (* Ž, ž *)
+    (0x152, 0x153); (* Œ, œ *)  (0x178, 0xff); (* Ÿ, ÿ *)
+    (0x1e9e, 0xdf); (* ẞ, ß *)
+  ]
+
+  (* NFD to NFC conversion table for the letters above *)
+
+  let known_pairs : (Uchar.t * Uchar.t, Uchar.t) Hashtbl.t = Hashtbl.create 32
+
+  let _ =
+    List.iter
+      (fun (c1, n2, n) ->
+        Hashtbl.add known_pairs
+          (Uchar.of_char c1, Uchar.of_int n2) (Uchar.of_int n))
+  [
+    ('A', 0x300, 0xc0); (* À *)    ('A', 0x301, 0xc1); (* Á *)
+    ('A', 0x302, 0xc2); (* Â *)    ('A', 0x303, 0xc3); (* Ã *)
+    ('A', 0x308, 0xc4); (* Ä *)    ('A', 0x30a, 0xc5); (* Å *)
+    ('C', 0x327, 0xc7); (* Ç *)    ('E', 0x300, 0xc8); (* È *)
+    ('E', 0x301, 0xc9); (* É *)    ('E', 0x302, 0xca); (* Ê *)
+    ('E', 0x308, 0xcb); (* Ë *)    ('I', 0x300, 0xcc); (* Ì *)
+    ('I', 0x301, 0xcd); (* Í *)    ('I', 0x302, 0xce); (* Î *)
+    ('I', 0x308, 0xcf); (* Ï *)    ('N', 0x303, 0xd1); (* Ñ *)
+    ('O', 0x300, 0xd2); (* Ò *)    ('O', 0x301, 0xd3); (* Ó *)
+    ('O', 0x302, 0xd4); (* Ô *)    ('O', 0x303, 0xd5); (* Õ *)
+    ('O', 0x308, 0xd6); (* Ö *)
+    ('U', 0x300, 0xd9); (* Ù *)    ('U', 0x301, 0xda); (* Ú *)
+    ('U', 0x302, 0xdb); (* Û *)    ('U', 0x308, 0xdc); (* Ü *)
+    ('Y', 0x301, 0xdd); (* Ý *)    ('Y', 0x308, 0x178);  (* Ÿ *)
+    ('S', 0x30c, 0x160); (* Š *)   ('Z', 0x30c, 0x17d); (* Ž *)
+    ('a', 0x300, 0xe0); (* à *)    ('a', 0x301, 0xe1); (* á *)
+    ('a', 0x302, 0xe2); (* â *)    ('a', 0x303, 0xe3); (* ã *)
+    ('a', 0x308, 0xe4); (* ä *)    ('a', 0x30a, 0xe5); (* å *)
+    ('c', 0x327, 0xe7); (* ç *)    ('e', 0x300, 0xe8); (* è *)
+    ('e', 0x301, 0xe9); (* é *)    ('e', 0x302, 0xea); (* ê *)
+    ('e', 0x308, 0xeb); (* ë *)    ('i', 0x300, 0xec); (* ì *)
+    ('i', 0x301, 0xed); (* í *)    ('i', 0x302, 0xee); (* î *)
+    ('i', 0x308, 0xef); (* ï *)    ('n', 0x303, 0xf1); (* ñ *)
+    ('o', 0x300, 0xf2); (* ò *)    ('o', 0x301, 0xf3); (* ó *)
+    ('o', 0x302, 0xf4); (* ô *)    ('o', 0x303, 0xf5); (* õ *)
+    ('o', 0x308, 0xf6); (* ö *)
+    ('u', 0x300, 0xf9); (* ù *)    ('u', 0x301, 0xfa); (* ú *)
+    ('u', 0x302, 0xfb); (* û *)    ('u', 0x308, 0xfc); (* ü *)
+    ('y', 0x301, 0xfd); (* ý *)    ('y', 0x308, 0xff); (* ÿ *)
+    ('s', 0x30c, 0x161); (* š *)   ('z', 0x30c, 0x17e); (* ž *)
+  ]
+
+  let normalize_generic ~keep_ascii transform s =
+    let rec norm check buf prev i =
+      if i >= String.length s then begin
+        Buffer.add_utf_8_uchar buf (transform prev)
+      end else begin
+        let d = String.get_utf_8_uchar s i in
+        let u = Uchar.utf_decode_uchar d in
+        check d u;
+        let i' = i + Uchar.utf_decode_length d in
+        match Hashtbl.find_opt known_pairs (prev, u) with
+        | Some u' ->
+            norm check buf u' i'
+        | None ->
+            Buffer.add_utf_8_uchar buf (transform prev);
+            norm check buf u i'
+      end in
+    let ascii_limit = 128 in
+    if s = ""
+    || keep_ascii && String.for_all (fun x -> Char.code x < ascii_limit) s
+    then Ok s
+    else
+      let buf = Buffer.create (String.length s) in
+      let valid = ref true in
+      let check d u =
+        valid := !valid && Uchar.utf_decode_is_valid d && u <> Uchar.rep
+      in
+      let d = String.get_utf_8_uchar s 0 in
+      let u = Uchar.utf_decode_uchar d in
+      check d u;
+      norm check buf u (Uchar.utf_decode_length d);
+      let contents = Buffer.contents buf in
+      if !valid then
+        Ok contents
+      else
+        Error contents
+
+  let normalize s =
+    normalize_generic ~keep_ascii:true (fun u -> u) s
+
+  (* Capitalization *)
+
+  let uchar_is_uppercase u =
+    let c = Uchar.to_int u in
+    if c < 0x80 then c >= 65 && c <= 90 else
+      match Hashtbl.find_opt known_chars u with
+      | Some(Upper _) -> true
+      | _ -> false
+
+  let uchar_lowercase u =
+    let c = Uchar.to_int u in
+    if c < 0x80 then
+      if c >= 65 && c <= 90 then Uchar.of_int (c + 32) else u
+    else
+      match Hashtbl.find_opt known_chars u with
+      | Some(Upper u') -> u'
+      | _ -> u
+
+  let uchar_uppercase u =
+    let c = Uchar.to_int u in
+    if c < 0x80 then
+      if c >= 97 && c <= 122 then Uchar.of_int (c - 32) else u
+    else
+      match Hashtbl.find_opt known_chars u with
+      | Some(Lower u') -> u'
+      | _ -> u
+
+  let capitalize s =
+    let first = ref true in
+    normalize_generic ~keep_ascii:false
+      (fun u -> if !first then (first := false; uchar_uppercase u) else u)
+      s
+
+  let uncapitalize s =
+    let first = ref true in
+    normalize_generic ~keep_ascii:false
+      (fun u -> if !first then (first := false; uchar_lowercase u) else u)
+      s
+
+  let is_capitalized s =
+    s <> "" &&
+    uchar_is_uppercase (Uchar.utf_decode_uchar (String.get_utf_8_uchar s 0))
+
+  (* Characters allowed in identifiers after normalization is applied.
+     Currently:
+       - ASCII letters, underscore
+       - Latin-9 letters, represented in NFC
+       - ASCII digits, single quote (but not as first character)
+       - dot if [with_dot] = true
+  *)
+  let uchar_valid_in_identifier ~with_dot u =
+    let c = Uchar.to_int u in
+    if c < 0x80 then
+         c >= 97 (* a *) && c <= 122 (* z *)
+      || c >= 65 (* A *) && c <= 90 (* Z *)
+      || c >= 48 (* 0 *) && c <= 57 (* 9 *)
+      || c = 95 (* underscore *)
+      || c = 39 (* single quote *)
+      || (with_dot && c = 46) (* dot *)
+    else
+      Hashtbl.mem known_chars u
+
+  let uchar_not_identifier_start u =
+    let c = Uchar.to_int u in
+       c >= 48 (* 0 *) && c <= 57 (* 9 *)
+    || c = 39  (* single quote *)
+
+  (* Check whether a normalized string is a valid OCaml identifier. *)
+
+  type validation_result =
+    | Valid
+    | Invalid_character of Uchar.t   (** Character not allowed *)
+    | Invalid_beginning of Uchar.t   (** Character not allowed as first char *)
+
+  let validate_identifier ?(with_dot=false) s =
+    let rec check i =
+      if i >= String.length s then Valid else begin
+        let d = String.get_utf_8_uchar s i in
+        let u = Uchar.utf_decode_uchar d in
+        let i' = i + Uchar.utf_decode_length d in
+        if not (uchar_valid_in_identifier ~with_dot u) then
+          Invalid_character u
+        else if i = 0 && uchar_not_identifier_start u then
+          Invalid_beginning u
+        else
+          check i'
+      end
+    in check 0
+
+  let is_valid_identifier s =
+    validate_identifier s = Valid
+
+  let starts_like_a_valid_identifier s =
+    s <> "" &&
+    (let u = Uchar.utf_decode_uchar (String.get_utf_8_uchar s 0) in
+     uchar_valid_in_identifier ~with_dot:false u
+     && not (uchar_not_identifier_start u))
+
+  let is_lowercase s =
+    let rec is_lowercase_at len s n =
+      if n >= len then true
+      else
+        let d = String.get_utf_8_uchar s n in
+        let u = Uchar.utf_decode_uchar d in
+        (uchar_valid_in_identifier ~with_dot:false  u)
+        && not (uchar_is_uppercase u)
+        && is_lowercase_at len s (n+Uchar.utf_decode_length d)
+    in
+    is_lowercase_at (String.length s) s 0
+end
+
 (* File functions *)
 
 let find_in_path path name =
@@ -290,10 +520,12 @@ let find_in_path_rel path name =
       if Sys.file_exists fullname then fullname else try_dir rem
   in try_dir path
 
-let normalized_unit_filename = String.uncapitalize_ascii
+let normalized_unit_filename = Utf8_lexeme.uncapitalize
 
 let find_in_path_normalized path name =
-  let uname = normalized_unit_filename name in
+  match normalized_unit_filename name with
+  | Error _ -> raise Not_found
+  | Ok uname ->
   let rec try_dir = function
     [] -> raise Not_found
   | dir::rem ->
@@ -651,11 +883,12 @@ module Style = struct
 
 
   let as_inline_code printer ppf x =
-    Format.pp_open_stag ppf (Format.String_tag "inline_code");
+    let open Format_doc in
+    pp_open_stag ppf (Format.String_tag "inline_code");
     printer ppf x;
-    Format.pp_close_stag ppf ()
+    pp_close_stag ppf ()
 
-  let inline_code ppf s = as_inline_code Format.pp_print_string ppf s
+  let inline_code ppf s = as_inline_code Format_doc.pp_print_string ppf s
 
   (* either prints the tag of [s] or delegates to [or_else] *)
   let mark_open_tag ~or_else s =
@@ -769,19 +1002,20 @@ let spellcheck env name =
   let env = List.sort_uniq (fun s1 s2 -> String.compare s2 s1) env in
   fst (List.fold_left (compare name) ([], max_int) env)
 
+
 let did_you_mean ppf get_choices =
+  let open Format_doc in
   (* flush now to get the error report early, in the (unheard of) case
      where the search in the get_choices function would take a bit of
      time; in the worst case, the user has seen the error, she can
      interrupt the process before the spell-checking terminates. *)
-  Format.fprintf ppf "@?";
+  fprintf ppf "@?";
   match get_choices () with
   | [] -> ()
   | choices ->
     let rest, last = split_last choices in
-    let comma ppf () = Format.fprintf ppf ", " in
-     Format.fprintf ppf "@\n@{<hint>Hint@}: Did you mean %a%s%a?@?"
-       (Format.pp_print_list ~pp_sep:comma Style.inline_code) rest
+     fprintf ppf "@\n@[@{<hint>Hint@}: Did you mean %a%s%a?@]"
+       (pp_print_list ~pp_sep:comma Style.inline_code) rest
        (if rest = [] then "" else " or ")
        Style.inline_code last
 
@@ -832,27 +1066,6 @@ let delete_eol_spaces src =
   let stop = loop 0 0 in
   Bytes.sub_string dst 0 stop
 
-let pp_two_columns ?(sep = "|") ?max_lines ppf (lines: (string * string) list) =
-  let left_column_size =
-    List.fold_left (fun acc (s, _) -> Int.max acc (String.length s)) 0 lines in
-  let lines_nb = List.length lines in
-  let ellipsed_first, ellipsed_last =
-    match max_lines with
-    | Some max_lines when lines_nb > max_lines ->
-        let printed_lines = max_lines - 1 in (* the ellipsis uses one line *)
-        let lines_before = printed_lines / 2 + printed_lines mod 2 in
-        let lines_after = printed_lines / 2 in
-        (lines_before, lines_nb - lines_after - 1)
-    | _ -> (-1, -1)
-  in
-  Format.fprintf ppf "@[<v>";
-  List.iteri (fun k (line_l, line_r) ->
-    if k = ellipsed_first then Format.fprintf ppf "...@,";
-    if ellipsed_first <= k && k <= ellipsed_last then ()
-    else Format.fprintf ppf "%*s %s %s@," left_column_size line_l sep line_r
-  ) lines;
-  Format.fprintf ppf "@]"
-
 (* showing configuration and configuration variables *)
 let show_config_and_exit () =
   Config.print_config stdout;
@@ -909,16 +1122,16 @@ let debug_prefix_map_flags () =
         []
   end
 
-let print_if ppf flag printer arg =
-  if !flag then Format.fprintf ppf "%a@." printer arg;
-  arg
-
 let print_see_manual ppf manual_section =
-  let open Format in
+  let open Format_doc in
   fprintf ppf "(see manual section %a)"
     (pp_print_list ~pp_sep:(fun f () -> pp_print_char f '.') pp_print_int)
     manual_section
 
+let print_if ppf flag printer arg =
+  if !flag then Format.fprintf ppf "%a@." printer arg;
+  arg
+
 
 type filepath = string
 type modname = string

diff --git a/utils/misc.mli b/utils/misc.mli
index 6deedc4934942b4728add73904a1582e451c9005..54354eba56abc36e1fe282ed1a2de4c2c06abdfc 100644 (file)
--- a/utils/misc.mli
+++ b/utils/misc.mli
@@ -217,8 +217,9 @@ val find_in_path: string list -> string -> string
 val find_in_path_rel: string list -> string -> string
        (** Search a relative file in a list of directories. *)
 
- (** Normalize file name [Foo.ml] to [foo.ml] *)
-val normalized_unit_filename: string -> string
+ (** Normalize file name [Foo.ml] to [foo.ml], using NFC and case-folding.
+     Return [Error] if the input is not a valid utf-8 byte sequence *)
+val normalized_unit_filename: string -> (string,string) Result.t
 
 val find_in_path_normalized: string list -> string -> string
 (** Same as {!find_in_path_rel} , but search also for normalized unit filename,
@@ -445,7 +446,8 @@ val spellcheck : string list -> string -> string list
     list of suggestions taken from [env], that are close enough to
     [name] that it may be a typo for one of them. *)
 
-val did_you_mean : Format.formatter -> (unit -> string list) -> unit
+val did_you_mean :
+    Format_doc.formatter -> (unit -> string list) -> unit
 (** [did_you_mean ppf get_choices] hints that the user may have meant
     one of the option returned by calling [get_choices]. It does nothing
     if the returned list is empty.
@@ -505,8 +507,8 @@ module Style : sig
     inline_code: tag_style;
   }
 
-  val as_inline_code: (Format.formatter -> 'a -> unit as 'printer) -> 'printer
-  val inline_code: Format.formatter -> string -> unit
+  val as_inline_code: 'a Format_doc.printer -> 'a Format_doc.printer
+  val inline_code: string Format_doc.printer
 
   val default_styles: styles
   val get_styles: unit -> styles
@@ -536,33 +538,7 @@ val print_if :
   Format.formatter -> bool ref -> (Format.formatter -> 'a -> unit) -> 'a -> 'a
 (** [print_if ppf flag fmt x] prints [x] with [fmt] on [ppf] if [b] is true. *)
 
-val pp_two_columns :
-  ?sep:string -> ?max_lines:int ->
-  Format.formatter -> (string * string) list -> unit
-(** [pp_two_columns ?sep ?max_lines ppf l] prints the lines in [l] as two
-   columns separated by [sep] ("|" by default). [max_lines] can be used to
-   indicate a maximum number of lines to print -- an ellipsis gets inserted at
-   the middle if the input has too many lines.
-
-   Example:
-
-    {v pp_two_columns ~max_lines:3 Format.std_formatter [
-      "abc", "hello";
-      "def", "zzz";
-      "a"  , "bllbl";
-      "bb" , "dddddd";
-    ] v}
-
-    prints
-
-    {v
-    abc | hello
-    ...
-    bb  | dddddd
-    v}
-*)
-
-val print_see_manual : Format.formatter -> int list -> unit
+val print_see_manual : int list Format_doc.printer
 (** See manual section *)
 
 (** {1 Displaying configuration variables} *)
@@ -787,6 +763,66 @@ module Magic_number : sig
   val all_kinds : kind list
 end
 
+(** {1 Minimal support for Unicode characters in identifiers} *)
+
+(** Characters allowed in identifiers are, currently:
+      - ASCII letters A-Z a-z
+      - Latin-1 letters (U+00C0 - U+00FF except U+00D7 and U+00F7)
+      - Character sequences which normalize to the above character under NFC
+      - digits 0-9, underscore, single quote
+*)
+
+module Utf8_lexeme: sig
+  type t = string
+
+  val normalize: string -> (t,t) Result.t
+  (** Normalize the given UTF-8 encoded string.
+      Invalid UTF-8 sequences results in a error and are replaced
+      by U+FFFD.
+      Identifier characters are put in NFC normalized form.
+      Other Unicode characters are left unchanged. *)
+
+  val capitalize: string -> (t,t) Result.t
+  (** Like [normalize], but if the string starts with a lowercase identifier
+      character, it is replaced by the corresponding uppercase character.
+      Subsequent characters are not changed. *)
+
+  val uncapitalize: string -> (t,t) Result.t
+  (** Like [normalize], but if the string starts with an uppercase identifier
+      character, it is replaced by the corresponding lowercase character.
+      Subsequent characters are not changed. *)
+
+  val is_capitalized: t -> bool
+  (** Returns [true] if the given normalized string starts with an
+      uppercase identifier character, [false] otherwise.  May return
+      wrong results if the string is not normalized. *)
+
+  val is_valid_identifier: t -> bool
+  (** Check whether the given normalized string is a valid OCaml identifier:
+      - all characters are identifier characters
+      - it does not start with a digit or a single quote
+  *)
+
+  val is_lowercase: t -> bool
+  (** Returns [true] if the given normalized string only contains lowercase
+      identifier character, [false] otherwise. May return wrong results if the
+      string is not normalized. *)
+
+  type validation_result =
+    | Valid
+    | Invalid_character of Uchar.t   (** Character not allowed *)
+    | Invalid_beginning of Uchar.t   (** Character not allowed as first char *)
+
+  val validate_identifier: ?with_dot:bool -> t -> validation_result
+  (** Like [is_valid_identifier], but returns a more detailed error code. Dots
+      can be allowed to extend support to path-like identifiers. *)
+
+  val starts_like_a_valid_identifier: t -> bool
+  (** Checks whether the given normalized string starts with an identifier
+      character other than a digit or a single quote.  Subsequent characters
+      are not checked. *)
+end
+
 (** {1 Miscellaneous type aliases} *)
 
 type filepath = string

diff --git a/utils/warnings.ml b/utils/warnings.ml
index 1812e0a34124ad5888b09dfb276e42aef9a810c2..d9670caf4967e2c7b54fd12219409902f2dd6b95 100644 (file)
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -52,7 +52,7 @@ type t =
   | Implicit_public_methods of string list  (* 15 *)
   | Unerasable_optional_argument            (* 16 *)
   | Undeclared_virtual_method of string     (* 17 *)
-  | Not_principal of string                 (* 18 *)
+  | Not_principal of Format_doc.t           (* 18 *)
   | Non_principal_labels of string          (* 19 *)
   | Ignored_extra_argument                  (* 20 *)
   | Nonreturning_statement                  (* 21 *)
@@ -109,6 +109,7 @@ type t =
   | Unused_tmc_attribute                    (* 71 *)
   | Tmc_breaks_tailcall                     (* 72 *)
   | Generative_application_expects_unit     (* 73 *)
+  | Degraded_to_partial_match               (* 74 *)
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
    the numbers of existing warnings.
@@ -190,12 +191,13 @@ let number = function
   | Unused_tmc_attribute -> 71
   | Tmc_breaks_tailcall -> 72
   | Generative_application_expects_unit -> 73
+  | Degraded_to_partial_match -> 74
 ;;
 (* DO NOT REMOVE the ;; above: it is used by
    the testsuite/ests/warnings/mnemonics.mll test to determine where
    the  definition of the number function above ends *)
 
-let last_warning_number = 73
+let last_warning_number = 74
 
 type description =
   { number : int;
@@ -534,6 +536,11 @@ let descriptions = [
     description = "A generative functor is applied to an empty structure \
                    (struct end) rather than to ().";
     since = since 5 1 };
+  { number = 74;
+    names = ["degraded-to-partial-match"];
+    description = "A pattern-matching is compiled as partial \
+                   even if it appears to be total.";
+    since = since 5 3 };
 ]
 
 let name_to_number =
@@ -863,7 +870,7 @@ let parse_options errflag s =
   alerts
 
 (* If you change these, don't forget to change them in man/ocamlc.m *)
-let defaults_w = "+a-4-7-9-27-29-30-32..42-44-45-48-50-60-66..70"
+let defaults_w = "+a-4-7-9-27-29-30-32..42-44-45-48-50-60-66..70-74"
 let defaults_warn_error = "-a"
 let default_disabled_alerts = [ "unstable"; "unsynchronized_access" ]
 
@@ -926,7 +933,9 @@ let message = function
       ^ String.concat " " l ^ "."
   | Unerasable_optional_argument -> "this optional argument cannot be erased."
   | Undeclared_virtual_method m -> "the virtual method "^m^" is not declared."
-  | Not_principal s -> s^" is not principal."
+  | Not_principal msg ->
+      Format_doc.asprintf "%a is not principal."
+        Format_doc.pp_doc msg
   | Non_principal_labels s -> s^" without principality."
   | Ignored_extra_argument -> "this argument will not be used by the function."
   | Nonreturning_statement ->
@@ -1040,7 +1049,7 @@ let message = function
         "Code should not depend on the actual values of\n\
          this constructor's arguments. They are only for information\n\
          and may change in future versions. %a"
-        Misc.print_see_manual ref_manual
+        (Format_doc.compat Misc.print_see_manual) ref_manual
   | Unreachable_case ->
       "this match case is unreachable.\n\
        Consider replacing it with a refutation case '<pat> -> .'"
@@ -1071,7 +1080,7 @@ let message = function
          %s.\n\
          Only the first match will be used to evaluate the guard expression.\n\
          %a"
-        vars_explanation Misc.print_see_manual ref_manual
+        vars_explanation (Format_doc.compat Misc.print_see_manual) ref_manual
   | No_cmx_file name ->
       Printf.sprintf
         "no cmx file was found in path for module %s, \
@@ -1096,7 +1105,7 @@ let message = function
   | Erroneous_printed_signature s ->
       "The printed interface differs from the inferred interface.\n\
        The inferred interface contained items which could not be printed\n\
-       properly due to name collisions between identifiers."
+       properly due to name collisions between identifiers.\n"
      ^ s
      ^ "\nBeware that this warning is purely informational and will not catch\n\
         all instances of erroneous printed interface."
@@ -1136,6 +1145,16 @@ let message = function
   | Generative_application_expects_unit ->
       "A generative functor\n\
        should be applied to '()'; using '(struct end)' is deprecated."
+  | Degraded_to_partial_match ->
+      let[@manual.ref "ss:warn74"] ref_manual = [ 13; 5; 5 ] in
+      Format.asprintf
+        "This pattern-matching is compiled \n\
+         as partial, even if it appears to be total. \
+         It may generate a Match_failure\n\
+         exception. This typically occurs due to \
+         complex matches on mutable fields.\n\
+         %a"
+        (Format_doc.compat Misc.print_see_manual) ref_manual
 ;;
 
 let nerrors = ref 0

diff --git a/utils/warnings.mli b/utils/warnings.mli
index f0a4b1c9239228208cb68fd2819e2f6db0e0d966..1da12c15fd8d697164e11dd39ab2d5d831c21833 100644 (file)
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -57,7 +57,7 @@ type t =
   | Implicit_public_methods of string list  (* 15 *)
   | Unerasable_optional_argument            (* 16 *)
   | Undeclared_virtual_method of string     (* 17 *)
-  | Not_principal of string                 (* 18 *)
+  | Not_principal of Format_doc.t           (* 18 *)
   | Non_principal_labels of string          (* 19 *)
   | Ignored_extra_argument                  (* 20 *)
   | Nonreturning_statement                  (* 21 *)
@@ -116,6 +116,7 @@ type t =
   | Unused_tmc_attribute                    (* 71 *)
   | Tmc_breaks_tailcall                     (* 72 *)
   | Generative_application_expects_unit     (* 73 *)
+  | Degraded_to_partial_match               (* 74 *)
 
 type alert = {kind:string; message:string; def:loc; use:loc}
 

diff --git a/yacc/error.c b/yacc/error.c
index 12cad18d4f7cd564d5ccea14c8a2e11650e36073..9dbe42de5792ed772ff2577e32c925a16c46ddc3 100644 (file)
--- a/yacc/error.c
+++ b/yacc/error.c
@@ -77,7 +77,7 @@ static void print_pos(char *st_line, char *st_cptr)
 }
 
 
-static Noreturn void gen_error(int st_lineno, char *st_line, char *st_cptr, char *msg)
+CAMLnoret static void gen_error(int st_lineno, char *st_line, char *st_cptr, char *msg)
 {
     fprintf(stderr, "File \"%s\", line %d: %s\n",
             virtual_input_file_name, st_lineno, msg);

diff --git a/yacc/reader.c b/yacc/reader.c
index 5d3ecdcb73fa2b692981bef01650b598376451ba..5c478bca270691fddc99a83a400e242a0acdaf17 100644 (file)
--- a/yacc/reader.c
+++ b/yacc/reader.c
@@ -347,6 +347,7 @@ static void process_open_curly_bracket(FILE *f) {
                         unterminated_string(s_lineno, s_line, s_cptr);
                 }
             }
+            FREE(s_line);
             FREE(buf);
             return;
         }
@@ -523,7 +524,7 @@ nextc(void)
                 s = cptr;
                 break;
             }
-            /* fall through */
+            fallthrough;
 
         default:
             cptr = s;
@@ -645,7 +646,7 @@ loop:
             FREE(t_line);
             return;
         }
-        /* fall through */
+        fallthrough;
 
     case '{':
         putc(c, f);
@@ -741,8 +742,10 @@ get_tag(void)
 
     for (i = 0; i < ntags; ++i)
     {
-        if (strcmp(cache, tag_table[i]) == 0)
+        if (strcmp(cache, tag_table[i]) == 0) {
+            FREE(t_line);
             return (tag_table[i]);
+        }
     }
 
     if (ntags >= tagmax)